Muse reader: parse definition lists with multiple descriptions

src/Text/Pandoc/Readers/Muse.hs

@@ -631,26 +631,37 @@ orderedListUntil end = try $ do
   (items, e) <- orderedListItemsUntil indent style end
   return $ (B.orderedListWith p <$> sequence items, e)
 
+descriptionsUntil :: PandocMonad m
+                  => Int
+                  -> MuseParser m a
+                  -> MuseParser m ([F Blocks], a)
+descriptionsUntil indent end = do
+  void spaceChar <|> lookAhead eol
+  st <- getState
+  setState $ st{ museInPara = False }
+  (x, e) <- listItemContentsUntil indent (Right <$> try (optional blankline >> indentWith indent >> manyTill spaceChar (string "::") >> descriptionsUntil indent end)) (Left <$> end)
+  case e of
+    Right (xs, ee) -> return (x:xs, ee)
+    Left ee -> return ([x], ee)
+
 definitionListItemsUntil :: PandocMonad m
                          => Int
                          -> MuseParser m a
                          -> MuseParser m ([F (Inlines, [Blocks])], a)
 definitionListItemsUntil indent end =
   continuation
-  where continuation = try $ do
-          pos <- getPosition
-          term <- trimInlinesF . mconcat <$> manyTill (choice inlineList) (string "::")
-          void spaceChar <|> lookAhead eol
-          st <- getState
-          setState $ st{ museInPara = False }
-          (x, e) <- listItemContentsUntil (sourceColumn pos) ((Right <$> try (optional blankline >> count indent spaceChar >> continuation)) <|> (Left <$> end))
-          let xx = do
-                term' <- term
-                x' <- x
-                (return (term', [x']))::(F (Inlines, [Blocks]))
-          case e of
-            Left ee -> return $ ([xx], ee)
-            Right (xs, ee) -> return $ (xx : xs, ee)
+  where
+    continuation = try $ do
+      pos <- getPosition
+      term <- trimInlinesF . mconcat <$> manyTill (choice inlineList) (string "::")
+      (x, e) <- descriptionsUntil (sourceColumn pos) ((Right <$> try (optional blankline >> indentWith indent >> continuation)) <|> (Left <$> end))
+      let xx = do
+            term' <- term
+            x' <- sequence x
+            return (term', x')
+      case e of
+        Left ee -> return ([xx], ee)
+        Right (xs, ee) -> return (xx:xs, ee)
 
 definitionListUntil :: PandocMonad m
                     => MuseParser m a

test/Tests/Readers/Muse.hs

@@ -28,15 +28,9 @@ spcSep :: [Inlines] -> Inlines
 spcSep = mconcat . intersperse space
 
 -- Tables don't round-trip yet
--- Definition lists with multiple descriptions are supported by writer, but not reader yet
-
-singleDescription :: ([Inline], [[Block]]) -> ([Inline], [[Block]])
-singleDescription (a, x:_) = (a, [x])
-singleDescription x = x
-
+--
 makeRoundTrip :: Block -> Block
 makeRoundTrip Table{} = Para [Str "table was here"]
-makeRoundTrip (DefinitionList items) = DefinitionList $ map singleDescription items
 makeRoundTrip x = x
 
 -- Demand that any AST produced by Muse reader and written by Muse writer can be read back exactly the same way.
@@ -1092,6 +1086,25 @@ tests =
                                                       ("Fourth", [ definitionList [ ("Fifth", [ para "Sixth"] ) ] ] ) ] ] )
                        , ("Seventh", [ para "Eighth" ])
                        ]
+      , testGroup "Definition lists with multiple descriptions"
+        [ "Correctly indented second description" =:
+          T.unlines
+          [ " First term :: first description"
+          , "  :: second description"
+          ] =?>
+          definitionList [ ("First term", [ para "first description"
+                                          , para "second description"
+                                          ])
+                         ]
+        , "Incorrectly indented second description" =:
+          T.unlines
+          [ " First term :: first description"
+          , " :: second description"
+          ] =?>
+          definitionList [ ("First term", [ para "first description" ])
+                         , ("", [ para "second description" ])
+                         ]
+        ]
       , "Two blank lines separate definition lists" =:
         T.unlines
           [ " First :: list"