scmdoc

  1{-# LANGUAGE LambdaCase #-}
  2{-# LANGUAGE OverloadedStrings #-}
  3
  4-- | This is the high-level interface for rendering Scheme source
  5-- documentation to a suitable output format. Currently, only HTML
  6-- is supported as an output format.
  7--
  8-- The API, provided by this module, is structured around R7RS
  9-- Scheme 'L.Library' declarations and generates documentation
 10-- for all exported identifiers of a Scheme library.
 11module SchemeDoc (DocLib, findDocLibs, docDecls, docFmt, mkDoc, findUndocumented)
 12where
 13
 14import SchemeDoc.Error
 15import SchemeDoc.Format.Formatter
 16import qualified SchemeDoc.Format.Library as L
 17import qualified SchemeDoc.Format.Record as R
 18import SchemeDoc.Format.Types
 19import SchemeDoc.Types
 20
 21import qualified Data.Text as T
 22import Text.Blaze.Html
 23import Text.Blaze.Html.Renderer.String
 24import qualified Text.Blaze.Html5 as H
 25import qualified Text.Blaze.Html5.Attributes as A
 26
 27-- | A documented Scheme library, i.e. a Scheme 'L.Library' declaration
 28-- which is proceded by a 'DocComment'.
 29type DocLib = (T.Text, L.Library)
 30
 31-- | Find all documented Scheme 'L.Library' declarations in a Scheme source.
 32findDocLibs :: [Sexp] -> Either SyntaxError [DocLib]
 33findDocLibs exprs = foldr fn (Right []) (findDocumented exprs)
 34  where
 35    fn (s, e@(List ((Id "define-library") : _))) acc =
 36        case L.mkLibrary e of
 37            Right lib -> fmap ((s, lib) :) acc
 38            Left err -> Left err
 39    fn _ acc = acc
 40
 41-- | Find all documented 'Component's of a Scheme 'L.Library'. Performs
 42-- file system access to expand includes and may return an 'ErrParser'
 43-- exception.
 44--
 45-- Returns the recognized Components and a list of S-expressions which
 46-- were preceded by a 'DocComment' but for which no suitable 'Formatter'
 47-- was found.
 48docDecls :: DocLib -> IO ([Component], [Sexp])
 49docDecls (_, lib) = do
 50    sexprs <- L.expand lib
 51    pure $ findComponents defFormatter (findDocumented sexprs)
 52
 53-- | Format a documented 'L.Library', with regards to its 'Component's
 54-- (obtained via 'docDecls') as an 'Html' document.
 55docFmt :: DocLib -> [Component] -> Html
 56docFmt (libDesc, lib) comps =
 57    let html = format lib comps
 58     in declFmt (fmt lib libDesc) Nothing >> html
 59
 60-- | Render an 'Html' document with the given title, stylesheet, and body.
 61mkDoc :: String -> String -> Html -> String
 62mkDoc title css hbody = renderHtml $ H.docTypeHtml $ do
 63    H.head $ do
 64        H.meta ! A.charset "UTF-8"
 65        H.meta
 66            ! A.name "viewport"
 67            ! A.content "width=device-width, initial-scale=1"
 68
 69        H.link
 70            ! A.rel "stylesheet"
 71            ! A.href (stringValue css)
 72        H.title $ toHtml title
 73    H.body hbody
 74
 75-- | The name of all internal identifiers which are exported by the
 76-- 'L.Library' but not documented, i.e. not preceded by a 'DocComment'.
 77findUndocumented :: L.Library -> [Component] -> [T.Text]
 78findUndocumented lib comps =
 79    filter (\i -> not $ member i comps) $
 80        map L.internal (L.exported lib)
 81  where
 82    member :: T.Text -> [Component] -> Bool
 83    member ident =
 84        any
 85            ( \case
 86                D d -> declId d == ident
 87                S _ -> False
 88            )
 89
 90------------------------------------------------------------------------
 91
 92-- Filter out all non-documented S-expressions and attempt to perform
 93-- pseudo macro expansion for documented S-expression.
 94filterAndExpand :: [Sexp] -> [Sexp]
 95filterAndExpand = snd . walk filterAndExpand' (False, [])
 96  where
 97    filterAndExpand' :: (Bool, [Sexp]) -> Sexp -> Walk (Bool, [Sexp])
 98    filterAndExpand' (False, acc) c@(DocComment _) = Recur (True, acc ++ [c])
 99    filterAndExpand' (True, acc) expr =
100        -- Attempt to expand the expression. If expansion was successful
101        -- strip the preceding DocComment from the accumulated value and
102        -- filter the expanded S-expressions.
103        --
104        -- TODO: Generalize this and use it for Library expansion too.
105        case R.expand expr of
106            Just e -> Rise (False, init acc ++ filterAndExpand [e])
107            Nothing -> Recur (False, acc ++ [expr])
108    filterAndExpand' b _ = Recur b
109
110-- Find all S-expressions which are preceded by a documentation comment.
111findDocumented :: [Sexp] -> [Documented]
112findDocumented = toPairLst . filterAndExpand
113  where
114    toPairLst :: [Sexp] -> [Documented]
115    toPairLst [] = []
116    toPairLst ((DocComment s) : expr : xs) = (s, expr) : toPairLst xs
117    toPairLst _ = error "unreachable"