Nesting

bold What is tested here:
Deprecation messages are shown for re-exported items. -
Deprecation messages are shown for re-exported items.
+Nesting
Contents
Index

Safe Haskell Safe-Inferred
Nesting
Synopsis
d :: t
e :: t
f :: t
g :: t
h :: t
i :: t
j :: t
Documentation
d :: t
We can
easily go back
some indentation
levels
back at the top
e :: t
Beginning of list
second list
Some indented list but +the presence of this text pushes it out of nesting back to the top.
f :: t
Beginning of list
nested code + we preserve the space correctly +
g :: t
Beginning of list
Nested list
h :: t
Beginning of list
nested + bird + tracks
i :: t
Beginning of list +This belongs to the list above!
nested + bird + tracks
Next list +More of the indented list.
Deeper
Deeper
Even deeper!
No newline separation even in indented lists.
j :: t
All this
Works for +definition lists too.
nested + bird + tracks
Next list +with more of the indented list content.
Even more content on a new line.
Different type of list
Deeper
>>> Here's an example in a list +example result +
b
Even deeper!
c
No newline separation even in indented lists. + We can have any paragraph level element that we normally + can, like headers
Level 3 header
with some content…
and even more lists inside
Produced by Haddock version 2.14.0
diff --git a/html-test/ref/PruneWithWarning.html b/html-test/ref/PruneWithWarning.html index 837c28b4..4fba05b6 100644 --- a/html-test/ref/PruneWithWarning.html +++ b/html-test/ref/PruneWithWarning.html @@ -52,8 +52,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_PruneWithWarning.html" >If a binding has a deprecation message but no documentation, it is pruned when OPTIONS_HADDOCK prune is used. - is used..
This is a bulleted list -
This is a bulleted list
This is the next item (different kind of bullet) -
This is the next item (different kind of bullet)
This is an ordered list -
This is an ordered list
This is the next item (different kind of bullet) -
This is the next item (different kind of bullet)
cat
a small, furry, domesticated mammal -
a small, furry, domesticated mammal
pineapple
a fruit grown in the tropics -
a fruit grown in the tropics
This is a block of code, which can include other markup: nested + > bird + > tracks +-} +h :: t +h = undefined + +{-| +* Beginning of list +This belongs to the list above! + + > nested + > bird + > tracks + + * Next list + More of the indented list. + + * Deeper + + * Deeper + + * Even deeper! + * No newline separation even in indented lists. +-} +i :: t +i = undefined + + + +{-| +[All this] Works for +definition lists too. + + > nested + > bird + > tracks + + * Next list + with more of the indented list content. + + Even more content on a new line. + + 1. Different type of list + + (2) Deeper + + >>> Here's an example in a list + example result + + [b] Even deeper! + [c] No newline separation even in indented lists. + We can have any paragraph level element that we normally + can, like headers + + === Level 3 header + with some content… + + * and even more lists inside +-} +j :: t +j = undefined diff --git a/src/Haddock/Doc.hs b/src/Haddock/Doc.hs index 69b2dd6f..55d4e303 100644 --- a/src/Haddock/Doc.hs +++ b/src/Haddock/Doc.hs @@ -23,6 +23,8 @@ combineDocumentation (Documentation mDoc mWarning) = Just (fromMaybe mempty mW docAppend :: Doc id -> Doc id -> Doc 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 (DocUnorderedList ds1) (DocUnorderedList ds2) = DocUnorderedList (ds1 ++ ds2) docAppend DocEmpty d = d docAppend d DocEmpty = d docAppend (DocString s1) (DocString s2) = DocString (s1 ++ s2) diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs index 0d24cf17..b8aa9cb4 100644 --- a/src/Haddock/Parser.hs +++ b/src/Haddock/Parser.hs @@ -1,4 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving + , FlexibleInstances, UndecidableInstances + , IncoherentInstances #-} -- | -- Module : Haddock.Parser -- Copyright : (c) Mateusz Kowalczyk 2013, @@ -12,6 +15,7 @@ module Haddock.Parser (parseString, parseParas, parseStringMaybe, parseParasMaybe) where import Prelude hiding (takeWhile) +import Control.Arrow (first) import Control.Monad (void, mfilter) import Control.Applicative import Data.Attoparsec.ByteString.Char8 hiding (parse, take, endOfLine) @@ -208,36 +212,93 @@ orderedList d = (paren <|> dot) *> innerList (orderedList d) d innerList :: Parser [Doc RdrName] -> DynFlags -> Parser [Doc RdrName] innerList item d = do c <- takeLine - (cs, items) <- more - let contents = (docParagraph . parseString d . unlines) (c : cs) - return (contents : items) - where - more :: Parser ([String], [Doc RdrName]) - more = moreListItems <|> moreContent <|> pure ([], []) - - moreListItems :: Parser ([String], [Doc RdrName]) - moreListItems = (,) [] <$> (skipSpace *> item) - - moreContent :: Parser ([String], [Doc RdrName]) - moreContent = mapFst . (:) <$> nonEmptyLine <*> more + (cs, items) <- more item d + let contents = docParagraph . parseString d . dropNLs . unlines $ c : cs + return $ case items of + Left p -> [contents `joinPara` p] + Right i -> contents : i -- | Parses definition lists. definitionList :: DynFlags -> Parser [(Doc RdrName, Doc RdrName)] definitionList d = do - label <- parseStringBS d <$> ("[" *> takeWhile1 (`notElem` "]\n") <* "]") + label <- "[" *> (parseStringBS d <$> takeWhile1 (`notElem` "]\n")) <* "]" c <- takeLine - (cs, items) <- more - let contents = (parseString d . unlines) (c : cs) - return ((label, contents) : items) + (cs, items) <- more (definitionList d) d + let contents = parseString d . dropNLs . unlines $ c : cs + return $ case items of + Left p -> [(label, contents `joinPara` p)] + Right i -> (label, contents) : i + +-- | If possible, appends two 'Doc's under a 'DocParagraph' rather than +-- outside of it. This allows to get structures like +-- +-- @DocParagraph (DocAppend … …)@ +-- +-- rather than +-- +-- @DocAppend (DocParagraph …) …@ +joinPara :: Doc id -> Doc id -> Doc id +joinPara (DocParagraph p) c = docParagraph $ docAppend p c +joinPara d p = docAppend d p + +-- | Drops all trailing newlines. +dropNLs :: String -> String +dropNLs = reverse . dropWhile (== '\n') . reverse + +-- | Main worker for 'innerList' and 'definitionList'. +-- We need the 'Either' here to be able to tell in the respective functions +-- whether we're dealing with the next list or a nested paragraph. +more :: Monoid a => Parser a -> DynFlags + -> Parser ([String], Either (Doc RdrName) a) +more item d = innerParagraphs d <|> moreListItems item + <|> moreContent item d <|> pure ([], Right mempty) + +-- | Use by 'innerList' and 'definitionList' to parse any nested paragraphs. +innerParagraphs :: DynFlags + -> Parser ([String], Either (Doc RdrName) a) +innerParagraphs d = (,) [] . Left <$> ("\n" *> indentedParagraphs d) + +-- | Attemps to fetch the next list if possibly. Used by 'innerList' and +-- 'definitionList' to recursivly grab lists that aren't separated by a whole +-- paragraph. +moreListItems :: Parser a + -> Parser ([String], Either (Doc RdrName) a) +moreListItems item = (,) [] . Right <$> (skipSpace *> item) + +-- | Helper for 'innerList' and 'definitionList' which simply takes +-- a line of text and attempts to parse more list content with 'more'. +moreContent :: Monoid a => Parser a -> DynFlags + -> Parser ([String], Either (Doc RdrName) a) +moreContent item d = first . (:) <$> nonEmptyLine <*> more item d + +-- | Collects and parses the result of 'dropFrontOfPara' +indentedParagraphs :: DynFlags -> Parser (Doc RdrName) +indentedParagraphs d = parseParas d . concat <$> dropFrontOfPara " " + +-- | Grab as many fully indented paragraphs as we can. +dropFrontOfPara :: Parser BS.ByteString -> Parser [String] +dropFrontOfPara sp = do + currentParagraph <- some (sp *> takeNonEmptyLine) + followingParagraphs <- + skipHorizontalSpace *> nextPar -- we have more paragraphs to take + <|> skipHorizontalSpace *> nlList -- end of the ride, remember the newline + <|> endOfInput *> return [] -- nothing more to take at all + return (currentParagraph ++ followingParagraphs) where - more :: Parser ([String], [(Doc RdrName, Doc RdrName)]) - more = moreListItems <|> moreContent <|> pure ([], []) + nextPar = (++) <$> nlList <*> dropFrontOfPara sp + nlList = "\n" *> return ["\n"] - moreListItems :: Parser ([String], [(Doc RdrName, Doc RdrName)]) - moreListItems = (,) [] <$> (skipSpace *> definitionList d) +nonSpace :: BS.ByteString -> Parser BS.ByteString +nonSpace xs + | not $ any (not . isSpace) $ decodeUtf8 xs = fail "empty line" + | otherwise = return xs - moreContent :: Parser ([String], [(Doc RdrName, Doc RdrName)]) - moreContent = mapFst . (:) <$> nonEmptyLine <*> more +-- | Takes a non-empty, not fully whitespace line. +-- +-- Doesn't discard the trailing newline. +takeNonEmptyLine :: Parser String +takeNonEmptyLine = do + (++ "\n") . decodeUtf8 <$> (takeWhile1 (/= '\n') >>= nonSpace) <* "\n" birdtracks :: Parser (Doc a) birdtracks = DocCodeBlock . DocString . intercalate "\n" <$> many1 line @@ -263,7 +324,7 @@ examples = DocExamples <$> (many (skipHorizontalSpace *> "\n") *> go) moreExamples = (,) [] <$> go result :: Parser ([String], [Example]) - result = mapFst . (:) <$> nonEmptyLine <*> resultAndMoreExamples + result = first . (:) <$> nonEmptyLine <*> resultAndMoreExamples makeExample :: String -> String -> [String] -> Example makeExample prefix expression res = @@ -285,9 +346,6 @@ takeLine = decodeUtf8 <$> takeWhile (/= '\n') <* endOfLine endOfLine :: Parser () endOfLine = void "\n" <|> endOfInput -mapFst :: (a -> b) -> (a, c) -> (b, c) -mapFst f (a, b) = (f a, b) - -- | Property parser. -- -- >>> parseOnly property "prop> hello world" diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index f90e5496..0a633ec0 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | diff --git a/test/Haddock/ParserSpec.hs b/test/Haddock/ParserSpec.hs index b5a9561f..4679661f 100644 --- a/test/Haddock/ParserSpec.hs +++ b/test/Haddock/ParserSpec.hs @@ -392,14 +392,85 @@ spec = before initStaticOpts $ do , Example "fib 10" ["55"] ] - it "requires an example to be separated from a previous paragraph by an empty line" $ do - unlines [ - "foobar" - , "" - , ">>> fib 10" - , "55" - ] `shouldParseTo` DocParagraph "foobar" - <> DocExamples [Example "fib 10" ["55"]] + + context "when parsing paragraphs nested in lists" $ do + it "can nest the same type of list" $ do + "* foo\n\n * bar" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocUnorderedList [DocParagraph "bar"]] + + it "can nest another type of list inside" $ do + "* foo\n\n 1. bar" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocOrderedList [DocParagraph "bar"]] + + it "can nest a code block inside" $ do + "* foo\n\n @foo bar baz@" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocCodeBlock "foo bar baz"] + + "* foo\n\n @\n foo bar baz\n @" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocCodeBlock "foo bar baz\n"] + + it "can nest more than one level" $ do + "* foo\n\n * bar\n\n * baz\n qux" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocUnorderedList [ DocParagraph $ "bar" + <> DocUnorderedList [DocParagraph "baz\nqux"] + ] + ] + + it "won't fail on not fully indented paragraph" $ do + "* foo\n\n * bar\n\n * qux\nquux" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocUnorderedList [ DocParagraph "bar" ] + , DocParagraph "qux\nquux"] + + + it "can nest definition lists" $ do + "[a] foo\n\n [b] bar\n\n [c] baz\n qux" `shouldParseTo` + DocDefList [ ("a", "foo" + <> DocDefList [ ("b", "bar" + <> DocDefList [("c", "baz\nqux")]) + ]) + ] + + it "can come back to top level with a different list" $ do + "* foo\n\n * bar\n\n1. baz" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocUnorderedList [ DocParagraph "bar" ] + ] + <> DocOrderedList [ DocParagraph "baz" ] + + it "definition lists can come back to top level with a different list" $ do + "[foo] foov\n\n [bar] barv\n\n1. baz" `shouldParseTo` + DocDefList [ ("foo", "foov" + <> DocDefList [ ("bar", "barv") ]) + ] + <> DocOrderedList [ DocParagraph "baz" ] + + + context "when parsing consecutive paragraphs" $ do + it "will not capture irrelevant consecutive lists" $ do + " * bullet\n\n - different bullet\n\n (1) ordered\n \n " + ++ "2. different bullet\n \n [cat] kitten\n \n [pineapple] fruit" + `shouldParseTo` + DocUnorderedList [ DocParagraph "bullet" + , DocParagraph "different bullet"] + <> DocOrderedList [ DocParagraph "ordered" + , DocParagraph "different bullet" + ] + <> DocDefList [ ("cat", "kitten") + , ("pineapple", "fruit") + ] + + context "when parsing an example" $ do + it ("requires an example to be separated" + ++ " from a previous paragraph by an empty line") $ do + "foobar\n\n>>> fib 10\n55" `shouldParseTo` + DocParagraph "foobar" + <> DocExamples [Example "fib 10" ["55"]] it "parses bird-tracks inside of paragraphs as plain strings" $ do let xs = "foo\n>>> bar" @@ -478,9 +549,9 @@ spec = before initStaticOpts $ do , " * three" ] `shouldParseTo` DocUnorderedList [ - DocParagraph "one\n" - , DocParagraph "two\n" - , DocParagraph "three\n" + DocParagraph "one" + , DocParagraph "two" + , DocParagraph "three" ] it "ignores empty lines between list items" $ do @@ -490,8 +561,8 @@ spec = before initStaticOpts $ do , "* two" ] `shouldParseTo` DocUnorderedList [ - DocParagraph "one\n" - , DocParagraph "two\n" + DocParagraph "one" + , DocParagraph "two" ] it "accepts an empty list item" $ do @@ -505,12 +576,12 @@ spec = before initStaticOpts $ do , "more two" ] `shouldParseTo` DocUnorderedList [ - DocParagraph "point one\n more one\n" - , DocParagraph "point two\nmore two\n" + DocParagraph "point one\n more one" + , DocParagraph "point two\nmore two" ] it "accepts markup in list items" $ do - "* /foo/" `shouldParseTo` DocUnorderedList [DocParagraph (DocEmphasis "foo" <> "\n")] + "* /foo/" `shouldParseTo` DocUnorderedList [DocParagraph (DocEmphasis "foo")] it "requires empty lines between list and other paragraphs" $ do unlines [ @@ -520,7 +591,7 @@ spec = before initStaticOpts $ do , "" , "baz" ] - `shouldParseTo` DocParagraph "foo" <> DocUnorderedList [DocParagraph "bar\n"] <> DocParagraph "baz" + `shouldParseTo` DocParagraph "foo" <> DocUnorderedList [DocParagraph "bar"] <> DocParagraph "baz" context "when parsing ordered lists" $ do it "parses a simple list" $ do @@ -530,9 +601,9 @@ spec = before initStaticOpts $ do , " 3. three" ] `shouldParseTo` DocOrderedList [ - DocParagraph "one\n" - , DocParagraph "two\n" - , DocParagraph "three\n" + DocParagraph "one" + , DocParagraph "two" + , DocParagraph "three" ] it "ignores empty lines between list items" $ do @@ -542,8 +613,8 @@ spec = before initStaticOpts $ do , "2. two" ] `shouldParseTo` DocOrderedList [ - DocParagraph "one\n" - , DocParagraph "two\n" + DocParagraph "one" + , DocParagraph "two" ] it "accepts an empty list item" $ do @@ -557,12 +628,12 @@ spec = before initStaticOpts $ do , "more two" ] `shouldParseTo` DocOrderedList [ - DocParagraph "point one\n more one\n" - , DocParagraph "point two\nmore two\n" + DocParagraph "point one\n more one" + , DocParagraph "point two\nmore two" ] it "accepts markup in list items" $ do - "1. /foo/" `shouldParseTo` DocOrderedList [DocParagraph (DocEmphasis "foo" <> "\n")] + "1. /foo/" `shouldParseTo` DocOrderedList [DocParagraph (DocEmphasis "foo")] it "requires empty lines between list and other paragraphs" $ do unlines [ @@ -572,7 +643,7 @@ spec = before initStaticOpts $ do , "" , "baz" ] - `shouldParseTo` DocParagraph "foo" <> DocOrderedList [DocParagraph "bar\n"] <> DocParagraph "baz" + `shouldParseTo` DocParagraph "foo" <> DocOrderedList [DocParagraph "bar"] <> DocParagraph "baz" context "when parsing definition lists" $ do it "parses a simple list" $ do @@ -582,9 +653,9 @@ spec = before initStaticOpts $ do , " [baz] three" ] `shouldParseTo` DocDefList [ - ("foo", "one\n") - , ("bar", "two\n") - , ("baz", "three\n") + ("foo", "one") + , ("bar", "two") + , ("baz", "three") ] it "ignores empty lines between list items" $ do @@ -594,8 +665,8 @@ spec = before initStaticOpts $ do , "[bar] two" ] `shouldParseTo` DocDefList [ - ("foo", "one\n") - , ("bar", "two\n") + ("foo", "one") + , ("bar", "two") ] it "accepts an empty list item" $ do @@ -609,15 +680,15 @@ spec = before initStaticOpts $ do , "more two" ] `shouldParseTo` DocDefList [ - ("foo", "point one\n more one\n") - , ("bar", "point two\nmore two\n") + ("foo", "point one\n more one") + , ("bar", "point two\nmore two") ] it "accepts markup in list items" $ do - "[foo] /foo/" `shouldParseTo` DocDefList [("foo", DocEmphasis "foo" <> "\n")] + "[foo] /foo/" `shouldParseTo` DocDefList [("foo", DocEmphasis "foo")] it "accepts markup for the label" $ do - "[/foo/] bar" `shouldParseTo` DocDefList [(DocEmphasis "foo", "bar\n")] + "[/foo/] bar" `shouldParseTo` DocDefList [(DocEmphasis "foo", "bar")] it "requires empty lines between list and other paragraphs" $ do unlines [ @@ -627,7 +698,7 @@ spec = before initStaticOpts $ do , "" , "baz" ] - `shouldParseTo` DocParagraph "foo" <> DocDefList [("foo", "bar\n")] <> DocParagraph "baz" + `shouldParseTo` DocParagraph "foo" <> DocDefList [("foo", "bar")] <> DocParagraph "baz" context "when parsing consecutive paragraphs" $ do it "accepts consecutive lists" $ do @@ -644,14 +715,14 @@ spec = before initStaticOpts $ do , " " , " [pineapple] fruit" ] `shouldParseTo` DocUnorderedList [ - DocParagraph "foo\n" - , DocParagraph "bar\n" + DocParagraph "foo" + , DocParagraph "bar" ] <> DocOrderedList [ - DocParagraph "ordered foo\n" - , DocParagraph "ordered bar\n" + DocParagraph "ordered foo" + , DocParagraph "ordered bar" ] <> DocDefList [ - ("cat", "kitten\n") - , ("pineapple", "fruit\n") + ("cat", "kitten") + , ("pineapple", "fruit") ] context "when parsing function documentation headers" $ do -- cgit v1.2.3