@@ -42,7 +42,8 @@ module Text.Pandoc.Readers.Muse (readMuse) where
4242import Control.Monad
4343import Control.Monad.Except (throwError)
4444import Data.Char (isLetter)
45−import Data.List (stripPrefix)
45+import Data.List (stripPrefix, intercalate)
46+import Data.List.Split (splitOn)
4647import qualified Data.Map as M
4748import Data.Maybe (fromMaybe)
4849import Data.Text (Text, unpack)
@@ -187,17 +188,19 @@ directive = do
187188-- block parsers
188189--
189190
190−block :: PandocMonad m => MuseParser m (F Blocks)
191−block = do
192− res <- mempty <$ skipMany1 blankline
193− <|> blockElements
194− <|> para
195− skipMany blankline
191+parseBlock :: PandocMonad m => MuseParser m (F Blocks)
192+parseBlock = do
193+ res <- blockElements <|> para
194+ optionMaybe blankline
196195 trace (take 60 $ show $ B.toList $ runF res defaultParserState)
197196 return res
198197
198+block :: PandocMonad m => MuseParser m (F Blocks)
199+block = parseBlock <* skipMany blankline
200+
199201blockElements :: PandocMonad m => MuseParser m (F Blocks)
200−blockElements = choice [ comment
202+blockElements = choice [ mempty <$ blankline
203+ , comment
201204 , separator
202205 , header
203206 , example
@@ -257,15 +260,26 @@ example = try $ do
257260-- in case opening and/or closing tags are on separate lines.
258261chop :: String -> String
259262chop = lchop . rchop
260− where lchop s = case s of
263+
264+lchop :: String -> String
265+lchop s = case s of
261266 '\n':ss -> ss
262267 _ -> s
263− rchop = reverse . lchop . reverse
268+
269+rchop :: String -> String
270+rchop = reverse . lchop . reverse
271+
272+dropSpacePrefix :: [String] -> [String]
273+dropSpacePrefix lns =
274+ map (drop maxIndent) lns
275+ where flns = filter (not . all (== ' ')) lns
276+ maxIndent = if null flns then maximum (map length lns) else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns
264277
265278exampleTag :: PandocMonad m => MuseParser m (F Blocks)
266−exampleTag = do
279+exampleTag = try $ do
280+ many spaceChar
267281 (attr, contents) <- htmlElement "example"
268− return $ return $ B.codeBlockWith attr $ chop contents
282+ return $ return $ B.codeBlockWith attr $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop contents
269283
270284literal :: PandocMonad m => MuseParser m (F Blocks)
271285literal = do
@@ -309,7 +323,7 @@ verseLine = do
309323
310324verseLines :: PandocMonad m => MuseParser m (F Blocks)
311325verseLines = do
312− optionMaybe blankline -- Skip blankline after opening tag on separate line
326+ --optionMaybe blankline -- Skip blankline after opening tag on separate line
313327 lns <- many verseLine
314328 lns' <- mapM (parseFromString' (trimInlinesF . mconcat <$> many inline)) lns
315329 return $ B.lineBlock <$> sequence lns'
@@ -317,7 +331,7 @@ verseLines = do
317331verseTag :: PandocMonad m => MuseParser m (F Blocks)
318332verseTag = do
319333 (_, content) <- htmlElement "verse"
320− parseFromString verseLines content
334+ parseFromString verseLines (intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop content)
321335
322336commentTag :: PandocMonad m => MuseParser m (F Blocks)
323337commentTag = parseHtmlContent "comment" anyChar >> return mempty
@@ -349,7 +363,7 @@ amuseNoteBlock = try $ do
349363 guardEnabled Ext_amuse
350364 pos <- getPosition
351365 ref <- noteMarker <* spaceChar
352− content <- listItemContents $ 3 + length ref
366+ content <- listItemContents
353367 oldnotes <- stateNotes' <$> getState
354368 case M.lookup ref oldnotes of
355369 Just _ -> logMessage $ DuplicateNoteReference ref pos
@@ -399,11 +413,6 @@ lineBlock = try $ do
399413-- lists
400414--
401415
402−listLine :: PandocMonad m => Int -> MuseParser m String
403−listLine markerLength = try $ do
404− indentWith markerLength
405− manyTill anyChar eol
406−
407416withListContext :: PandocMonad m => MuseParser m a -> MuseParser m a
408417withListContext p = do
409418 state <- getState
@@ -413,66 +422,47 @@ withListContext p = do
413422 updateState (\st -> st {stateParserContext = oldContext})
414423 return parsed
415424
416−listContinuation :: PandocMonad m => Int -> MuseParser m [String]
417−listContinuation markerLength = try $ do
418− result <- many1 $ listLine markerLength
419− blank <- option id ((++ [""]) <$ blankline)
420− return $ blank result
421−
422−listStart :: PandocMonad m => MuseParser m Int -> MuseParser m Int
423−listStart marker = try $ do
424− preWhitespace <- length <$> many spaceChar
425− st <- stateParserContext <$> getState
426− getPosition >>= \pos -> guard (st == ListItemState || sourceColumn pos /= 1)
427− markerLength <- marker
428− void spaceChar <|> eol
429− return $ preWhitespace + markerLength + 1
430−
431−dropSpacePrefix :: [String] -> [String]
432−dropSpacePrefix lns =
433− map (drop maxIndent) lns
434− where flns = filter (not . all (== ' ')) lns
435− maxIndent = if null flns then 0 else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns
436−
437−listItemContents :: PandocMonad m => Int -> MuseParser m (F Blocks)
438−listItemContents markerLength = do
439− firstLine <- manyTill anyChar eol
440− restLines <- many $ listLine markerLength
441− blank <- option id ((++ [""]) <$ blankline)
442− let first = firstLine : blank restLines
443− rest <- many $ listContinuation markerLength
444− let allLines = concat (first : rest)
445− parseFromString (withListContext parseBlocks) $ unlines (dropSpacePrefix allLines)
446−
447−listItem :: PandocMonad m => MuseParser m Int -> MuseParser m (F Blocks)
448−listItem start = try $ do
449− markerLength <- start
450− listItemContents markerLength
451−
452−bulletListItems :: PandocMonad m => MuseParser m (F [Blocks])
453−bulletListItems = sequence <$> many1 (listItem bulletListStart)
425+listItemContents :: PandocMonad m => MuseParser m (F Blocks)
426+listItemContents = do
427+ pos <- getPosition
428+ let col = sourceColumn pos - 1
429+ first <- try $ withListContext parseBlock
430+ rest <- many $ try (skipMany blankline >> indentWith col >> withListContext parseBlock)
431+ return $ mconcat (first : rest)
454432
455−bulletListStart :: PandocMonad m => MuseParser m Int
456−bulletListStart = listStart (char '-' >> return 1)
433+listItem :: PandocMonad m => Int -> MuseParser m () -> MuseParser m (F Blocks)
434+listItem n p = try $ do
435+ optionMaybe blankline
436+ count n spaceChar
437+ p
438+ void spaceChar <|> lookAhead eol
439+ listItemContents
457440
458441bulletList :: PandocMonad m => MuseParser m (F Blocks)
459−bulletList = do
460− listItems <- bulletListItems
461− return $ B.bulletList <$> listItems
462−
463−orderedListStart :: PandocMonad m
464− => ListNumberStyle
465− -> ListNumberDelim
466− -> MuseParser m Int
467−orderedListStart style delim = listStart (snd <$> withHorizDisplacement (orderedListMarker style delim))
442+bulletList = try $ do
443+ many spaceChar
444+ pos <- getPosition
445+ let col = sourceColumn pos
446+ guard $ col /= 1
447+ char '-'
448+ void spaceChar <|> lookAhead eol
449+ first <- listItemContents
450+ rest <- many $ listItem (col - 1) (void (char '-'))
451+ return $ B.bulletList <$> sequence (first : rest)
468452
469453orderedList :: PandocMonad m => MuseParser m (F Blocks)
470454orderedList = try $ do
471− p@(_, style, delim) <- lookAhead (many spaceChar *> anyOrderedListMarker <* (eol <|> void spaceChar))
455+ many spaceChar
456+ pos <- getPosition
457+ let col = sourceColumn pos
458+ guard $ col /= 1
459+ p@(_, style, delim) <- anyOrderedListMarker
472460 guard $ style `elem` [Decimal, LowerAlpha, UpperAlpha, LowerRoman, UpperRoman]
473461 guard $ delim == Period
474− items <- sequence <$> many1 (listItem $ orderedListStart style delim)
475− return $ B.orderedListWith p <$> items
462+ void spaceChar <|> lookAhead eol
463+ first <- listItemContents
464+ rest <- many $ listItem (col - 1) (void (orderedListMarker style delim))
465+ return $ B.orderedListWith p <$> sequence (first : rest)
476466
477467definitionListItem :: PandocMonad m => MuseParser m (F (Inlines, [Blocks]))
478468definitionListItem = try $ do
@@ -482,7 +472,7 @@ definitionListItem = try $ do
482472 string "::"
483473 firstLine <- manyTill anyChar eol
484474 restLines <- manyTill anyLine endOfListItemElement
485− let lns = dropWhile (== ' ') firstLine : dropSpacePrefix restLines
475+ let lns = dropWhile (== ' ') firstLine : restLines
486476 lineContent <- parseFromString (withListContext parseBlocks) $ unlines lns
487477 pure $ do lineContent' <- lineContent
488478 term' <- term
@@ -501,8 +491,8 @@ definitionListItems = sequence <$> many1 definitionListItem
501491
502492definitionList :: PandocMonad m => MuseParser m (F Blocks)
503493definitionList = do
504− listItems <- definitionListItems
505− return $ B.definitionList <$> listItems
494+ items <- definitionListItems
495+ return $ B.definitionList <$> items
506496
507497--
508498-- tables