Muse reader: parse bullet lists

src/Text/Pandoc/Readers/Muse.hs

@@ -185,6 +185,7 @@ blockElements = choice [ comment
                        , centerTag
                        , rightTag
                        , quoteTag
+                       , bulletList
                        , table
                        , commentTag
                        , noteBlock
@@ -274,6 +275,59 @@ noteBlock = try $ do
     blocksTillNote =
       many1Till block (eof <|> () <$ lookAhead noteMarker)
 
+--
+-- lists
+--
+
+bulletListItems :: PandocMonad m => MuseParser m (F [Blocks])
+bulletListItems = sequence <$> many1 bulletListItem
+
+bulletList :: PandocMonad m => MuseParser m (F Blocks)
+bulletList = do
+  listItems <- bulletListItems
+  return $ B.bulletList <$> listItems
+
+bulletListStart :: PandocMonad m => MuseParser m Int
+bulletListStart = try $ do
+  preWhitespace <- length <$> many spaceChar
+  st <- stateParserContext <$> getState
+  getPosition >>= \pos -> guard (st == ListItemState || sourceColumn pos /= 1)
+  char '-'
+  postWhitespace <- length <$> many1 spaceChar
+  return $ preWhitespace + 1 + postWhitespace
+
+listLine :: PandocMonad m => Int -> MuseParser m [Char]
+listLine markerLength = try $ do
+  notFollowedBy blankline
+  indentWith markerLength
+  anyLineNewline
+
+withListContext :: PandocMonad m => MuseParser m a -> MuseParser m a
+withListContext p = do
+  state <- getState
+  let oldContext = stateParserContext state
+  setState $ state { stateParserContext = ListItemState }
+  parsed <- p
+  updateState (\st -> st {stateParserContext = oldContext})
+  return parsed
+
+bulletListItem :: PandocMonad m => MuseParser m (F Blocks)
+bulletListItem = try $ do
+  markerLength <- bulletListStart
+  firstLine <- anyLineNewline
+  blank <- option "" ("\n" <$ blankline)
+  restLines <- many $ listLine markerLength
+  let first = firstLine ++ blank ++ concat restLines
+  rest <- many $ listContinuation markerLength
+  parsed <- parseFromString (withListContext parseBlocks) $ concat (first:rest) ++ "\n"
+  return parsed
+
+listContinuation :: PandocMonad m => Int -> MuseParser m String
+listContinuation markerLength = try $ do
+  result <- many1 $ listLine markerLength
+  blanks <- many1 blankline
+  return $ concat result ++ blanks
+
 --
 -- tables
 --

test/Tests/Readers/Muse.hs

@@ -222,4 +222,29 @@ tests =
              [plain "", plain ""],
              [plain "bar", plain ""]]
         ]
+    , testGroup "Lists" $
+      [ "Bullet list" =:
+         unlines
+           [ " - Item1"
+           , ""
+           , " - Item2"
+           ] =?>
+          bulletList [ para "Item1"
+                     , para "Item2"
+                     ]
+      , "Nested list" =:
+         unlines
+           [ " - Item1"
+           , "   - Item2"
+           , "   - Item3"
+           , " - Item4"
+           ] =?>
+         bulletList [ mconcat [ para "Item1"
+                              , bulletList [ para "Item2"
+                                           , para "Item3"
+                                           ]
+                              ]
+                    , para "Item4"
+                    ]
+      ]
   ]