Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

hlint Muse reader and tests

Browse source
This commit is contained in:
Alexander Krotov 2017-12-06 19:38:25 +03:00
parent 6fd3cdac46
commit e536c4d9c9
2 changed files with 8 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/Text/Pandoc/Readers/Muse.hs
View file

@ -148,7 +148,7 @@ atStart p = do
-- --
-- While not documented, Emacs Muse allows "-" in directive name -- While not documented, Emacs Muse allows "-" in directive name
parseDirectiveKey :: PandocMonad m => MuseParser m (String) parseDirectiveKey :: PandocMonad m => MuseParser m String
parseDirectiveKey = do parseDirectiveKey = do
char '#' char '#'
many (letter <|> char '-') many (letter <|> char '-')
@ -173,7 +173,7 @@ parseAmuseDirective = do
value <- parseFromString (trimInlinesF . mconcat <$> many inline) $ unlines (first : rest) value <- parseFromString (trimInlinesF . mconcat <$> many inline) $ unlines (first : rest)
return (key, value) return (key, value)
where where
endOfDirective = lookAhead $ endOfInput <|> (try $ void blankline) <|> (try $ void parseDirectiveKey) endOfDirective = lookAhead $ endOfInput <|> try (void blankline) <|> try (void parseDirectiveKey)
endOfInput = try $ skipMany blankline >> skipSpaces >> eof endOfInput = try $ skipMany blankline >> skipSpaces >> eof
directive :: PandocMonad m => MuseParser m () directive :: PandocMonad m => MuseParser m ()
@ -428,7 +428,7 @@ listStart marker = try $ do
dropSpacePrefix :: [String] -> [String] dropSpacePrefix :: [String] -> [String]
dropSpacePrefix lns = dropSpacePrefix lns =
map (drop maxIndent) lns map (drop maxIndent) lns
where flns = filter (\s -> not $ all (== ' ') s) lns where flns = filter (not . all (== ' ')) lns
maxIndent = if null flns then 0 else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns maxIndent = if null flns then 0 else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns
listItemContents :: PandocMonad m => Int -> MuseParser m (F Blocks) listItemContents :: PandocMonad m => Int -> MuseParser m (F Blocks)
@ -620,7 +620,7 @@ inlineList = [ endline
] ]
inline :: PandocMonad m => MuseParser m (F Inlines) inline :: PandocMonad m => MuseParser m (F Inlines)
inline = (choice inlineList) <?> "inline" inline = choice inlineList <?> "inline"
endline :: PandocMonad m => MuseParser m (F Inlines) endline :: PandocMonad m => MuseParser m (F Inlines)
endline = try $ do endline = try $ do

8
test/Tests/Readers/Muse.hs
View file

@ -116,7 +116,7 @@ tests =
, "Linebreak" =: "Line <br> break" =?> para ("Line" <> linebreak <> "break") , "Linebreak" =: "Line <br> break" =?> para ("Line" <> linebreak <> "break")
, test emacsMuse "Non-breaking space" , test emacsMuse "Non-breaking space"
("Foo~~bar" =?> para ("Foo\160bar")) ("Foo~~bar" =?> para "Foo\160bar")
, testGroup "Code markup" , testGroup "Code markup"
[ "Code" =: "=foo(bar)=" =?> para (code "foo(bar)") [ "Code" =: "=foo(bar)=" =?> para (code "foo(bar)")
@ -457,15 +457,15 @@ tests =
, testGroup "Directives" , testGroup "Directives"
[ "Title" =: [ "Title" =:
"#title Document title" =?> "#title Document title" =?>
let titleInline = toList $ "Document title" let titleInline = toList "Document title"
meta = setMeta "title" (MetaInlines titleInline) $ nullMeta meta = setMeta "title" (MetaInlines titleInline) nullMeta
in Pandoc meta mempty in Pandoc meta mempty
-- Emacs Muse documentation says that "You can use any combination -- Emacs Muse documentation says that "You can use any combination
-- of uppercase and lowercase letters for directives", -- of uppercase and lowercase letters for directives",
-- but also allows '-', which is not documented, but used for disable-tables. -- but also allows '-', which is not documented, but used for disable-tables.
, test emacsMuse "Disable tables" , test emacsMuse "Disable tables"
("#disable-tables t" =?> ("#disable-tables t" =?>
Pandoc (setMeta "disable-tables" (MetaInlines $ toList "t") $ nullMeta) mempty) Pandoc (setMeta "disable-tables" (MetaInlines $ toList "t") nullMeta) mempty)
] ]
, testGroup "Anchors" , testGroup "Anchors"
[ "Anchor" =: [ "Anchor" =: