diff options
Diffstat (limited to 'src/Text/Pandoc/App')
-rw-r--r-- | src/Text/Pandoc/App/CommandLineOptions.hs | 25 | ||||
-rw-r--r-- | src/Text/Pandoc/App/FormatHeuristics.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/App/Opt.hs | 321 | ||||
-rw-r--r-- | src/Text/Pandoc/App/OutputSettings.hs | 33 |
4 files changed, 186 insertions, 195 deletions
diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs index a6df12715..759f8ac35 100644 --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -33,10 +33,8 @@ import Data.Bifunctor (second) import Data.Char (toLower) import Data.List (intercalate, sort, foldl') #ifdef _WINDOWS -#if MIN_VERSION_base(4,12,0) import Data.List (isPrefixOf) #endif -#endif import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) import Safe (tailDef) @@ -188,6 +186,11 @@ options = (\opt -> return opt { optFileScope = True })) "" -- "Parse input files before combining" + , Option "" ["sandbox"] + (NoArg + (\opt -> return opt { optSandbox = True })) + "" + , Option "s" ["standalone"] (NoArg (\opt -> return opt { optStandalone = True })) @@ -332,14 +335,8 @@ options = , Option "" ["syntax-definition"] (ReqArg - (\arg opt -> do - let tr c d = map (\x -> if x == c then d else x) - let arg' = case arg of -- see #4836 - -- HXT confuses Windows path with URI - _:':':'\\':_ -> - "file:///" ++ tr '\\' '/' arg - _ -> normalizePath arg - return opt{ optSyntaxDefinitions = arg' : + (\arg opt -> + return opt{ optSyntaxDefinitions = normalizePath arg : optSyntaxDefinitions opt }) "FILE") "" -- "Syntax definition (xml) file" @@ -576,10 +573,10 @@ options = (ReqArg (\arg opt -> case safeStrRead arg of - Just t | t >= 1 && t <= 6 -> + Just t | t >= 0 && t <= 6 -> return opt { optSlideLevel = Just t } _ -> E.throwIO $ PandocOptionError - "slide level must be a number between 1 and 6") + "slide level must be a number between 0 and 6") "NUMBER") "" -- "Force header level for slides" @@ -1079,7 +1076,6 @@ readMetaValue s -- beginning with \\ to \\?\UNC\. -- See #5127. normalizePath :: FilePath -> FilePath #ifdef _WINDOWS -#if MIN_VERSION_base(4,12,0) normalizePath fp = if "\\\\" `isPrefixOf` fp && not ("\\\\?\\" `isPrefixOf` fp) then "\\\\?\\UNC\\" ++ drop 2 fp @@ -1087,6 +1083,3 @@ normalizePath fp = #else normalizePath = id #endif -#else -normalizePath = id -#endif diff --git a/src/Text/Pandoc/App/FormatHeuristics.hs b/src/Text/Pandoc/App/FormatHeuristics.hs index bdf8c6667..e5fe7ad81 100644 --- a/src/Text/Pandoc/App/FormatHeuristics.hs +++ b/src/Text/Pandoc/App/FormatHeuristics.hs @@ -54,6 +54,7 @@ formatFromFilePath x = ".lhs" -> Just "markdown+lhs" ".ltx" -> Just "latex" ".markdown" -> Just "markdown" + ".markua" -> Just "markua" ".mkdn" -> Just "markdown" ".mkd" -> Just "markdown" ".mdwn" -> Just "markdown" @@ -74,7 +75,6 @@ formatFromFilePath x = ".s5" -> Just "s5" ".t2t" -> Just "t2t" ".tei" -> Just "tei" - ".tei.xml" -> Just "tei" ".tex" -> Just "latex" ".texi" -> Just "texinfo" ".texinfo" -> Just "texinfo" diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs index d54d932b7..c5fac7951 100644 --- a/src/Text/Pandoc/App/Opt.hs +++ b/src/Text/Pandoc/App/Opt.hs @@ -29,7 +29,7 @@ import Control.Monad.Except (MonadIO, liftIO, throwError, (>=>), foldM) import Control.Monad.State.Strict (StateT, modify, gets) import System.FilePath ( addExtension, (</>), takeExtension, takeDirectory ) import System.Directory ( canonicalizePath ) -import Data.Char (isLower, toLower) +import Data.Char (toLower) import Data.Maybe (fromMaybe) import GHC.Generics hiding (Meta) import Text.Pandoc.Filter (Filter (..)) @@ -40,11 +40,10 @@ import Text.Pandoc.Options (TopLevelDivision (TopLevelDefault), ReferenceLocation (EndOfDocument), ObfuscationMethod (NoObfuscation), CiteMethod (Citeproc)) -import Text.Pandoc.Class (readFileLazy, fileExists, setVerbosity, report, +import Text.Pandoc.Class (readFileStrict, fileExists, setVerbosity, report, PandocMonad(lookupEnv), getUserDataDir) import Text.Pandoc.Error (PandocError (PandocParseError, PandocSomeError)) -import Text.Pandoc.Shared (camelCaseStrToHyphenated, defaultUserDataDir, - findM, ordNub) +import Text.Pandoc.Shared (defaultUserDataDir, findM, ordNub) import qualified Text.Pandoc.Parsing as P import Text.Pandoc.Readers.Metadata (yamlMap) import Text.Pandoc.Class.PandocPure @@ -54,21 +53,18 @@ import Data.Default (def) import qualified Data.Text as T import qualified Data.Map as M import Text.Pandoc.Definition (Meta(..), MetaValue(..)) -import Data.Aeson (defaultOptions, Options(..)) +import Data.Aeson (defaultOptions, Options(..), Result(..), fromJSON, camelTo2) import Data.Aeson.TH (deriveJSON) import Control.Applicative ((<|>)) -import Data.YAML +import Data.Yaml -- | The type of line-endings to be used when writing plain-text. data LineEnding = LF | CRLF | Native deriving (Show, Generic) -instance FromYAML LineEnding where - parseYAML = withStr "LineEnding" $ \t -> - case T.toLower t of - "lf" -> return LF - "crlf" -> return CRLF - "native" -> return Native - _ -> fail $ "Unknown line ending type " ++ show t +-- see https://github.com/jgm/pandoc/pull/4083 +-- using generic deriving caused long compilation times +$(deriveJSON + defaultOptions{ constructorTagModifier = map toLower } ''LineEnding) -- | How to handle output blocks in ipynb. data IpynbOutput = @@ -77,13 +73,8 @@ data IpynbOutput = | IpynbOutputBest deriving (Show, Generic) -instance FromYAML IpynbOutput where - parseYAML = withStr "LineEnding" $ \t -> - case t of - "none" -> return IpynbOutputNone - "all" -> return IpynbOutputAll - "best" -> return IpynbOutputBest - _ -> fail $ "Unknown ipynb output type " ++ show t +$(deriveJSON + defaultOptions{ fieldLabelModifier = map toLower . drop 11 } ''IpynbOutput) -- | Data structure for command line options. data Opt = Opt @@ -160,11 +151,18 @@ data Opt = Opt , optCSL :: Maybe FilePath -- ^ CSL stylesheet , optBibliography :: [FilePath] -- ^ Bibliography files , optCitationAbbreviations :: Maybe FilePath -- ^ Citation abbreviations + , optSandbox :: Bool } deriving (Generic, Show) -instance FromYAML (Opt -> Opt) where - parseYAML (Mapping _ _ m) = chain doOpt (M.toList m) - parseYAML n = failAtNode n "Expected a mapping" +$(deriveJSON + defaultOptions{ fieldLabelModifier = camelTo2 '-' . drop 3 } ''Opt) + +instance FromJSON (Opt -> Opt) where + parseJSON (Object m) = + case fromJSON (Object m) of + Error err' -> fail err' + Success (m' :: M.Map Text Value) -> chain doOpt (M.toList m') + parseJSON _ = fail "Expected a mapping" data DefaultsState = DefaultsState { @@ -173,22 +171,21 @@ data DefaultsState = DefaultsState } deriving (Show) instance (PandocMonad m, MonadIO m) - => FromYAML (Opt -> StateT DefaultsState m Opt) where - parseYAML (Mapping _ _ m) = do - let opts = M.mapKeys toText m - dataDir <- case M.lookup "data-dir" opts of - Nothing -> return Nothing - Just v -> Just . unpack <$> parseYAML v - f <- parseOptions (M.toList m) - case M.lookup "defaults" opts of - Just v -> do - g <- parseDefaults v dataDir - return $ g >=> f >=> resolveVarsInOpt - Nothing -> return $ f >=> resolveVarsInOpt - where - toText (Scalar _ (SStr s)) = s - toText _ = "" - parseYAML n = failAtNode n "Expected a mapping" + => FromJSON (Opt -> StateT DefaultsState m Opt) where + parseJSON (Object o) = + case fromJSON (Object o) of + Error err' -> fail err' + Success (opts :: M.Map Text Value) -> do + dataDir <- case M.lookup "data-dir" opts of + Nothing -> return Nothing + Just v -> Just . unpack <$> parseJSON v + f <- parseOptions (M.toList opts) + case M.lookup "defaults" opts of + Just v -> do + g <- parseDefaults v dataDir + return $ g >=> f >=> resolveVarsInOpt + Nothing -> return $ f >=> resolveVarsInOpt + parseJSON _ = fail "Expected a mapping" resolveVarsInOpt :: forall m. (PandocMonad m, MonadIO m) => Opt -> StateT DefaultsState m Opt @@ -302,7 +299,7 @@ resolveVarsInOpt parseDefaults :: (PandocMonad m, MonadIO m) - => Node Pos + => Value -> Maybe FilePath -> Parser (Opt -> StateT DefaultsState m Opt) parseDefaults n dataDir = parseDefsNames n >>= \ds -> return $ \o -> do @@ -321,11 +318,11 @@ parseDefaults n dataDir = parseDefsNames n >>= \ds -> return $ \o -> do "Error: Circular defaults file reference in " ++ "'" ++ defsParent ++ "'" else foldM applyDefaults o defsChildren - where parseDefsNames x = (parseYAML x >>= \xs -> return $ map unpack xs) - <|> (parseYAML x >>= \x' -> return [unpack x']) + where parseDefsNames x = (parseJSON x >>= \xs -> return $ map unpack xs) + <|> (parseJSON x >>= \x' -> return [unpack x']) parseOptions :: Monad m - => [(Node Pos, Node Pos)] + => [(Text, Value)] -> Parser (Opt -> StateT DefaultsState m Opt) parseOptions ns = do f <- chain doOpt' ns @@ -335,267 +332,267 @@ chain :: Monad m => (a -> m (b -> b)) -> [a] -> m (b -> b) chain f = foldM g id where g o n = f n >>= \o' -> return $ o' . o -doOpt' :: (Node Pos, Node Pos) -> Parser (Opt -> Opt) -doOpt' (k',v) = do - k <- parseStringKey k' +doOpt' :: (Text, Value) -> Parser (Opt -> Opt) +doOpt' (k,v) = do case k of "defaults" -> return id - _ -> doOpt (k',v) + _ -> doOpt (k,v) -doOpt :: (Node Pos, Node Pos) -> Parser (Opt -> Opt) -doOpt (k',v) = do - k <- parseStringKey k' +doOpt :: (Text, Value) -> Parser (Opt -> Opt) +doOpt (k,v) = do case k of "tab-stop" -> - parseYAML v >>= \x -> return (\o -> o{ optTabStop = x }) + parseJSON v >>= \x -> return (\o -> o{ optTabStop = x }) "preserve-tabs" -> - parseYAML v >>= \x -> return (\o -> o{ optPreserveTabs = x }) + parseJSON v >>= \x -> return (\o -> o{ optPreserveTabs = x }) "standalone" -> - parseYAML v >>= \x -> return (\o -> o{ optStandalone = x }) + parseJSON v >>= \x -> return (\o -> o{ optStandalone = x }) "table-of-contents" -> - parseYAML v >>= \x -> return (\o -> o{ optTableOfContents = x }) + parseJSON v >>= \x -> return (\o -> o{ optTableOfContents = x }) "toc" -> - parseYAML v >>= \x -> return (\o -> o{ optTableOfContents = x }) + parseJSON v >>= \x -> return (\o -> o{ optTableOfContents = x }) "from" -> - parseYAML v >>= \x -> return (\o -> o{ optFrom = x }) + parseJSON v >>= \x -> return (\o -> o{ optFrom = x }) "reader" -> - parseYAML v >>= \x -> return (\o -> o{ optFrom = x }) + parseJSON v >>= \x -> return (\o -> o{ optFrom = x }) "to" -> - parseYAML v >>= \x -> return (\o -> o{ optTo = x }) + parseJSON v >>= \x -> return (\o -> o{ optTo = x }) "writer" -> - parseYAML v >>= \x -> return (\o -> o{ optTo = x }) + parseJSON v >>= \x -> return (\o -> o{ optTo = x }) "shift-heading-level-by" -> - parseYAML v >>= \x -> return (\o -> o{ optShiftHeadingLevelBy = x }) + parseJSON v >>= \x -> return (\o -> o{ optShiftHeadingLevelBy = x }) "template" -> - parseYAML v >>= \x -> return (\o -> o{ optTemplate = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optTemplate = unpack <$> x }) "variables" -> - parseYAML v >>= \x -> return (\o -> o{ optVariables = + parseJSON v >>= \x -> return (\o -> o{ optVariables = x <> optVariables o }) -- Note: x comes first because <> for Context is left-biased union -- and we want to favor later default files. See #5988. "metadata" -> yamlToMeta v >>= \x -> return (\o -> o{ optMetadata = optMetadata o <> x }) "metadata-files" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optMetadataFiles = optMetadataFiles o <> map unpack x }) "metadata-file" -> -- allow either a list or a single value - (parseYAML v >>= \x -> return (\o -> o{ optMetadataFiles = + (parseJSON v >>= \x -> return (\o -> o{ optMetadataFiles = optMetadataFiles o <> map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optMetadataFiles = optMetadataFiles o <>[unpack x] })) "output-file" -> - parseYAML v >>= \x -> return (\o -> o{ optOutputFile = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optOutputFile = unpack <$> x }) "input-files" -> - parseYAML v >>= \x -> return (\o -> o{ optInputFiles = + parseJSON v >>= \x -> return (\o -> o{ optInputFiles = optInputFiles o <> (map unpack <$> x) }) "input-file" -> -- allow either a list or a single value - (parseYAML v >>= \x -> return (\o -> o{ optInputFiles = + (parseJSON v >>= \x -> return (\o -> o{ optInputFiles = optInputFiles o <> (map unpack <$> x) })) <|> - (parseYAML v >>= \x -> return (\o -> o{ optInputFiles = + (parseJSON v >>= \x -> return (\o -> o{ optInputFiles = optInputFiles o <> ((\z -> [unpack z]) <$> x) })) "number-sections" -> - parseYAML v >>= \x -> return (\o -> o{ optNumberSections = x }) + parseJSON v >>= \x -> return (\o -> o{ optNumberSections = x }) "number-offset" -> - parseYAML v >>= \x -> return (\o -> o{ optNumberOffset = x }) + parseJSON v >>= \x -> return (\o -> o{ optNumberOffset = x }) "section-divs" -> - parseYAML v >>= \x -> return (\o -> o{ optSectionDivs = x }) + parseJSON v >>= \x -> return (\o -> o{ optSectionDivs = x }) "incremental" -> - parseYAML v >>= \x -> return (\o -> o{ optIncremental = x }) + parseJSON v >>= \x -> return (\o -> o{ optIncremental = x }) "self-contained" -> - parseYAML v >>= \x -> return (\o -> o{ optSelfContained = x }) + parseJSON v >>= \x -> return (\o -> o{ optSelfContained = x }) "html-q-tags" -> - parseYAML v >>= \x -> return (\o -> o{ optHtmlQTags = x }) + parseJSON v >>= \x -> return (\o -> o{ optHtmlQTags = x }) "highlight-style" -> - parseYAML v >>= \x -> return (\o -> o{ optHighlightStyle = x }) + parseJSON v >>= \x -> return (\o -> o{ optHighlightStyle = x }) "syntax-definition" -> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optSyntaxDefinitions = optSyntaxDefinitions o <> map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optSyntaxDefinitions = optSyntaxDefinitions o <> [unpack x] })) "syntax-definitions" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optSyntaxDefinitions = optSyntaxDefinitions o <> map unpack x }) "top-level-division" -> - parseYAML v >>= \x -> return (\o -> o{ optTopLevelDivision = x }) + parseJSON v >>= \x -> return (\o -> o{ optTopLevelDivision = x }) "html-math-method" -> - parseYAML v >>= \x -> return (\o -> o{ optHTMLMathMethod = x }) + parseJSON v >>= \x -> return (\o -> o{ optHTMLMathMethod = x }) "abbreviations" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optAbbreviations = unpack <$> x }) "reference-doc" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optReferenceDoc = unpack <$> x }) "epub-subdirectory" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optEpubSubdirectory = unpack x }) "epub-metadata" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optEpubMetadata = unpack <$> x }) "epub-fonts" -> - parseYAML v >>= \x -> return (\o -> o{ optEpubFonts = optEpubFonts o <> + parseJSON v >>= \x -> return (\o -> o{ optEpubFonts = optEpubFonts o <> map unpack x }) "epub-chapter-level" -> - parseYAML v >>= \x -> return (\o -> o{ optEpubChapterLevel = x }) + parseJSON v >>= \x -> return (\o -> o{ optEpubChapterLevel = x }) "epub-cover-image" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optEpubCoverImage = unpack <$> x }) "toc-depth" -> - parseYAML v >>= \x -> return (\o -> o{ optTOCDepth = x }) + parseJSON v >>= \x -> return (\o -> o{ optTOCDepth = x }) "dump-args" -> - parseYAML v >>= \x -> return (\o -> o{ optDumpArgs = x }) + parseJSON v >>= \x -> return (\o -> o{ optDumpArgs = x }) "ignore-args" -> - parseYAML v >>= \x -> return (\o -> o{ optIgnoreArgs = x }) + parseJSON v >>= \x -> return (\o -> o{ optIgnoreArgs = x }) "verbosity" -> - parseYAML v >>= \x -> return (\o -> o{ optVerbosity = x }) + parseJSON v >>= \x -> return (\o -> o{ optVerbosity = x }) "trace" -> - parseYAML v >>= \x -> return (\o -> o{ optTrace = x }) + parseJSON v >>= \x -> return (\o -> o{ optTrace = x }) "log-file" -> - parseYAML v >>= \x -> return (\o -> o{ optLogFile = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optLogFile = unpack <$> x }) "fail-if-warnings" -> - parseYAML v >>= \x -> return (\o -> o{ optFailIfWarnings = x }) + parseJSON v >>= \x -> return (\o -> o{ optFailIfWarnings = x }) "reference-links" -> - parseYAML v >>= \x -> return (\o -> o{ optReferenceLinks = x }) + parseJSON v >>= \x -> return (\o -> o{ optReferenceLinks = x }) "reference-location" -> - parseYAML v >>= \x -> return (\o -> o{ optReferenceLocation = x }) + parseJSON v >>= \x -> return (\o -> o{ optReferenceLocation = x }) "dpi" -> - parseYAML v >>= \x -> return (\o -> o{ optDpi = x }) + parseJSON v >>= \x -> return (\o -> o{ optDpi = x }) "wrap" -> - parseYAML v >>= \x -> return (\o -> o{ optWrap = x }) + parseJSON v >>= \x -> return (\o -> o{ optWrap = x }) "columns" -> - parseYAML v >>= \x -> return (\o -> o{ optColumns = x }) + parseJSON v >>= \x -> return (\o -> o{ optColumns = x }) "filters" -> - parseYAML v >>= \x -> return (\o -> o{ optFilters = optFilters o <> x }) + parseJSON v >>= \x -> return (\o -> o{ optFilters = optFilters o <> x }) "citeproc" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> if x then return (\o -> o{ optFilters = CiteprocFilter : optFilters o }) else return id "email-obfuscation" -> - parseYAML v >>= \x -> return (\o -> o{ optEmailObfuscation = x }) + parseJSON v >>= \x -> return (\o -> o{ optEmailObfuscation = x }) "identifier-prefix" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optIdentifierPrefix = x }) "strip-empty-paragraphs" -> - parseYAML v >>= \x -> return (\o -> o{ optStripEmptyParagraphs = x }) + parseJSON v >>= \x -> return (\o -> o{ optStripEmptyParagraphs = x }) "indented-code-classes" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optIndentedCodeClasses = x }) "data-dir" -> - parseYAML v >>= \x -> return (\o -> o{ optDataDir = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optDataDir = unpack <$> x }) "cite-method" -> - parseYAML v >>= \x -> return (\o -> o{ optCiteMethod = x }) + parseJSON v >>= \x -> return (\o -> o{ optCiteMethod = x }) "listings" -> - parseYAML v >>= \x -> return (\o -> o{ optListings = x }) + parseJSON v >>= \x -> return (\o -> o{ optListings = x }) "pdf-engine" -> - parseYAML v >>= \x -> return (\o -> o{ optPdfEngine = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optPdfEngine = unpack <$> x }) "pdf-engine-opts" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optPdfEngineOpts = map unpack x }) "pdf-engine-opt" -> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optPdfEngineOpts = map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optPdfEngineOpts = [unpack x] })) "slide-level" -> - parseYAML v >>= \x -> return (\o -> o{ optSlideLevel = x }) + parseJSON v >>= \x -> return (\o -> o{ optSlideLevel = x }) "atx-headers" -> - parseYAML v >>= \x -> return (\o -> o{ optSetextHeaders = not x }) + parseJSON v >>= \x -> return (\o -> o{ optSetextHeaders = not x }) "markdown-headings" -> - parseYAML v >>= \x -> return (\o -> + parseJSON v >>= \x -> return (\o -> case T.toLower x of "atx" -> o{ optSetextHeaders = False } "setext" -> o{ optSetextHeaders = True } _ -> o) "ascii" -> - parseYAML v >>= \x -> return (\o -> o{ optAscii = x }) + parseJSON v >>= \x -> return (\o -> o{ optAscii = x }) "default-image-extension" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optDefaultImageExtension = x }) "extract-media" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optExtractMedia = unpack <$> x }) "track-changes" -> - parseYAML v >>= \x -> return (\o -> o{ optTrackChanges = x }) + parseJSON v >>= \x -> return (\o -> o{ optTrackChanges = x }) "file-scope" -> - parseYAML v >>= \x -> return (\o -> o{ optFileScope = x }) + parseJSON v >>= \x -> return (\o -> o{ optFileScope = x }) "title-prefix" -> - parseYAML v >>= \x -> return (\o -> o{ optTitlePrefix = x, + parseJSON v >>= \x -> return (\o -> o{ optTitlePrefix = x, optStandalone = True }) "css" -> - (parseYAML v >>= \x -> return (\o -> o{ optCss = optCss o <> + (parseJSON v >>= \x -> return (\o -> o{ optCss = optCss o <> map unpack x })) <|> - (parseYAML v >>= \x -> return (\o -> o{ optCss = optCss o <> + (parseJSON v >>= \x -> return (\o -> o{ optCss = optCss o <> [unpack x] })) "bibliography" -> - (parseYAML v >>= \x -> return (\o -> + (parseJSON v >>= \x -> return (\o -> o{ optBibliography = optBibliography o <> map unpack x })) <|> - (parseYAML v >>= \x -> return (\o -> + (parseJSON v >>= \x -> return (\o -> o{ optBibliography = optBibliography o <> [unpack x] })) "csl" -> - parseYAML v >>= \x -> return (\o -> o{ optCSL = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optCSL = unpack <$> x }) "citation-abbreviations" -> - parseYAML v >>= \x -> return (\o -> o{ optCitationAbbreviations = + parseJSON v >>= \x -> return (\o -> o{ optCitationAbbreviations = unpack <$> x }) "ipynb-output" -> - parseYAML v >>= \x -> return (\o -> o{ optIpynbOutput = x }) + parseJSON v >>= \x -> return (\o -> o{ optIpynbOutput = x }) "include-before-body" -> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeBeforeBody = optIncludeBeforeBody o <> map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeBeforeBody = optIncludeBeforeBody o <> [unpack x] })) "include-after-body" -> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeAfterBody = optIncludeAfterBody o <> map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeAfterBody = optIncludeAfterBody o <> [unpack x] })) "include-in-header" -> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeInHeader = optIncludeInHeader o <> map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeInHeader = optIncludeInHeader o <> [unpack x] })) "resource-path" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optResourcePath = map unpack x <> optResourcePath o }) "request-headers" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optRequestHeaders = x }) "no-check-certificate" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optNoCheckCertificate = x }) "eol" -> - parseYAML v >>= \x -> return (\o -> o{ optEol = x }) + parseJSON v >>= \x -> return (\o -> o{ optEol = x }) "strip-comments" -> - parseYAML v >>= \x -> return (\o -> o { optStripComments = x }) - _ -> failAtNode k' $ "Unknown option " ++ show k + parseJSON v >>= \x -> return (\o -> o { optStripComments = x }) + "sandbox" -> + parseJSON v >>= \x -> return (\o -> o { optSandbox = x }) + _ -> fail $ "Unknown option " ++ show k -- | Defaults for command-line options. defaultOpts :: Opt @@ -673,20 +670,15 @@ defaultOpts = Opt , optCSL = Nothing , optBibliography = [] , optCitationAbbreviations = Nothing + , optSandbox = False } -parseStringKey :: Node Pos -> Parser Text -parseStringKey k = case k of - Scalar _ (SStr t) -> return t - Scalar _ _ -> failAtNode k "Non-string key" - _ -> failAtNode k "Non-scalar key" - -yamlToMeta :: Node Pos -> Parser Meta -yamlToMeta (Mapping _ _ m) = - either (fail . show) return $ runEverything (yamlMap pMetaString m) - where - pMetaString = pure . MetaString <$> P.manyChar P.anyChar - runEverything p = +yamlToMeta :: Value -> Parser Meta +yamlToMeta (Object o) = + either (fail . show) return $ runEverything (yamlMap pMetaString o) + where + pMetaString = pure . MetaString <$> P.manyChar P.anyChar + runEverything p = runPure (P.readWithM p (def :: P.ParserState) ("" :: Text)) >>= fmap (Meta . flip P.runF def) yamlToMeta _ = return mempty @@ -699,14 +691,12 @@ applyDefaults :: (PandocMonad m, MonadIO m) applyDefaults opt file = do setVerbosity $ optVerbosity opt modify $ \defsState -> defsState{ curDefaults = Just file } - inp <- readFileLazy file - case decode1 inp of + inp <- readFileStrict file + case decodeEither' inp of Right f -> f opt - Left (errpos, errmsg) -> throwError $ - PandocParseError $ T.pack $ - "Error parsing " ++ file ++ " line " ++ - show (posLine errpos) ++ " column " ++ - show (posColumn errpos) ++ ":\n" ++ errmsg + Left err' -> throwError $ + PandocParseError + $ T.pack $ Data.Yaml.prettyPrintParseException err' fullDefaultsPath :: (PandocMonad m, MonadIO m) => Maybe FilePath @@ -734,14 +724,3 @@ cyclic :: Ord a => [[a]] -> Bool cyclic = any hasDuplicate where hasDuplicate xs = length (ordNub xs) /= length xs - --- see https://github.com/jgm/pandoc/pull/4083 --- using generic deriving caused long compilation times -$(deriveJSON - defaultOptions{ fieldLabelModifier = drop 11 . map toLower } ''IpynbOutput) -$(deriveJSON - defaultOptions{ fieldLabelModifier = map toLower } ''LineEnding) -$(deriveJSON - defaultOptions{ fieldLabelModifier = - camelCaseStrToHyphenated . dropWhile isLower - } ''Opt) diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs index 3864ab188..7b057713b 100644 --- a/src/Text/Pandoc/App/OutputSettings.hs +++ b/src/Text/Pandoc/App/OutputSettings.hs @@ -45,16 +45,16 @@ readUtf8File :: PandocMonad m => FilePath -> m T.Text readUtf8File = fmap UTF8.toText . readFileStrict -- | Settings specifying how document output should be produced. -data OutputSettings = OutputSettings +data OutputSettings m = OutputSettings { outputFormat :: T.Text - , outputWriter :: Writer PandocIO + , outputWriter :: Writer m , outputWriterName :: T.Text , outputWriterOptions :: WriterOptions , outputPdfProgram :: Maybe String } -- | Get output settings from command line options. -optToOutputSettings :: Opt -> PandocIO OutputSettings +optToOutputSettings :: (PandocMonad m, MonadIO m) => Opt -> m (OutputSettings m) optToOutputSettings opts = do let outputFile = fromMaybe "-" (optOutputFile opts) @@ -90,12 +90,31 @@ optToOutputSettings opts = do then writerName else T.toLower $ baseWriterName writerName - (writer :: Writer PandocIO, writerExts) <- + let makeSandboxed pureWriter = + let files = maybe id (:) (optReferenceDoc opts) . + maybe id (:) (optEpubMetadata opts) . + maybe id (:) (optEpubCoverImage opts) . + maybe id (:) (optCSL opts) . + maybe id (:) (optCitationAbbreviations opts) $ + optEpubFonts opts ++ + optBibliography opts + in case pureWriter of + TextWriter w -> TextWriter $ \o d -> sandbox files (w o d) + ByteStringWriter w + -> ByteStringWriter $ \o d -> sandbox files (w o d) + + + (writer, writerExts) <- if ".lua" `T.isSuffixOf` format then return (TextWriter - (\o d -> writeCustom (T.unpack writerName) o d) - :: Writer PandocIO, mempty) - else getWriter (T.toLower writerName) + (\o d -> writeCustom (T.unpack writerName) o d), mempty) + else if optSandbox opts + then + case runPure (getWriter writerName) of + Left e -> throwError e + Right (w, wexts) -> + return (makeSandboxed w, wexts) + else getWriter (T.toLower writerName) let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput |