diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Textile.hs | 62 | ||||
| -rw-r--r-- | test/command/2465.md | 59 |
2 files changed, 111 insertions, 10 deletions
diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 8922d2b35..e28ac52f6 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -54,6 +54,7 @@ import Text.Pandoc.Parsing import Text.Pandoc.Readers.HTML (htmlTag, isBlockTag, isInlineTag) import Text.Pandoc.Readers.LaTeX (rawLaTeXBlock, rawLaTeXInline) import Text.Pandoc.Shared (trim, tshow) +import Text.Read (readMaybe) -- | Parse a Textile text and return a Pandoc document. readTextile :: (PandocMonad m, ToSources a) @@ -229,30 +230,59 @@ bulletListAtDepth depth = try $ B.bulletList <$> many1 (bulletListItemAtDepth d -- | Bullet List Item of given depth, depth being the number of -- leading '*' bulletListItemAtDepth :: PandocMonad m => Int -> TextileParser m Blocks -bulletListItemAtDepth = genericListItemAtDepth '*' +bulletListItemAtDepth depth = try $ do + bulletListStartAtDepth depth + genericListItemContentsAtDepth depth -- | Ordered List of given depth, depth being the number of -- leading '#' +-- The first Ordered List Item may have a start attribute orderedListAtDepth :: PandocMonad m => Int -> TextileParser m Blocks orderedListAtDepth depth = try $ do - items <- many1 (orderedListItemAtDepth depth) - return $ B.orderedList items + (startNum, firstItem) <- firstOrderedListItemAtDepth depth + moreItems <- many (orderedListItemAtDepth depth) + let listItems = firstItem : moreItems + return $ B.orderedListWith (startNum, DefaultStyle, DefaultDelim) listItems + +-- | The first Ordered List Item, which could have a start attribute +firstOrderedListItemAtDepth :: PandocMonad m => Int + -> TextileParser m (Int, Blocks) +firstOrderedListItemAtDepth depth = try $ do + startNum <- orderedListStartAtDepth depth + contents <- genericListItemContentsAtDepth depth + return (startNum, contents) -- | Ordered List Item of given depth, depth being the number of -- leading '#' orderedListItemAtDepth :: PandocMonad m => Int -> TextileParser m Blocks -orderedListItemAtDepth = genericListItemAtDepth '#' - --- | Common implementation of list items -genericListItemAtDepth :: PandocMonad m => Char -> Int -> TextileParser m Blocks -genericListItemAtDepth c depth = try $ do - count depth (char c) >> attributes >> whitespace +orderedListItemAtDepth depth = try $ do + orderedListStartAtDepth depth + genericListItemContentsAtDepth depth + +-- | Lists always start with a number of leading characters '#' or '*' +-- Ordered list start characters '#' can be followed by the start attribute +-- number, but bullet list characters '*' can not +orderedListStartAtDepth :: PandocMonad m => Int -> TextileParser m Int +orderedListStartAtDepth depth = count depth (char '#') >> + try orderedListStartAttr <* (attributes >> whitespace) + +bulletListStartAtDepth :: PandocMonad m => Int -> TextileParser m () +bulletListStartAtDepth depth = () <$ (count depth (char '*') >> + attributes >> whitespace) + +-- | The leading characters and start attributes differ between ordered and +-- unordered lists, but their contents have the same structure and can +-- share a Parser +genericListItemContentsAtDepth :: PandocMonad m => Int + -> TextileParser m Blocks +genericListItemContentsAtDepth depth = do contents <- mconcat <$> many ((B.plain . mconcat <$> many1 inline) <|> try (newline >> codeBlockHtml)) newline sublist <- option mempty (anyListAtDepth (depth + 1)) return $ contents <> sublist + -- | A definition list is a set of consecutive definition items definitionList :: PandocMonad m => TextileParser m Blocks definitionList = try $ B.definitionList <$> many1 definitionListItem @@ -260,12 +290,17 @@ definitionList = try $ B.definitionList <$> many1 definitionListItem -- | List start character. listStart :: PandocMonad m => TextileParser m () listStart = genericListStart '*' - <|> () <$ genericListStart '#' + <|> () <$ orderedListStart <|> () <$ definitionListStart genericListStart :: PandocMonad m => Char -> TextileParser m () genericListStart c = () <$ try (many1 (char c) >> whitespace) +orderedListStart :: PandocMonad m => TextileParser m () +orderedListStart = () <$ try (many1 (char '#') >> + try orderedListStartAttr >> + whitespace) + basicDLStart :: PandocMonad m => TextileParser m () basicDLStart = do char '-' @@ -631,6 +666,13 @@ code2 = do htmlTag (tagOpen (=="tt") null) B.code . T.pack <$> manyTill anyChar' (try $ htmlTag $ tagClose (=="tt")) +orderedListStartAttr :: PandocMonad m => TextileParser m Int +orderedListStartAttr = do + digits <- many digit + case readMaybe digits :: Maybe Int of + Nothing -> return 1 + Just n -> return n + -- | Html / CSS attributes attributes :: PandocMonad m => TextileParser m Attr attributes = foldl' (flip ($)) ("",[],[]) <$> diff --git a/test/command/2465.md b/test/command/2465.md new file mode 100644 index 000000000..610e3510e --- /dev/null +++ b/test/command/2465.md @@ -0,0 +1,59 @@ +``` +% pandoc -f textile -t native +This list starts: + +# one +# two + +This list should continue at 3: + +#3 three +# four + +This list should restart at 1: + +# one again +# two again +^D +[ Para + [ Str "This" , Space , Str "list" , Space , Str "starts:" ] +, OrderedList + ( 1 , DefaultStyle , DefaultDelim ) + [ [ Plain [ Str "one" ] ] , [ Plain [ Str "two" ] ] ] +, Para + [ Str "This" + , Space + , Str "list" + , Space + , Str "should" + , Space + , Str "continue" + , Space + , Str "at" + , Space + , Str "3:" + ] +, OrderedList + ( 3 , DefaultStyle , DefaultDelim ) + [ [ Plain [ Str "three" ] ] , [ Plain [ Str "four" ] ] ] +, Para + [ Str "This" + , Space + , Str "list" + , Space + , Str "should" + , Space + , Str "restart" + , Space + , Str "at" + , Space + , Str "1:" + ] +, OrderedList + ( 1 , DefaultStyle , DefaultDelim ) + [ [ Plain [ Str "one" , Space , Str "again" ] ] + , [ Plain [ Str "two" , Space , Str "again" ] ] + ] +] +``` + |