[commit: haddock] T6018-injective-type-families, adamse-D1033, ghc-head, master, wip/10268, wip/10313, wip/D538-1, wip/D538-2, wip/D538-3, wip/D538-4, wip/D538-5, wip/D538-6, wip/D548-master, wip/D548-master-2, wip/T10483, wip/T9840, wip/api-annot-tweaks-7.10, wip/api-annots-ghc-7.10-3, wip/orf-reboot: Only keep one Version instead of blindly appending (b8ffb16)

git at git.haskell.org git at git.haskell.org
Wed Jul 8 08:35:33 UTC 2015


Repository : ssh://git@git.haskell.org/haddock

On branches: T6018-injective-type-families,adamse-D1033,ghc-head,master,wip/10268,wip/10313,wip/D538-1,wip/D538-2,wip/D538-3,wip/D538-4,wip/D538-5,wip/D538-6,wip/D548-master,wip/D548-master-2,wip/T10483,wip/T9840,wip/api-annot-tweaks-7.10,wip/api-annots-ghc-7.10-3,wip/orf-reboot
Link       : http://git.haskell.org/haddock.git/commitdiff/b8ffb16aa4e146855c78594879662dc606ffe0b1

>---------------------------------------------------------------

commit b8ffb16aa4e146855c78594879662dc606ffe0b1
Author: Mateusz Kowalczyk <fuuzetsu at fuuzetsu.co.uk>
Date:   Wed Dec 17 09:13:54 2014 +0000

    Only keep one Version instead of blindly appending


>---------------------------------------------------------------

b8ffb16aa4e146855c78594879662dc606ffe0b1
 haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs |  6 +++---
 haddock-library/src/Documentation/Haddock/Doc.hs    | 21 +++++++++++++++++----
 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 921e409..96d734e 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 fe8cf99..66bd1c9 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 6f22efb..4ef8965 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



More information about the ghc-commits mailing list