git.iko.soy/typeable/pandoc
on master help sign in
RST reader: use `insertIncludedFile` from T.P.Parsing...

instead of reproducing much of its code.

commit41a3ac9da99c2701fa7e6adbc85da91f191620f4 authorJohn MacFarlane <jgm@berkeley.edu> dateSun 9 May 2021, 16:26 (5 years ago) parent05ea507
1 file changed+36−58
src/Text/Pandoc/Readers/RST.hs+36−58
src/Text/Pandoc/Readers/RST.hs+36−58
@@ -27,8 +27,7 @@ import Data.Text (Text)
2727import qualified Data.Text as T
2828import Text.Pandoc.Builder (Blocks, Inlines, fromList, setMeta, trimInlines)
2929import qualified Text.Pandoc.Builder as B
30−import Text.Pandoc.Class.PandocMonad (PandocMonad, fetchItem,
31− readFileFromDirs, getTimestamp)
30+import Text.Pandoc.Class.PandocMonad (PandocMonad, fetchItem, getTimestamp)
3231import Text.Pandoc.CSV (CSVOptions (..), defaultCSVOptions, parseCSV)
3332import Text.Pandoc.Definition
3433import Text.Pandoc.Error
@@ -453,59 +452,38 @@ encoding
453452-}
454453
455454includeDirective :: PandocMonad m
456− => Text -> [(Text, Text)] -> Text
455+ => Text
456+ -> [(Text, Text)]
457+ -> Text
457458 -> RSTParser m Blocks
458459includeDirective top fields body = do
459− let f = trim top
460− guard $ not (T.null f)
460+ let f = T.unpack $ trim top
461+ guard $ not $ null f
461462 guard $ T.null (trim body)
462− -- options
463− let (startLine :: Maybe Int) = lookup "start-line" fields >>= safeRead
464− let (endLine :: Maybe Int) = lookup "end-line" fields >>= safeRead
465− oldPos <- getPosition
466− containers <- stateContainers <$> getState
467− when (f `elem` containers) $
468− throwError $ PandocParseError $ "Include file loop at " <> tshow oldPos
469− updateState $ \s -> s{ stateContainers = f : stateContainers s }
470− mbContents <- readFileFromDirs ["."] $ T.unpack f
471− contentLines <- case mbContents of
472− Just s -> return $ T.lines s
473− Nothing -> do
474− logMessage $ CouldNotLoadIncludeFile f oldPos
475− return []
476− let numLines = length contentLines
477− let startLine' = case startLine of
478− Nothing -> 1
479− Just x | x >= 0 -> x
480− | otherwise -> numLines + x -- negative from end
481− let endLine' = case endLine of
482− Nothing -> numLines + 1
483− Just x | x >= 0 -> x
484− | otherwise -> numLines + x -- negative from end
485− let contentLines' = drop (startLine' - 1)
486− $ take (endLine' - 1) contentLines
487− let contentLines'' = (case trim <$> lookup "end-before" fields of
488− Just patt -> takeWhile (not . (patt `T.isInfixOf`))
489− Nothing -> id) .
490− (case trim <$> lookup "start-after" fields of
491− Just patt -> drop 1 .
492− dropWhile (not . (patt `T.isInfixOf`))
493− Nothing -> id) $ contentLines'
494− let contents' = T.unlines contentLines''
495− case lookup "code" fields of
496− Just lang -> do
497− let classes = maybe [] T.words (lookup "class" fields)
498− let ident = maybe "" trimr $ lookup "name" fields
499− codeblock ident classes fields (trimr lang) contents' False
500− Nothing -> case lookup "literal" fields of
501− Just _ -> return $ B.rawBlock "rst" contents'
502− Nothing -> do
503− addToSources (initialPos (T.unpack f))
504− (contents' <> "\n")
505− updateState $ \s -> s{ stateContainers =
506− tail $ stateContainers s }
507− return mempty
508−
463+ let startLine = lookup "start-line" fields >>= safeRead
464+ let endLine = lookup "end-line" fields >>= safeRead
465+ let classes = maybe [] T.words (lookup "class" fields)
466+ let ident = maybe "" trimr $ lookup "name" fields
467+ let parser =
468+ case lookup "code" fields of
469+ Just lang ->
470+ (codeblock ident classes fields (trimr lang) False
471+ . sourcesToText) <$> getInput
472+ Nothing ->
473+ case lookup "literal" fields of
474+ Just _ -> B.rawBlock "rst" . sourcesToText <$> getInput
475+ Nothing -> parseBlocks
476+ let selectLines =
477+ (case trim <$> lookup "end-before" fields of
478+ Just patt -> takeWhile (not . (patt `T.isInfixOf`))
479+ Nothing -> id) .
480+ (case trim <$> lookup "start-after" fields of
481+ Just patt -> drop 1 .
482+ dropWhile (not . (patt `T.isInfixOf`))
483+ Nothing -> id)
484+ let toStream t =
485+ toSources [(f, T.unlines . selectLines . T.lines $ t)]
486+ insertIncludedFile parser toStream ["."] f startLine endLine
509487
510488--
511489-- list blocks
@@ -734,8 +712,8 @@ directive' = do
734712 "" -> stateRstHighlight def
735713 lang -> Just lang })
736714 x | x == "code" || x == "code-block" || x == "sourcecode" ->
737− codeblock name classes (map (second trimr) fields)
738− (trim top) body True
715+ return $ codeblock name classes (map (second trimr) fields)
716+ (trim top) True body
739717 "aafig" -> do
740718 let attribs = (name, ["aafig"], map (second trimr) fields)
741719 return $ B.codeBlockWith attribs $ stripTrailingNewlines body
@@ -1021,10 +999,10 @@ toChunks = dropWhile T.null
1021999 then "\\begin{aligned}\n" <> s <> "\n\\end{aligned}"
10221000 else s
10231001
1024−codeblock :: Text -> [Text] -> [(Text, Text)] -> Text -> Text -> Bool
1025− -> RSTParser m Blocks
1026−codeblock ident classes fields lang body rmTrailingNewlines =
1027− return $ B.codeBlockWith attribs $ stripTrailingNewlines' body
1002+codeblock :: Text -> [Text] -> [(Text, Text)] -> Text -> Bool -> Text
1003+ -> Blocks
1004+codeblock ident classes fields lang rmTrailingNewlines body =
1005+ B.codeBlockWith attribs $ stripTrailingNewlines' body
10281006 where stripTrailingNewlines' = if rmTrailingNewlines
10291007 then stripTrailingNewlines
10301008 else id