d226212 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Muse reader: code cleanup

d226212Alexander Krotov8 years ago

src/Text/Pandoc/Readers/Muse.hs+29−33

compare with master

unifiedsplit

@@ -44,7 +44,6 @@ import Control.Monad

44import Control.Monad.Reader

45import Control.Monad.Except (throwError)

46import Data.Bifunctor

47−import Data.Char (isAlphaNum)

48import Data.Default

47import Data.Default

49import Data.List (intercalate)

48import Data.List (intercalate)

50import Data.List.Split (splitOn)

49import Data.List.Split (splitOn)

@@ -69,7 +68,7 @@ readMuse :: PandocMonad m

69 -> m Pandoc

68 -> m Pandoc

70readMuse opts s = do

69readMuse opts s = do

71 let input = crFilter s

70 let input = crFilter s

72− res <- runReaderT (runParserT parseMuse def{ museOptions = opts } "source" input) def

71+ res <- flip runReaderT def $ runParserT parseMuse def{ museOptions = opts } "source" input

73 case res of

72 case res of

74 Left e -> throwError $ PandocParsecError (unpack input) e

73 Left e -> throwError $ PandocParsecError (unpack input) e

75 Right d -> return d

74 Right d -> return d

@@ -132,9 +131,7 @@ parseMuse = do

132 many directive

131 many directive

133 blocks <- (:) <$> parseBlocks <*> many parseSection

132 blocks <- (:) <$> parseBlocks <*> many parseSection

134 st <- getState

133 st <- getState

135− let doc = runF (Pandoc <$> museMeta st <*> fmap B.toList (mconcat blocks)) st

134+ runF (Pandoc <$> museMeta st <*> fmap B.toList (mconcat blocks)) st <$ reportLogMessages

136− reportLogMessages

137− return doc

138

135

139-- * Utility functions

136-- * Utility functions

140

137

@@ -203,7 +200,7 @@ htmlAttrToPandoc attrs = (ident, classes, keyvals)

203 where

200 where

204 ident = fromMaybe "" $ lookup "id" attrs

201 ident = fromMaybe "" $ lookup "id" attrs

205 classes = maybe [] words $ lookup "class" attrs

202 classes = maybe [] words $ lookup "class" attrs

206− keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]

203+ keyvals = [(k,v) | (k,v) <- attrs, k /= "id", k /= "class"]

207

204

208parseHtmlContent :: PandocMonad m

205parseHtmlContent :: PandocMonad m

209 => String -- ^ Tag name

206 => String -- ^ Tag name

@@ -279,28 +276,22 @@ parseSection =

279parseBlocksTill :: PandocMonad m

276parseBlocksTill :: PandocMonad m

280 => MuseParser m a

277 => MuseParser m a

281 -> MuseParser m (F Blocks)

278 -> MuseParser m (F Blocks)

282−parseBlocksTill end =

279+parseBlocksTill end = continuation

283− try (parseEnd <|>

284− blockStart <|>

285− listStart <|>

286− paraStart)

287 where

280 where

288 parseEnd = mempty <$ end

281 parseEnd = mempty <$ end

289 blockStart = (B.<>) <$> blockElements <*> allowPara continuation

282 blockStart = (B.<>) <$> blockElements <*> allowPara continuation

290 listStart = uncurry (B.<>) <$> allowPara (anyListUntil (parseEnd <|> continuation))

283 listStart = uncurry (B.<>) <$> allowPara (anyListUntil (parseEnd <|> continuation))

291 paraStart = uncurry (B.<>) <$> paraUntil (parseEnd <|> continuation)

284 paraStart = uncurry (B.<>) <$> paraUntil (parseEnd <|> continuation)

292− continuation = parseBlocksTill end

285+ continuation = try $ parseEnd <|> blockStart <|> listStart <|> paraStart

293

286

294listItemContentsUntil :: PandocMonad m

287listItemContentsUntil :: PandocMonad m

295 => Int

288 => Int

296 -> MuseParser m a

289 -> MuseParser m a

297 -> MuseParser m a

290 -> MuseParser m a

298 -> MuseParser m (F Blocks, a)

291 -> MuseParser m (F Blocks, a)

299−listItemContentsUntil col pre end =

292+listItemContentsUntil col pre end = p

300− try blockStart <|>

301− try listStart <|>

302− try paraStart

303 where

293 where

294+ p = try blockStart <|> try listStart <|> try paraStart

304 parsePre = (mempty,) <$> pre

295 parsePre = (mempty,) <$> pre

305 parseEnd = (mempty,) <$> end

296 parseEnd = (mempty,) <$> end

306 paraStart = do

297 paraStart = do

@@ -314,7 +305,7 @@ listItemContentsUntil col pre end =

314 continuation = try $ do blank <- optionMaybe blankline

305 continuation = try $ do blank <- optionMaybe blankline

315 skipMany blankline

306 skipMany blankline

316 indentWith col

307 indentWith col

317− local (\s -> s { museInPara = museInPara s && isNothing blank }) $ listItemContentsUntil col pre end

308+ local (\s -> s { museInPara = museInPara s && isNothing blank }) p

318

309

319parseBlock :: PandocMonad m => MuseParser m (F Blocks)

310parseBlock :: PandocMonad m => MuseParser m (F Blocks)

320parseBlock = do

311parseBlock = do

@@ -435,9 +426,9 @@ divTag = do

435-- | Parse @\<biblio>@ tag, the result is the same as @\<div class="biblio">@.

426-- | Parse @\<biblio>@ tag, the result is the same as @\<div class="biblio">@.

436-- @\<biblio>@ tag is supported only in Text::Amuse mode.

427-- @\<biblio>@ tag is supported only in Text::Amuse mode.

437biblioTag :: PandocMonad m => MuseParser m (F Blocks)

428biblioTag :: PandocMonad m => MuseParser m (F Blocks)

438−biblioTag = do

429+biblioTag = fmap (B.divWith ("", ["biblio"], [])) . snd

439− guardEnabled Ext_amuse

430+ <$ guardEnabled Ext_amuse

440− fmap (B.divWith ("", ["biblio"], [])) . snd <$> parseHtmlContent "biblio"

431+ <*> parseHtmlContent "biblio"

441

432

442-- | Parse @\<play>@ tag, the result is the same as @\<div class="play">@.

433-- | Parse @\<play>@ tag, the result is the same as @\<div class="play">@.

443-- @\<play>@ tag is supported only in Text::Amuse mode.

434-- @\<play>@ tag is supported only in Text::Amuse mode.

@@ -489,6 +480,17 @@ noteMarker = try $ (:)

489 <*> oneOf "123456789"

480 <*> oneOf "123456789"

490 <*> manyTill digit (char ']')

481 <*> manyTill digit (char ']')

491

482

483+addNote :: PandocMonad m

484+ => String

485+ -> SourcePos

486+ -> F Blocks

487+ -> MuseParser m ()

488+addNote ref pos content = do

489+ oldnotes <- museNotes <$> getState

490+ when (M.member ref oldnotes)

491+ (logMessage $ DuplicateNoteReference ref pos)

492+ updateState $ \s -> s{ museNotes = M.insert ref (pos, content) oldnotes }

493+

492-- Amusewiki version of note

494-- Amusewiki version of note

493-- Parsing is similar to list item, except that note marker is used instead of list marker

495-- Parsing is similar to list item, except that note marker is used instead of list marker

494amuseNoteBlockUntil :: PandocMonad m

496amuseNoteBlockUntil :: PandocMonad m

@@ -499,10 +501,7 @@ amuseNoteBlockUntil end = try $ do

499 ref <- noteMarker <* spaceChar

501 ref <- noteMarker <* spaceChar

500 pos <- getPosition

502 pos <- getPosition

501 (content, e) <- allowPara $ listItemContentsUntil (sourceColumn pos - 1) (fail "x") end

503 (content, e) <- allowPara $ listItemContentsUntil (sourceColumn pos - 1) (fail "x") end

502− oldnotes <- museNotes <$> getState

504+ addNote ref pos content

503− when (M.member ref oldnotes)

504− (logMessage $ DuplicateNoteReference ref pos)

505− updateState $ \s -> s{ museNotes = M.insert ref (pos, content) oldnotes }

506 return (mempty, e)

505 return (mempty, e)

507

506

508-- Emacs version of note

507-- Emacs version of note

@@ -510,13 +509,10 @@ amuseNoteBlockUntil end = try $ do

510emacsNoteBlock :: PandocMonad m => MuseParser m (F Blocks)

509emacsNoteBlock :: PandocMonad m => MuseParser m (F Blocks)

511emacsNoteBlock = try $ do

510emacsNoteBlock = try $ do

512 guardDisabled Ext_amuse

511 guardDisabled Ext_amuse

513− pos <- getPosition

514 ref <- noteMarker <* skipSpaces

512 ref <- noteMarker <* skipSpaces

513+ pos <- getPosition

515− content <- mconcat <$> blocksTillNote

514+ content <- fmap mconcat blocksTillNote

516− oldnotes <- museNotes <$> getState

515+ addNote ref pos content

517− when (M.member ref oldnotes)

518− (logMessage $ DuplicateNoteReference ref pos)

519− updateState $ \s -> s{ museNotes = M.insert ref (pos, content) oldnotes }

520 return mempty

516 return mempty

521 where

517 where

522 blocksTillNote =

518 blocksTillNote =

@@ -688,7 +684,7 @@ tableParseRow :: PandocMonad m

688tableParseRow n = try $ sequence <$> tableCells

684tableParseRow n = try $ sequence <$> tableCells

689 where tableCells = (:) <$> tableCell sep <*> (tableCells <|> fmap pure (tableCell eol))

685 where tableCells = (:) <$> tableCell sep <*> (tableCells <|> fmap pure (tableCell eol))

690 tableCell p = try $ fmap B.plain . trimInlinesF . mconcat <$> manyTill inline' p

686 tableCell p = try $ fmap B.plain . trimInlinesF . mconcat <$> manyTill inline' p

691− sep = try $ many1 spaceChar *> count n (char '|') *> (void (lookAhead $ many1 spaceChar) <|> void (lookAhead eol))

687+ sep = try $ many1 spaceChar *> count n (char '|') *> lookAhead (void (many1 spaceChar) <|> void eol)

692

688

693-- | Parse a table header row.

689-- | Parse a table header row.

694tableParseHeader :: PandocMonad m => MuseParser m (F MuseTableElement)

690tableParseHeader :: PandocMonad m => MuseParser m (F MuseTableElement)

@@ -852,7 +848,7 @@ code = try $ fmap pure $ B.code . uncurry (++)

852 <$ atStart (char '=')

848 <$ atStart (char '=')

853 <* notFollowedBy (spaceChar <|> newline)

849 <* notFollowedBy (spaceChar <|> newline)

854 <*> manyUntil (noneOf "\n\r" <|> (newline <* notFollowedBy newline)) (try $ fmap pure $ noneOf " \t\n\r=" <* char '=')

850 <*> manyUntil (noneOf "\n\r" <|> (newline <* notFollowedBy newline)) (try $ fmap pure $ noneOf " \t\n\r=" <* char '=')

855− <* notFollowedBy (satisfy isAlphaNum)

851+ <* notFollowedBy alphaNum

856

852

857-- | Parse @\<code>@ tag.

853-- | Parse @\<code>@ tag.

858codeTag :: PandocMonad m => MuseParser m (F Inlines)

854codeTag :: PandocMonad m => MuseParser m (F Inlines)

@@ -877,7 +873,7 @@ str :: PandocMonad m => MuseParser m (F Inlines)

877str = return . B.str <$> many1 alphaNum <* updateLastStrPos

873str = return . B.str <$> many1 alphaNum <* updateLastStrPos

878

874

879symbol :: PandocMonad m => MuseParser m (F Inlines)

875symbol :: PandocMonad m => MuseParser m (F Inlines)

880−symbol = return . B.str <$> count 1 nonspaceChar

876+symbol = pure . B.str . pure <$> nonspaceChar

881

877

882-- | Parse a link or image.

878-- | Parse a link or image.

883linkOrImage :: PandocMonad m => MuseParser m (F Inlines)

879linkOrImage :: PandocMonad m => MuseParser m (F Inlines)