scmdoc

  1{-# LANGUAGE LambdaCase #-}
  2{-# LANGUAGE OverloadedStrings #-}
  3
  4-- | This module provides functions for applying a 'Formatter' to
  5-- create 'Component's for given S-expressions. Furthermore, an
  6-- HTML document, for recognized 'Component's, can be generated
  7-- using this module.
  8module SchemeDoc.Format.Formatter (findComponents, format, defFormatter)
  9where
 10
 11import Control.Applicative
 12import Control.Monad
 13
 14import qualified SchemeDoc.Format.Library as L
 15import SchemeDoc.Format.Procedure
 16import SchemeDoc.Format.Syntax
 17import SchemeDoc.Format.Types
 18import SchemeDoc.Format.Variable
 19import SchemeDoc.Types
 20
 21import qualified Data.Text as T
 22import Text.Blaze.Html
 23import qualified Text.Blaze.Html5 as H
 24
 25-- ToC represents a table of contents with a depth of one.
 26data ToC = Heading Section | Items [Declaration]
 27
 28tableOfContents' :: [Component] -> [ToC] -> [ToC]
 29tableOfContents' ((D pc) : xs) ((Items lst) : toc) = tableOfContents' xs (toc ++ [Items $ lst ++ [pc]])
 30tableOfContents' ((D pc) : xs) toc = tableOfContents' xs (toc ++ [Items [pc]])
 31tableOfContents' ((S sec) : xs) toc = tableOfContents' xs (toc ++ [Heading sec])
 32tableOfContents' [] toc = toc
 33
 34tableOfContents :: [Component] -> Html
 35tableOfContents comps = H.ul $ do
 36    forM_
 37        (tableOfContents' comps [])
 38        ( \case
 39            Heading s -> H.li (compLink $ S s)
 40            Items lst -> H.ul (formatItems lst)
 41        )
 42  where
 43    formatItems :: [Declaration] -> Html
 44    formatItems decls = forM_ decls (H.li . compLink . D)
 45
 46------------------------------------------------------------------------
 47
 48-- | The default 'Formatter', can be extented via the 'Maybe' applicative.
 49defFormatter :: Sexp -> T.Text -> Maybe Declaration
 50defFormatter sexp desc =
 51    flip fmt desc <$> mkVariable sexp
 52        <|> flip fmt desc <$> mkProcedure sexp
 53        <|> flip fmt desc <$> mkSyntax sexp
 54
 55-- | Find all 'Component's recognized by the given 'Formatter'.
 56-- Non-recognized S-expressions are also returned.
 57findComponents :: Formatter -> [Documented] -> ([Component], [Sexp])
 58findComponents formatFn = foldl foldFunc ([], [])
 59  where
 60    foldFunc (acc, unFmt) (secRaw, com@(DocComment desc)) =
 61        case sectionComment secRaw of
 62            Just sec -> let s = Section sec desc in (acc ++ [S s], unFmt)
 63            Nothing -> (acc, unFmt ++ [com])
 64    foldFunc (acc, unFmt) (desc, expr) =
 65        case formatFn expr desc of
 66            Just c -> (acc ++ [D c], unFmt)
 67            Nothing -> (acc, unFmt ++ [expr])
 68
 69-- | Format all 'Component's which are exported by the given 'L.Library'.
 70format :: L.Library -> [Component] -> Html
 71format lib comps = do
 72    H.h2 "Index"
 73    H.details $ do
 74        H.summary "Table of contents"
 75        tableOfContents finalComps
 76    forM_
 77        finalComps
 78        ( \case
 79            D c -> declFmt c (L.externalId lib $ declId c)
 80            S s -> sectionFmt s
 81        )
 82  where
 83    -- Exclude any non-exported program components.
 84    exportedComps =
 85        filter
 86            ( \case
 87                D c -> L.exports lib $ declId c
 88                S _ -> True
 89            )
 90            comps
 91
 92    -- Extra components to prepend to the component list.
 93    -- Neccessary to ensure that HTML heading structure is always valid.
 94    extraComps =
 95        if any (\case D _ -> False; S _ -> True) exportedComps
 96            then []
 97            else [S defaultSection]
 98
 99    -- Prepend extraComps to the exported components.
100    finalComps = extraComps ++ exportedComps