scmdoc

  1{-# LANGUAGE OverloadedStrings #-}
  2
  3-- | This module provides data types for building 'Formatter's.
  4module SchemeDoc.Format.Types (
  5    Declaration (declId, declDesc),
  6    mkDeclaration,
  7    declFmt,
  8    Formatable (..),
  9    Formatter,
 10    Section (..),
 11    sectionComment,
 12    defaultSection,
 13    sectionFmt,
 14    Component (..),
 15    compAnchor,
 16    compLink,
 17)
 18where
 19
 20import Control.Monad (unless)
 21import Data.Char (isSpace)
 22import Data.Maybe (fromMaybe)
 23import qualified Data.Text as T
 24import SchemeDoc.Format.Util (fromMkd)
 25import SchemeDoc.Types
 26
 27import Text.Blaze.Html
 28import qualified Text.Blaze.Html5 as H
 29import qualified Text.Blaze.Html5.Attributes as A
 30
 31-- | Type class to convert a given type to a formatted S-expression.
 32class Formatable a where
 33    -- Create a 'Declaration' using the given documentation.
 34    fmt :: a -> T.Text -> Declaration
 35
 36-- | A high-level declaration in the Scheme source code, e.g. a
 37-- 'SchemeDoc.Format.Library' declaration.
 38data Declaration = Declaration
 39    { declId :: T.Text
 40    -- ^ Internal identifier of the declaration.
 41    , declDesc :: T.Text
 42    -- ^ Documentation for the declaration, i.e. the 'DocComment' preceding it.
 43    , declFmt' :: T.Text -> Html
 44    }
 45
 46-- | Create a new 'Declaration' with a given identifier, description and format function.
 47mkDeclaration :: T.Text -> T.Text -> (T.Text -> Html) -> Declaration
 48mkDeclaration = Declaration
 49
 50-- | Format a declaration with an optional external identifier.
 51declFmt :: Declaration -> Maybe T.Text -> Html
 52declFmt d newName = declFmt' d $ fromMaybe (declId d) newName
 53
 54-- | Function for converting an S-expression into a 'Declaration'
 55-- based on the given documentation for the S-expression.
 56type Formatter = Sexp -> T.Text -> Maybe Declaration
 57
 58------------------------------------------------------------------------
 59
 60-- | Section represents a section comment in the source.
 61data Section
 62    = Section
 63        T.Text
 64        -- ^ Section title.
 65        T.Text
 66        -- ^ Sectiond description.
 67
 68-- Character used to identify section comments.
 69sectionChar :: Char
 70sectionChar = '|'
 71
 72-- Remove all leading ASCII space characters.
 73ltrim :: T.Text -> T.Text
 74ltrim = T.dropWhile isSpace
 75
 76-- Remove all trailing ASCII space characters.
 77rtrim :: T.Text -> T.Text
 78rtrim = T.dropWhileEnd isSpace
 79
 80-- Remove all trailing and leading ASCII space characters.
 81trim :: T.Text -> T.Text
 82trim = rtrim . ltrim
 83
 84-- | If the given comment text constitutes a 'Section' title
 85-- return the title, otherwise return 'Nothing'.
 86sectionComment :: T.Text -> Maybe T.Text
 87sectionComment t =
 88    if T.length t >= 1 && T.head t == sectionChar
 89        then Just (ltrim $ T.tail t)
 90        else Nothing
 91
 92-- | Default section, used if the input file doesn't contain a single
 93-- section comment of its own.
 94defaultSection :: Section
 95defaultSection = Section "Declarations" ""
 96
 97-- | Format a section comment as 'Html'.
 98sectionFmt :: Section -> Html
 99sectionFmt s@(Section n desc) = do
100    -- TODO: Add <section> tags for each H2
101    H.h2 ! A.id (textValue $ compAnchor (S s)) $
102        toHtml n
103    unless (T.null desc) $ do
104        H.p $ fromMkd desc
105
106------------------------------------------------------------------------
107
108-- | Component in the documented source code.
109-- This is either a 'Declaration' or a 'Section' comment.
110data Component = D Declaration | S Section
111
112-- | Unique anchor for a compoment.
113compAnchor :: Component -> T.Text
114compAnchor (D c) = declId c -- TODO: Ensure that this is aligned with format function
115compAnchor (S (Section n _)) = "section-" `T.append` toAnchor n
116  where
117    toAnchor :: T.Text -> T.Text
118    toAnchor = T.map (\c -> if isSpace c then '-' else c) . T.toLower . trim
119
120-- | Generate an anchor tag which links to a given 'Component'.
121compLink :: Component -> Html
122compLink c = do
123    H.a ! A.href (textValue $ T.cons '#' (compAnchor c)) $
124        toHtml (compName c)
125  where
126    compName :: Component -> T.Text
127    compName (D c') = declId c'
128    compName (S (Section n _)) = n