diff options
Diffstat (limited to 'haddock-library')
4 files changed, 42 insertions, 27 deletions
diff --git a/haddock-library/src/Documentation/Haddock/Markup.hs b/haddock-library/src/Documentation/Haddock/Markup.hs index 0919737f..28c5c2ca 100644 --- a/haddock-library/src/Documentation/Haddock/Markup.hs +++ b/haddock-library/src/Documentation/Haddock/Markup.hs @@ -22,7 +22,7 @@ markup m (DocEmphasis d) = markupEmphasis m (markup m d) markup m (DocBold d) = markupBold m (markup m d) markup m (DocMonospaced d) = markupMonospaced m (markup m d) markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds) -markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds) +markup m (DocOrderedList ds) = markupOrderedList m (map (\(index, a) -> (index, markup m a)) ds) markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds) markup m (DocCodeBlock d) = markupCodeBlock m (markup m d) markup m (DocHyperlink (Hyperlink u l)) = markupHyperlink m (Hyperlink u (fmap (markup m) l)) diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index c6d7e59b..19c92721 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -78,7 +78,7 @@ overIdentifier f d = g d g (DocMonospaced x) = DocMonospaced $ g x g (DocBold x) = DocBold $ g x g (DocUnorderedList x) = DocUnorderedList $ fmap g x - g (DocOrderedList x) = DocOrderedList $ fmap g x + g (DocOrderedList x) = DocOrderedList $ fmap (\(index, a) -> (index, g a)) x g (DocDefList x) = DocDefList $ fmap (\(y, z) -> (g y, g z)) x g (DocCodeBlock x) = DocCodeBlock $ g x g (DocHyperlink (Hyperlink u x)) = DocHyperlink (Hyperlink u (fmap g x)) @@ -577,10 +577,24 @@ unorderedList indent = DocUnorderedList <$> p orderedList :: Text -> Parser (DocH mod Identifier) orderedList indent = DocOrderedList <$> p where - p = (paren <|> dot) *> innerList indent p + p = do + index <- paren <|> dot + innerList' indent p index dot = (decimal :: Parser Int) <* "." paren = "(" *> decimal <* ")" +-- | Like 'innerList' but takes the parsed index of the list item +innerList' :: Text -> Parser [(Int, DocH mod Identifier)] + -> Int + -> Parser [(Int, DocH mod Identifier)] +innerList' indent item index = do + c <- takeLine + (cs, items) <- more indent item + let contents = docParagraph . parseText . dropNLs . T.unlines $ c : cs + return $ case items of + Left p -> [(index, contents `docAppend` p)] + Right i -> (index, contents) : i + -- | Generic function collecting any further lines belonging to the -- list entry and recursively collecting any further lists in the -- same paragraph. Usually used as diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 22516864..d72ab4b4 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -124,7 +124,7 @@ data DocH mod id | DocMonospaced (DocH mod id) | DocBold (DocH mod id) | DocUnorderedList [DocH mod id] - | DocOrderedList [DocH mod id] + | DocOrderedList [(Int, DocH mod id)] | DocDefList [(DocH mod id, DocH mod id)] | DocCodeBlock (DocH mod id) | DocHyperlink (Hyperlink (DocH mod id)) @@ -154,7 +154,7 @@ instance Bifunctor DocH where bimap f g (DocMonospaced doc) = DocMonospaced (bimap f g doc) bimap f g (DocBold doc) = DocBold (bimap f g doc) bimap f g (DocUnorderedList docs) = DocUnorderedList (map (bimap f g) docs) - bimap f g (DocOrderedList docs) = DocOrderedList (map (bimap f g) docs) + bimap f g (DocOrderedList docs) = DocOrderedList (map (\(index, a) -> (index, bimap f g a)) docs) bimap f g (DocDefList docs) = DocDefList (map (bimap f g *** bimap f g) docs) bimap f g (DocCodeBlock doc) = DocCodeBlock (bimap f g doc) bimap f g (DocHyperlink (Hyperlink url lbl)) = DocHyperlink (Hyperlink url (fmap (bimap f g) lbl)) @@ -180,7 +180,7 @@ instance Bifoldable DocH where bifoldr f g z (DocMonospaced doc) = bifoldr f g z doc bifoldr f g z (DocBold doc) = bifoldr f g z doc bifoldr f g z (DocUnorderedList docs) = foldr (flip (bifoldr f g)) z docs - bifoldr f g z (DocOrderedList docs) = foldr (flip (bifoldr f g)) z docs + bifoldr f g z (DocOrderedList docs) = foldr (flip (bifoldr f g)) z (map snd docs) bifoldr f g z (DocDefList docs) = foldr (\(l, r) acc -> bifoldr f g (bifoldr f g acc l) r) z docs bifoldr f g z (DocCodeBlock doc) = bifoldr f g z doc bifoldr f g z (DocHeader (Header _ title)) = bifoldr f g z title @@ -201,7 +201,8 @@ instance Bitraversable DocH where bitraverse f g (DocMonospaced doc) = DocMonospaced <$> bitraverse f g doc bitraverse f g (DocBold doc) = DocBold <$> bitraverse f g doc bitraverse f g (DocUnorderedList docs) = DocUnorderedList <$> traverse (bitraverse f g) docs - bitraverse f g (DocOrderedList docs) = DocOrderedList <$> traverse (bitraverse f g) docs + bitraverse f g (DocOrderedList docs) = DocOrderedList <$> traverseSnd (bitraverse f g) docs + where traverseSnd f' = traverse (\(x, a) -> (\b -> (x, b)) <$> f' a) bitraverse f g (DocDefList docs) = DocDefList <$> traverse (bitraverse (bitraverse f g) (bitraverse f g)) docs bitraverse f g (DocCodeBlock doc) = DocCodeBlock <$> bitraverse f g doc bitraverse f g (DocHyperlink (Hyperlink url lbl)) = DocHyperlink <$> (Hyperlink url <$> traverse (bitraverse f g) lbl) @@ -246,7 +247,7 @@ data DocMarkupH mod id a = Markup , markupBold :: a -> a , markupMonospaced :: a -> a , markupUnorderedList :: [a] -> a - , markupOrderedList :: [a] -> a + , markupOrderedList :: [(Int,a)] -> a , markupDefList :: [(a,a)] -> a , markupCodeBlock :: a -> a , markupHyperlink :: Hyperlink a -> a diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs index 9cf7c537..6e700050 100644 --- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -820,7 +820,7 @@ spec = do it "can nest another type of list inside" $ do "* foo\n\n 1. bar" `shouldParseTo` DocUnorderedList [ DocParagraph "foo" - <> DocOrderedList [DocParagraph "bar"]] + <> DocOrderedList [(1, DocParagraph "bar")]] it "can nest a code block inside" $ do "* foo\n\n @foo bar baz@" `shouldParseTo` @@ -859,7 +859,7 @@ spec = do DocUnorderedList [ DocParagraph "foo" <> DocUnorderedList [ DocParagraph "bar" ] ] - <> DocOrderedList [ DocParagraph "baz" ] + <> DocOrderedList [ (1, DocParagraph "baz") ] it "allows arbitrary initial indent of a list" $ do unlines @@ -883,20 +883,20 @@ spec = do DocDefList [ ("foo", "foov" <> DocDefList [ ("bar", "barv") ]) ] - <> DocOrderedList [ DocParagraph "baz" ] + <> DocOrderedList [ (1, DocParagraph "baz") ] it "list order is preserved in presence of nesting + extra text" $ do "1. Foo\n\n > Some code\n\n2. Bar\n\nSome text" `shouldParseTo` - DocOrderedList [ DocParagraph "Foo" <> DocCodeBlock "Some code" - , DocParagraph "Bar" + DocOrderedList [ (1, DocParagraph "Foo" <> DocCodeBlock "Some code") + , (2, DocParagraph "Bar") ] <> DocParagraph (DocString "Some text") "1. Foo\n\n2. Bar\n\nSome text" `shouldParseTo` - DocOrderedList [ DocParagraph "Foo" - , DocParagraph "Bar" + DocOrderedList [ (1, DocParagraph "Foo") + , (2, DocParagraph "Bar") ] <> DocParagraph (DocString "Some text") @@ -980,9 +980,9 @@ spec = do , " 3. three" ] `shouldParseTo` DocOrderedList [ - DocParagraph "one" - , DocParagraph "two" - , DocParagraph "three" + (1, DocParagraph "one") + , (1, DocParagraph "two") + , (3, DocParagraph "three") ] it "ignores empty lines between list items" $ do @@ -992,12 +992,12 @@ spec = do , "2. two" ] `shouldParseTo` DocOrderedList [ - DocParagraph "one" - , DocParagraph "two" + (1, DocParagraph "one") + , (2, DocParagraph "two") ] it "accepts an empty list item" $ do - "1." `shouldParseTo` DocOrderedList [DocParagraph DocEmpty] + "1." `shouldParseTo` DocOrderedList [(1, DocParagraph DocEmpty)] it "accepts multi-line list items" $ do unlines [ @@ -1007,12 +1007,12 @@ spec = do , "more two" ] `shouldParseTo` DocOrderedList [ - DocParagraph "point one\n more one" - , DocParagraph "point two\nmore two" + (1, DocParagraph "point one\n more one") + , (1, DocParagraph "point two\nmore two") ] it "accepts markup in list items" $ do - "1. /foo/" `shouldParseTo` DocOrderedList [DocParagraph (DocEmphasis "foo")] + "1. /foo/" `shouldParseTo` DocOrderedList [(1, DocParagraph (DocEmphasis "foo"))] it "requires empty lines between list and other paragraphs" $ do unlines [ @@ -1022,7 +1022,7 @@ spec = do , "" , "baz" ] - `shouldParseTo` DocParagraph "foo" <> DocOrderedList [DocParagraph "bar"] <> DocParagraph "baz" + `shouldParseTo` DocParagraph "foo" <> DocOrderedList [(1, DocParagraph "bar")] <> DocParagraph "baz" context "when parsing definition lists" $ do it "parses a simple list" $ do @@ -1109,8 +1109,8 @@ spec = do ] `shouldParseTo` DocUnorderedList [ DocParagraph "bullet" , DocParagraph "different bullet"] - <> DocOrderedList [ DocParagraph "ordered" - , DocParagraph "different bullet" + <> DocOrderedList [ (1, DocParagraph "ordered") + , (2, DocParagraph "different bullet") ] <> DocDefList [ ("cat", "kitten") , ("pineapple", "fruit") |