aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Doc.hs
diff options
context:
space:
mode:
authorMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2013-07-09 14:24:10 +0100
committerAustin Seipp <austin@well-typed.com>2014-01-12 14:48:35 -0600
commitbb6cef20b82ef7a7f2d49f3ef6dc1a7ce880b5f0 (patch)
treeea07b1d4ab43169bc8d7074ff05bf1792c93feb0 /src/Haddock/Doc.hs
parentc1228df0339d041b455bb993786a9ed6322c5e01 (diff)
One pass parser and tests.
We remove the HTML test as it is no longer necessary. We cover the test case in spec tests and other HTML tests but keeping this around fails: this is because the new parser has different semantics there. In fact, I suspect the original behaviour was a bug that wasn't caught/fixed but simply included as-is during the testing.
Diffstat (limited to 'src/Haddock/Doc.hs')
-rw-r--r--src/Haddock/Doc.hs20
1 files changed, 18 insertions, 2 deletions
diff --git a/src/Haddock/Doc.hs b/src/Haddock/Doc.hs
index 18555cfb..4d68c554 100644
--- a/src/Haddock/Doc.hs
+++ b/src/Haddock/Doc.hs
@@ -1,14 +1,27 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
module Haddock.Doc (
docAppend,
docParagraph,
- combineStringNodes
+ combineStringNodes,
+ combineDocumentation
) where
-
+import Data.Maybe
+import Data.Monoid
import Haddock.Types
import Data.Char (isSpace)
import Control.Arrow ((***))
+-- We put it here so that we can avoid a circular import
+-- anything relevant imports this module anyway
+instance Monoid (Doc id) where
+ mempty = DocEmpty
+ mappend = docAppend
+
+combineDocumentation :: Documentation name -> Maybe (Doc name)
+combineDocumentation (Documentation Nothing Nothing) = Nothing
+combineDocumentation (Documentation mDoc mWarning) = Just (fromMaybe mempty mWarning `mappend` fromMaybe mempty mDoc)
+
-- used to make parsing easier; we group the list items later
docAppend :: Doc id -> Doc id -> Doc id
docAppend (DocUnorderedList ds1) (DocUnorderedList ds2)
@@ -85,4 +98,7 @@ combineStringNodes x = x
tryjoin :: Doc id -> Doc id
tryjoin (DocAppend (DocString x) (DocString y)) = DocString (x ++ y)
+tryjoin (DocAppend (DocString x) (DocAppend (DocString y) z)) = DocAppend (DocString (x ++ y)) z
+tryjoin (DocAppend (DocAppend x (DocString y)) (DocString z))
+ = tryjoin (DocAppend (combineStringNodes x) (DocString $ y ++ z))
tryjoin x = x