aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Doc.hs
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Doc.hs')
-rw-r--r--haddock-api/src/Haddock/Doc.hs31
1 files changed, 31 insertions, 0 deletions
diff --git a/haddock-api/src/Haddock/Doc.hs b/haddock-api/src/Haddock/Doc.hs
new file mode 100644
index 00000000..91ad709f
--- /dev/null
+++ b/haddock-api/src/Haddock/Doc.hs
@@ -0,0 +1,31 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Haddock.Doc ( module Documentation.Haddock.Doc
+ , docCodeBlock
+ , combineDocumentation
+ ) where
+
+import Data.Maybe
+import Documentation.Haddock.Doc
+import Haddock.Types
+
+combineDocumentation :: Documentation name -> Maybe (Doc name)
+combineDocumentation (Documentation Nothing Nothing) = Nothing
+combineDocumentation (Documentation mDoc mWarning) =
+ Just (fromMaybe DocEmpty mWarning `docAppend` fromMaybe DocEmpty mDoc)
+
+-- Drop trailing whitespace from @..@ code blocks. Otherwise this:
+--
+-- -- @
+-- -- foo
+-- -- @
+--
+-- turns into (DocCodeBlock "\nfoo\n ") which when rendered in HTML
+-- gives an extra vertical space after the code block. The single space
+-- on the final line seems to trigger the extra vertical space.
+--
+docCodeBlock :: DocH mod id -> DocH mod id
+docCodeBlock (DocString s)
+ = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s)
+docCodeBlock (DocAppend l r)
+ = DocAppend l (docCodeBlock r)
+docCodeBlock d = d