aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Doc.hs
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2009-11-28 20:15:30 +0000
committerDavid Waern <david.waern@gmail.com>2009-11-28 20:15:30 +0000
commitfba37778cd3eb564c83f1a35e922b8a0a9f111ea (patch)
treed8e94dc594415b2b63a268a16c72a9acef917529 /src/Haddock/Doc.hs
parenta5138aa6b3da207b78f2624f0fb41b0de6e8f02a (diff)
Rename HsDoc back into Doc
Diffstat (limited to 'src/Haddock/Doc.hs')
-rw-r--r--src/Haddock/Doc.hs64
1 files changed, 64 insertions, 0 deletions
diff --git a/src/Haddock/Doc.hs b/src/Haddock/Doc.hs
new file mode 100644
index 00000000..adafc8fd
--- /dev/null
+++ b/src/Haddock/Doc.hs
@@ -0,0 +1,64 @@
+module Haddock.Doc (
+ docAppend,
+ docParagraph
+ ) where
+
+
+import Haddock.Types
+import Data.Char (isSpace)
+
+
+-- used to make parsing easier; we group the list items later
+docAppend :: Doc id -> Doc id -> Doc id
+docAppend (DocUnorderedList ds1) (DocUnorderedList ds2)
+ = DocUnorderedList (ds1++ds2)
+docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d)
+ = DocAppend (DocUnorderedList (ds1++ds2)) d
+docAppend (DocOrderedList ds1) (DocOrderedList ds2)
+ = DocOrderedList (ds1++ds2)
+docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d)
+ = DocAppend (DocOrderedList (ds1++ds2)) d
+docAppend (DocDefList ds1) (DocDefList ds2)
+ = DocDefList (ds1++ds2)
+docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d)
+ = DocAppend (DocDefList (ds1++ds2)) d
+docAppend DocEmpty d = d
+docAppend d DocEmpty = d
+docAppend d1 d2
+ = DocAppend d1 d2
+
+-- again to make parsing easier - we spot a paragraph whose only item
+-- is a DocMonospaced and make it into a DocCodeBlock
+docParagraph :: Doc id -> Doc id
+docParagraph (DocMonospaced p)
+ = DocCodeBlock (docCodeBlock p)
+docParagraph (DocAppend (DocString s1) (DocMonospaced p))
+ | all isSpace s1
+ = DocCodeBlock (docCodeBlock p)
+docParagraph (DocAppend (DocString s1)
+ (DocAppend (DocMonospaced p) (DocString s2)))
+ | all isSpace s1 && all isSpace s2
+ = DocCodeBlock (docCodeBlock p)
+docParagraph (DocAppend (DocMonospaced p) (DocString s2))
+ | all isSpace s2
+ = DocCodeBlock (docCodeBlock p)
+docParagraph p
+ = DocParagraph p
+
+
+-- 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 :: Doc id -> Doc id
+docCodeBlock (DocString s)
+ = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s)
+docCodeBlock (DocAppend l r)
+ = DocAppend l (docCodeBlock r)
+docCodeBlock d = d