diff options
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs | 6 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Doc.hs | 21 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Types.hs | 6 |
3 files changed, 20 insertions, 13 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index 921e4090..96d734eb 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -22,12 +22,12 @@ module Haddock.Backends.Xhtml.DocMarkup ( import Control.Applicative ((<$>)) import Data.List -import Data.Monoid (mconcat) import Haddock.Backends.Xhtml.Names import Haddock.Backends.Xhtml.Utils import Haddock.Types import Haddock.Utils -import Haddock.Doc (combineDocumentation, emptyMetaDoc, metaDocAppend) +import Haddock.Doc (combineDocumentation, emptyMetaDoc, + metaDocAppend, metaConcat) import Text.XHtml hiding ( name, p, quote ) import Data.Maybe (fromMaybe) @@ -152,7 +152,7 @@ flatten x = [x] hackMarkup :: DocMarkup id Html -> Hack (ModuleName, OccName) id -> Html hackMarkup fmt' h' = let (html, ms) = hackMarkup' fmt' h' - in html +++ renderMeta fmt' (mconcat ms) + in html +++ renderMeta fmt' (metaConcat ms) where hackMarkup' :: DocMarkup id Html -> Hack (ModuleName, OccName) id -> (Html, [Meta]) diff --git a/haddock-library/src/Documentation/Haddock/Doc.hs b/haddock-library/src/Documentation/Haddock/Doc.hs index fe8cf99b..66bd1c97 100644 --- a/haddock-library/src/Documentation/Haddock/Doc.hs +++ b/haddock-library/src/Documentation/Haddock/Doc.hs @@ -1,15 +1,20 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Documentation.Haddock.Doc (docParagraph, docAppend, docConcat, metaDocConcat, - metaDocAppend, emptyMetaDoc) where + metaDocAppend, emptyMetaDoc, + metaAppend, metaConcat) where -import Data.Monoid (mempty, (<>)) +import Control.Applicative ((<|>), empty) import Documentation.Haddock.Types import Data.Char (isSpace) docConcat :: [DocH mod id] -> DocH mod id docConcat = foldr docAppend DocEmpty +-- | Concat using 'metaAppend'. +metaConcat :: [Meta] -> Meta +metaConcat = foldr metaAppend emptyMeta + -- | Like 'docConcat' but also joins the 'Meta' info. metaDocConcat :: [MetaDoc mod id] -> MetaDoc mod id metaDocConcat = foldr metaDocAppend emptyMetaDoc @@ -20,10 +25,18 @@ metaDocConcat = foldr metaDocAppend emptyMetaDoc 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' } + MetaDoc { _meta = m' `metaAppend` m, _doc = d `docAppend` d' } + +-- | This is not a monoidal append, it uses '<|>' for the '_version'. +metaAppend :: Meta -> Meta -> Meta +metaAppend (Meta { _version = v }) (Meta { _version = v' }) = + Meta { _version = v <|> v' } emptyMetaDoc :: MetaDoc mod id -emptyMetaDoc = MetaDoc { _meta = mempty, _doc = DocEmpty } +emptyMetaDoc = MetaDoc { _meta = emptyMeta, _doc = DocEmpty } + +emptyMeta :: Meta +emptyMeta = Meta { _version = empty } docAppend :: DocH mod id -> DocH mod id -> DocH mod id docAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2) diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 6f22efb5..4ef89658 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -15,7 +15,6 @@ 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 @@ -24,11 +23,6 @@ import Data.Traversable -- 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 |