Move sources under haddock-api/src

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