diff options
Diffstat (limited to 'pandoc.hs')
-rw-r--r-- | pandoc.hs | 31 |
1 files changed, 27 insertions, 4 deletions
@@ -215,6 +215,7 @@ data Opt = Opt , optExtractMedia :: Maybe FilePath -- ^ Path to extract embedded media , optTrace :: Bool -- ^ Print debug information , optTrackChanges :: TrackChanges -- ^ Accept or reject MS Word track-changes. + , optFileScope :: Bool -- ^ Parse input files before combining , optKaTeXStylesheet :: Maybe String -- ^ Path to stylesheet for KaTeX , optKaTeXJS :: Maybe String -- ^ Path to js file for KaTeX } @@ -278,6 +279,7 @@ defaultOpts = Opt , optExtractMedia = Nothing , optTrace = False , optTrackChanges = AcceptChanges + , optFileScope = False , optKaTeXStylesheet = Nothing , optKaTeXJS = Nothing } @@ -387,6 +389,11 @@ options = "accept|reject|all") "" -- "Accepting or reject MS Word track-changes."" + , Option "" ["file-scope"] + (NoArg + (\opt -> return opt { optFileScope = True })) + "" -- "Parse input files before combining" + , Option "" ["extract-media"] (ReqArg (\arg opt -> @@ -1009,6 +1016,8 @@ defaultWriterName x = ".fb2" -> "fb2" ".opml" -> "opml" ".icml" -> "icml" + ".tei.xml" -> "tei" + ".tei" -> "tei" ['.',y] | y `elem` ['1'..'9'] -> "man" _ -> "html" @@ -1115,6 +1124,7 @@ convertWithOpts opts args = do , optExtractMedia = mbExtractMedia , optTrace = trace , optTrackChanges = trackChanges + , optFileScope = fileScope , optKaTeXStylesheet = katexStylesheet , optKaTeXJS = katexJS } = opts @@ -1267,6 +1277,7 @@ convertWithOpts opts args = do , readerDefaultImageExtension = defaultImageExtension , readerTrace = trace , readerTrackChanges = trackChanges + , readerFileScope = fileScope } when (not (isTextFormat format) && outputFile == "-") $ @@ -1299,13 +1310,25 @@ convertWithOpts opts args = do then handleIncludes else return . Right - (doc, media) <- fmap handleError $ - case reader of + let sourceToDoc :: [FilePath] -> IO (Pandoc, MediaBag) + sourceToDoc sources' = fmap handleError $ + case reader of StringReader r-> do - srcs <- convertTabs . intercalate "\n" <$> readSources sources + srcs <- convertTabs . intercalate "\n" <$> readSources sources' doc <- handleIncludes' srcs either (return . Left) (\s -> fmap (,mempty) <$> r readerOpts s) doc - ByteStringReader r -> readFiles sources >>= r readerOpts + ByteStringReader r -> readFiles sources' >>= r readerOpts + + -- We parse first if (1) fileScope is set, (2), it's a binary + -- reader, or (3) we're reading JSON. This is easier to do of an AND + -- of negatives as opposed to an OR of positives, so we do default + -- parsing if it's a StringReader AND (fileScope is set AND it's not + -- a JSON reader). + (doc, media) <- case reader of + (StringReader _) | not fileScope && readerName' /= "json" -> + sourceToDoc sources + _ -> do pairs <- mapM (\s -> sourceToDoc [s]) sources + return (mconcat $ map fst pairs, mconcat $ map snd pairs) let writerOptions = def { writerStandalone = standalone', writerTemplate = templ, |