aboutsummaryrefslogtreecommitdiff
path: root/haddock-library/src/Documentation/Haddock
diff options
context:
space:
mode:
authorMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2014-07-28 14:31:03 +0200
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2014-08-15 02:47:40 +0100
commit08db4c81ffac672a4a5a90291be70279e9a1f098 (patch)
treecc51e2fa2fdc49b64a584b990a66752a152a3d8f /haddock-library/src/Documentation/Haddock
parent5c93cc347773c7634321edd5f808d5b55b46301f (diff)
Fix #313 by doing some list munging.
I get rid of the Monoid instance because we weren't satisfying the laws. Convenience of having <> didn't outweigh the shock-factor of having it behave badly.
Diffstat (limited to 'haddock-library/src/Documentation/Haddock')
-rw-r--r--haddock-library/src/Documentation/Haddock/Doc.hs12
-rw-r--r--haddock-library/src/Documentation/Haddock/Parser.hs26
2 files changed, 18 insertions, 20 deletions
diff --git a/haddock-library/src/Documentation/Haddock/Doc.hs b/haddock-library/src/Documentation/Haddock/Doc.hs
index 4d6c10a4..1c20555d 100644
--- a/haddock-library/src/Documentation/Haddock/Doc.hs
+++ b/haddock-library/src/Documentation/Haddock/Doc.hs
@@ -1,21 +1,19 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Documentation.Haddock.Doc (docParagraph) where
+module Documentation.Haddock.Doc (docParagraph, docAppend, docConcat) where
-import Data.Monoid
import Documentation.Haddock.Types
import Data.Char (isSpace)
--- We put it here so that we can avoid a circular import
--- anything relevant imports this module anyway
-instance Monoid (DocH mod id) where
- mempty = DocEmpty
- mappend = docAppend
+docConcat :: [DocH mod id] -> DocH mod id
+docConcat = foldr docAppend DocEmpty
docAppend :: DocH mod id -> DocH mod id -> DocH mod id
docAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2)
docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) = DocAppend (DocDefList (ds1++ds2)) d
docAppend (DocOrderedList ds1) (DocOrderedList ds2) = DocOrderedList (ds1 ++ ds2)
+docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d) = DocAppend (DocOrderedList (ds1++ds2)) d
docAppend (DocUnorderedList ds1) (DocUnorderedList ds2) = DocUnorderedList (ds1 ++ ds2)
+docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d) = DocAppend (DocUnorderedList (ds1++ds2)) d
docAppend DocEmpty d = d
docAppend d DocEmpty = d
docAppend (DocString s1) (DocString s2) = DocString (s1 ++ s2)
diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 68d9ecec..ab3f3625 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -93,7 +93,7 @@ parseParas :: String -- ^ String to parse
parseParas = parse (p <* skipSpace) . encodeUtf8 . (++ "\n")
where
p :: Parser (DocH mod Identifier)
- p = mconcat <$> paragraph `sepBy` many (skipHorizontalSpace *> "\n")
+ p = docConcat <$> paragraph `sepBy` many (skipHorizontalSpace *> "\n")
-- | Parse a text paragraph. Actually just a wrapper over 'parseStringBS' which
-- drops leading whitespace and encodes the string to UTF8 first.
@@ -104,10 +104,10 @@ parseStringBS :: BS.ByteString -> DocH mod Identifier
parseStringBS = parse p
where
p :: Parser (DocH mod Identifier)
- p = mconcat <$> many (monospace <|> anchor <|> identifier <|> moduleName
- <|> picture <|> hyperlink <|> bold
- <|> emphasis <|> encodedChar <|> string'
- <|> skipSpecialChar)
+ p = docConcat <$> many (monospace <|> anchor <|> identifier <|> moduleName
+ <|> picture <|> hyperlink <|> bold
+ <|> emphasis <|> encodedChar <|> string'
+ <|> skipSpecialChar)
-- | Parses and processes
-- <https://en.wikipedia.org/wiki/Numeric_character_reference Numeric character references>
@@ -231,8 +231,8 @@ header = do
pser = foldl1 (<|>) psers
delim <- decodeUtf8 <$> pser
line <- skipHorizontalSpace *> nonEmptyLine >>= return . parseString
- rest <- paragraph <|> return mempty
- return $ DocHeader (Header (length delim) line) <> rest
+ rest <- paragraph <|> return DocEmpty
+ return $ DocHeader (Header (length delim) line) `docAppend` rest
textParagraph :: Parser (DocH mod Identifier)
textParagraph = docParagraph . parseString . intercalate "\n" <$> many1 nonEmptyLine
@@ -265,7 +265,7 @@ innerList item = do
(cs, items) <- more item
let contents = docParagraph . parseString . dropNLs . unlines $ c : cs
return $ case items of
- Left p -> [contents <> p]
+ Left p -> [contents `docAppend` p]
Right i -> contents : i
-- | Parses definition lists.
@@ -276,7 +276,7 @@ definitionList = do
(cs, items) <- more definitionList
let contents = parseString . dropNLs . unlines $ c : cs
return $ case items of
- Left p -> [(label, contents <> p)]
+ Left p -> [(label, contents `docAppend` p)]
Right i -> (label, contents) : i
-- | Drops all trailing newlines.
@@ -291,12 +291,12 @@ more :: Monoid a => Parser a
more item = innerParagraphs <|> moreListItems item
<|> moreContent item <|> pure ([], Right mempty)
--- | Use by 'innerList' and 'definitionList' to parse any nested paragraphs.
+-- | Used by 'innerList' and 'definitionList' to parse any nested paragraphs.
innerParagraphs :: Parser ([String], Either (DocH mod Identifier) a)
innerParagraphs = (,) [] . Left <$> ("\n" *> indentedParagraphs)
--- | Attemps to fetch the next list if possibly. Used by 'innerList' and
--- 'definitionList' to recursivly grab lists that aren't separated by a whole
+-- | Attempts to fetch the next list if possibly. Used by 'innerList' and
+-- 'definitionList' to recursively grab lists that aren't separated by a whole
-- paragraph.
moreListItems :: Parser a
-> Parser ([String], Either (DocH mod Identifier) a)
@@ -456,7 +456,7 @@ autoUrl = mkLink <$> url
url = mappend <$> ("http://" <|> "https://" <|> "ftp://") <*> takeWhile1 (not . isSpace)
mkLink :: BS.ByteString -> DocH mod a
mkLink s = case unsnoc s of
- Just (xs, x) | x `elem` ",.!?" -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) <> DocString [x]
+ Just (xs, x) | x `elem` ",.!?" -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) `docAppend` DocString [x]
_ -> DocHyperlink (Hyperlink (decodeUtf8 s) Nothing)
-- | Parses strings between identifier delimiters. Consumes all input that it