aboutsummaryrefslogtreecommitdiff
path: root/haddock-library/src
diff options
context:
space:
mode:
authorMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2014-12-17 09:13:54 +0000
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2014-12-17 09:28:59 +0000
commitb8ffb16aa4e146855c78594879662dc606ffe0b1 (patch)
tree11cdfe258edd5547edf7f92833857becfbc1006e /haddock-library/src
parent179a3faca1524f6cb1cd21e0cefc2000bb6480be (diff)
Only keep one Version instead of blindly appending
Diffstat (limited to 'haddock-library/src')
-rw-r--r--haddock-library/src/Documentation/Haddock/Doc.hs21
-rw-r--r--haddock-library/src/Documentation/Haddock/Types.hs6
2 files changed, 17 insertions, 10 deletions
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