41a3ac9 · typeable/pandoc

27import qualified Data.Text as T

28import Text.Pandoc.Builder (Blocks, Inlines, fromList, setMeta, trimInlines)

29import qualified Text.Pandoc.Builder as B

30−import Text.Pandoc.Class.PandocMonad (PandocMonad, fetchItem,

30+import Text.Pandoc.Class.PandocMonad (PandocMonad, fetchItem, getTimestamp)

31− readFileFromDirs, getTimestamp)

32import Text.Pandoc.CSV (CSVOptions (..), defaultCSVOptions, parseCSV)

31import Text.Pandoc.CSV (CSVOptions (..), defaultCSVOptions, parseCSV)

33import Text.Pandoc.Definition

32import Text.Pandoc.Definition

34import Text.Pandoc.Error

33import Text.Pandoc.Error

453-}

452-}

454

453

455includeDirective :: PandocMonad m

454includeDirective :: PandocMonad m

455+ => Text

456− => Text -> [(Text, Text)] -> Text

456+ -> [(Text, Text)]

457+ -> Text

457 -> RSTParser m Blocks

458 -> RSTParser m Blocks

458includeDirective top fields body = do

459includeDirective top fields body = do

459− let f = trim top

460+ let f = T.unpack $ trim top

460− guard $ not (T.null f)

461+ guard $ not $ null f

461 guard $ T.null (trim body)

462 guard $ T.null (trim body)

462− -- options

463− let (startLine :: Maybe Int) = lookup "start-line" fields >>= safeRead

463+ let startLine = lookup "start-line" fields >>= safeRead

464− let (endLine :: Maybe Int) = lookup "end-line" fields >>= safeRead

464+ let endLine = 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)

465+ let classes = maybe [] T.words (lookup "class" fields)

498− let ident = maybe "" trimr $ lookup "name" fields

466+ let ident = maybe "" trimr $ lookup "name" fields

467+ let parser =

468+ case lookup "code" fields of

469+ Just lang ->

499− codeblock ident classes fields (trimr lang) contents' False

470+ (codeblock ident classes fields (trimr lang) False

471+ . sourcesToText) <$> getInput

472+ Nothing ->

500− Nothing -> case lookup "literal" fields of

473+ case lookup "literal" fields of

501− Just _ -> return $ B.rawBlock "rst" contents'

474+ Just _ -> B.rawBlock "rst" . sourcesToText <$> getInput

502− Nothing -> do

475+ Nothing -> parseBlocks

503− addToSources (initialPos (T.unpack f))

476+ let selectLines =

504− (contents' <> "\n")

477+ (case trim <$> lookup "end-before" fields of

505− updateState $ \s -> s{ stateContainers =

478+ Just patt -> takeWhile (not . (patt `T.isInfixOf`))

506− tail $ stateContainers s }

479+ Nothing -> id) .

507− return mempty

480+ (case trim <$> lookup "start-after" fields of

508−

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

509

487

510--

488--

511-- list blocks

489-- list blocks

734 "" -> stateRstHighlight def

712 "" -> stateRstHighlight def

735 lang -> Just lang })

713 lang -> Just lang })

736 x | x == "code" || x == "code-block" || x == "sourcecode" ->

714 x | x == "code" || x == "code-block" || x == "sourcecode" ->

737− codeblock name classes (map (second trimr) fields)

715+ return $ codeblock name classes (map (second trimr) fields)

738− (trim top) body True

716+ (trim top) True body

739 "aafig" -> do

717 "aafig" -> do

740 let attribs = (name, ["aafig"], map (second trimr) fields)

718 let attribs = (name, ["aafig"], map (second trimr) fields)

741 return $ B.codeBlockWith attribs $ stripTrailingNewlines body

719 return $ B.codeBlockWith attribs $ stripTrailingNewlines body

1021 then "\\begin{aligned}\n" <> s <> "\n\\end{aligned}"

999 then "\\begin{aligned}\n" <> s <> "\n\\end{aligned}"

1022 else s

1000 else s

1023

1001

1024−codeblock :: Text -> [Text] -> [(Text, Text)] -> Text -> Text -> Bool

1002+codeblock :: Text -> [Text] -> [(Text, Text)] -> Text -> Bool -> Text

1025− -> RSTParser m Blocks

1003+ -> Blocks

1026−codeblock ident classes fields lang body rmTrailingNewlines =

1004+codeblock ident classes fields lang rmTrailingNewlines body =

1027− return $ B.codeBlockWith attribs $ stripTrailingNewlines' body

1005+ B.codeBlockWith attribs $ stripTrailingNewlines' body

1028 where stripTrailingNewlines' = if rmTrailingNewlines

1006 where stripTrailingNewlines' = if rmTrailingNewlines

1029 then stripTrailingNewlines

1007 then stripTrailingNewlines

1030 else id

1008 else id