diff options
Diffstat (limited to 'haddock-library/src/Documentation/Haddock')
-rw-r--r-- | haddock-library/src/Documentation/Haddock/Doc.hs | 20 | ||||
-rw-r--r-- | haddock-library/src/Documentation/Haddock/Parser.hs | 6 | ||||
-rw-r--r-- | haddock-library/src/Documentation/Haddock/Types.hs | 20 |
3 files changed, 43 insertions, 3 deletions
diff --git a/haddock-library/src/Documentation/Haddock/Doc.hs b/haddock-library/src/Documentation/Haddock/Doc.hs index 1c20555d..fe8cf99b 100644 --- a/haddock-library/src/Documentation/Haddock/Doc.hs +++ b/haddock-library/src/Documentation/Haddock/Doc.hs @@ -1,12 +1,30 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module Documentation.Haddock.Doc (docParagraph, docAppend, docConcat) where +module Documentation.Haddock.Doc (docParagraph, docAppend, + docConcat, metaDocConcat, + metaDocAppend, emptyMetaDoc) where +import Data.Monoid (mempty, (<>)) import Documentation.Haddock.Types import Data.Char (isSpace) docConcat :: [DocH mod id] -> DocH mod id docConcat = foldr docAppend DocEmpty +-- | Like 'docConcat' but also joins the 'Meta' info. +metaDocConcat :: [MetaDoc mod id] -> MetaDoc mod id +metaDocConcat = foldr metaDocAppend emptyMetaDoc + +-- | We do something perhaps unexpected here and join the meta info +-- in ‘reverse’: this results in the metadata from the ‘latest’ +-- paragraphs taking precedence. +metaDocAppend :: MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id +metaDocAppend (MetaDoc { _meta = m, _doc = d }) + (MetaDoc { _meta = m', _doc = d' }) = + MetaDoc { _meta = m' <> m, _doc = d `docAppend` d' } + +emptyMetaDoc :: MetaDoc mod id +emptyMetaDoc = MetaDoc { _meta = mempty, _doc = DocEmpty } + docAppend :: DocH mod id -> DocH mod id -> DocH mod id docAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2) docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) = DocAppend (DocDefList (ds1++ds2)) d diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index 1cc277b8..b88a8c7f 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -86,9 +86,11 @@ parse p = either err id . parseOnly (p <* endOfInput) -- | Main entry point to the parser. Appends the newline character -- to the input string. parseParas :: String -- ^ String to parse - -> (Maybe Version, DocH mod Identifier) + -> MetaDoc mod Identifier parseParas input = case parseParasState input of - (state, a) -> (parserStateSince state, a) + (state, a) -> MetaDoc { _meta = Meta { _version = parserStateSince state } + , _doc = a + } parseParasState :: String -> (ParserState, DocH mod Identifier) parseParasState = parse (p <* skipSpace) . encodeUtf8 . (++ "\n") diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 92ddeb7e..6f22efb5 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -15,8 +15,28 @@ module Documentation.Haddock.Types where import Data.Foldable +import Data.Monoid import Data.Traversable +-- | With the advent of 'Version', we may want to start attaching more +-- meta-data to comments. We make a structure for this ahead of time +-- so we don't have to gut half the core each time we want to add such +-- info. +newtype Meta = Meta { _version :: Maybe Version } deriving (Eq, Show) + +instance Monoid Meta where + mempty = Meta { _version = Nothing } + Meta { _version = v } `mappend` Meta { _version = v' } = + Meta { _version = v `mappend` v' } + +data MetaDoc mod id = + MetaDoc { _meta :: Meta + , _doc :: DocH mod id + } deriving (Eq, Show, Functor, Foldable, Traversable) + +overDoc :: (DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d +overDoc f d = d { _doc = f $ _doc d } + type Version = [Int] data Hyperlink = Hyperlink |