Muse reader: add definition list support (#3860)

2 files changed, 80 insertions, 1 deletions

diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index 5d77dec13..924149294 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -33,7 +33,6 @@ TODO:
 - Page breaks (five "*")
 - Headings with anchors (make it round trip with Muse writer)
 - <verse> and ">"
-- Definition lists
 - Org tables
 - table.el tables
 - Images with attributes (floating and width)
@@ -184,6 +183,7 @@ blockElements = choice [ comment
                        , quoteTag
                        , bulletList
                        , orderedList
+                       , definitionList
                        , table
                        , commentTag
                        , noteBlock
@@ -348,6 +348,33 @@ orderedList = try $ do
   items <- sequence <$> many1 (listItem $ orderedListStart style delim)
   return $ B.orderedListWith p <$> items
 
+definitionListItem :: PandocMonad m => MuseParser m (F (Inlines, [Blocks]))
+definitionListItem = try $ do
+  term <- termParser
+  many1 spaceChar
+  string "::"
+  firstLine <- anyLineNewline
+  restLines <- manyTill anyLineNewline endOfListItemElement
+  let lns = firstLine : restLines
+  lineContent <- parseFromString (withListContext parseBlocks) $ concat lns ++ "\n"
+  pure $ do lineContent' <- lineContent
+            pure (B.text term, [lineContent'])
+  where
+    termParser = (many1 spaceChar) >> -- Initial space as required by Amusewiki, but not Emacs Muse
+                 (many1Till anyChar $ lookAhead (void (try (spaceChar >> string "::")) <|> void newline))
+    endOfInput = try $ skipMany blankline >> skipSpaces >> eof
+    twoBlankLines = try $ blankline >> skipMany1 blankline
+    newDefinitionListItem = try $ void termParser
+    endOfListItemElement = lookAhead $ endOfInput <|> newDefinitionListItem <|> twoBlankLines
+
+definitionListItems :: PandocMonad m => MuseParser m (F [(Inlines, [Blocks])])
+definitionListItems = sequence <$> many1 definitionListItem
+
+definitionList :: PandocMonad m => MuseParser m (F Blocks)
+definitionList = do
+  listItems <- definitionListItems
+  return $ B.definitionList <$> listItems
+
 --
 -- tables
 --
diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs
index c5c973f00..5a1a635c5 100644
--- a/test/Tests/Readers/Muse.hs
+++ b/test/Tests/Readers/Muse.hs
@@ -421,6 +421,58 @@ tests =
             ] =?>
           bulletList [ para "Foo" <> para "bar" ] <> bulletList [ para "Baz" ]
         ]
+      -- Test that definition list requires a leading space.
+      -- Emacs Muse does not require a space, we follow Amusewiki here.
+      , "Not a definition list" =:
+        T.unlines
+          [ "First :: second"
+          , "Foo :: bar"
+          ] =?>
+        para "First :: second Foo :: bar"
+      , "Definition list" =:
+        T.unlines
+          [ " First :: second"
+          , " Foo :: bar"
+          ] =?>
+        definitionList [ ("First", [ para "second" ])
+                       , ("Foo", [ para "bar" ])
+                       ]
+      , "Definition list term cannot include newline" =:
+        T.unlines
+          [ " Foo" -- "Foo" is not a part of the definition list term
+          , " Bar :: baz"
+          ] =?>
+        para "Foo" <>
+        definitionList [ ("Bar", [ para "baz" ]) ]
+      , "Multi-line definition lists" =:
+        T.unlines
+          [ " First term :: Definition of first term"
+          , "and its continuation."
+          , " Second term :: Definition of second term."
+          ] =?>
+        definitionList [ ("First term", [ para "Definition of first term and its continuation." ])
+                       , ("Second term", [ para "Definition of second term." ])
+                       ]
+      -- Emacs Muse creates two separate lists when indentation of items is different.
+      -- We follow Amusewiki and allow different indentation within one list.
+      , "Changing indentation" =:
+        T.unlines
+          [ " First term :: Definition of first term"
+          , "and its continuation."
+          , "   Second term :: Definition of second term."
+          ] =?>
+        definitionList [ ("First term", [ para "Definition of first term and its continuation." ])
+                       , ("Second term", [ para "Definition of second term." ])
+                       ]
+      , "Two blank lines separate definition lists" =:
+        T.unlines
+          [ " First :: list"
+          , ""
+          , ""
+          , " Second :: list"
+          ] =?>
+        definitionList [ ("First", [ para "list" ]) ] <>
+        definitionList [ ("Second", [ para "list" ]) ]
       -- Headers in first column of list continuation are not allowed
       , "No headers in list continuation" =:
         T.unlines