diff options
Diffstat (limited to 'src/Text/Pandoc/App')
-rw-r--r-- | src/Text/Pandoc/App/CommandLineOptions.hs | 115 | ||||
-rw-r--r-- | src/Text/Pandoc/App/FormatHeuristics.hs | 27 | ||||
-rw-r--r-- | src/Text/Pandoc/App/Opt.hs | 312 | ||||
-rw-r--r-- | src/Text/Pandoc/App/OutputSettings.hs | 6 |
4 files changed, 347 insertions, 113 deletions
diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs index 906fcc4c0..a6df12715 100644 --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -6,7 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {- | Module : Text.Pandoc.App.CommandLineOptions - Copyright : Copyright (C) 2006-2020 John MacFarlane + Copyright : Copyright (C) 2006-2021 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley@edu> @@ -17,6 +17,7 @@ Does a pandoc conversion based on command-line options. -} module Text.Pandoc.App.CommandLineOptions ( parseOptions + , parseOptionsFromArgs , options , engines , lookupHighlightStyle @@ -25,11 +26,12 @@ module Text.Pandoc.App.CommandLineOptions ( import Control.Monad import Control.Monad.Trans import Control.Monad.Except (throwError) +import Control.Monad.State.Strict import Data.Aeson.Encode.Pretty (encodePretty', Config(..), keyOrder, defConfig, Indent(..), NumberFormat(..)) import Data.Bifunctor (second) import Data.Char (toLower) -import Data.List (intercalate, sort) +import Data.List (intercalate, sort, foldl') #ifdef _WINDOWS #if MIN_VERSION_base(4,12,0) import Data.List (isPrefixOf) @@ -46,10 +48,13 @@ import System.FilePath import System.IO (stdout) import Text.DocTemplates (Context (..), ToContext (toVal), Val (..)) import Text.Pandoc -import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), IpynbOutput (..), addMeta) +import Text.Pandoc.Builder (setMeta) +import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), IpynbOutput (..), + DefaultsState (..), applyDefaults, + fullDefaultsPath) import Text.Pandoc.Filter (Filter (..)) import Text.Pandoc.Highlighting (highlightingStyles) -import Text.Pandoc.Shared (ordNub, elemText, safeStrRead, defaultUserDataDirs, findM) +import Text.Pandoc.Shared (ordNub, elemText, safeStrRead, defaultUserDataDir) import Text.Printf #ifdef EMBED_DATA_FILES @@ -64,16 +69,19 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as B import qualified Data.Map as M import qualified Data.Text as T -import qualified Data.YAML as Y import qualified Text.Pandoc.UTF8 as UTF8 parseOptions :: [OptDescr (Opt -> IO Opt)] -> Opt -> IO Opt parseOptions options' defaults = do rawArgs <- map UTF8.decodeArg <$> getArgs prg <- getProgName + parseOptionsFromArgs options' defaults prg rawArgs +parseOptionsFromArgs + :: [OptDescr (Opt -> IO Opt)] -> Opt -> String -> [String] -> IO Opt +parseOptionsFromArgs options' defaults prg rawArgs = do let (actions, args, unrecognizedOpts, errors) = - getOpt' Permute options' rawArgs + getOpt' Permute options' (map UTF8.decodeArg rawArgs) let unknownOptionErrors = foldr (handleUnrecognizedOption . takeWhile (/= '=')) [] @@ -85,7 +93,7 @@ parseOptions options' defaults = do ("Try " ++ prg ++ " --help for more information.") -- thread option data structure through all supplied option actions - opts <- foldl (>>=) (return defaults) actions + opts <- foldl' (>>=) (return defaults) actions let mbArgs = case args of [] -> Nothing xs -> Just xs @@ -166,7 +174,11 @@ options = , Option "d" ["defaults"] (ReqArg - (\arg opt -> applyDefaults opt arg + (\arg opt -> runIOorExplode $ do + let defsState = DefaultsState { curDefaults = Nothing, + inheritanceGraph = [] } + fp <- fullDefaultsPath (optDataDir opt) arg + evalStateT (applyDefaults opt fp) defsState ) "FILE") "" @@ -276,7 +288,8 @@ options = , Option "" ["resource-path"] (ReqArg (\arg opt -> return opt { optResourcePath = - splitSearchPath arg }) + splitSearchPath arg ++ + optResourcePath opt }) "SEARCHPATH") "" -- "Paths to search for images and other resources" @@ -801,10 +814,10 @@ options = map (\c -> ['-',c]) shorts ++ map ("--" ++) longs let allopts = unwords (concatMap optnames options) - UTF8.hPutStrLn stdout $ printf tpl allopts - (unwords readersNames) - (unwords writersNames) - (unwords $ map (T.unpack . fst) highlightingStyles) + UTF8.hPutStrLn stdout $ T.pack $ printf tpl allopts + (T.unpack $ T.unwords readersNames) + (T.unpack $ T.unwords writersNames) + (T.unpack $ T.unwords $ map fst highlightingStyles) (unwords datafiles) exitSuccess )) "" -- "Print bash completion script" @@ -843,7 +856,7 @@ options = else if extensionEnabled x allExts then '-' else ' ') : drop 4 (show x) - mapM_ (UTF8.hPutStrLn stdout . showExt) + mapM_ (UTF8.hPutStrLn stdout . T.pack . showExt) [ex | ex <- extList, extensionEnabled ex allExts] exitSuccess ) "FORMAT") @@ -857,14 +870,14 @@ options = , sShortname s `notElem` [T.pack "Alert", T.pack "Alert_indent"] ] - mapM_ (UTF8.hPutStrLn stdout) (sort langs) + mapM_ (UTF8.hPutStrLn stdout . T.pack) (sort langs) exitSuccess )) "" , Option "" ["list-highlight-styles"] (NoArg (\_ -> do - mapM_ (UTF8.hPutStrLn stdout . T.unpack . fst) highlightingStyles + mapM_ (UTF8.hPutStrLn stdout . fst) highlightingStyles exitSuccess )) "" @@ -882,7 +895,7 @@ options = | T.null t -> -- e.g. for docx, odt, json: E.throwIO $ PandocCouldNotFindDataFileError $ T.pack ("templates/default." ++ arg) - | otherwise -> write . T.unpack $ t + | otherwise -> write t Left e -> E.throwIO e exitSuccess) "FORMAT") @@ -928,12 +941,13 @@ options = (NoArg (\_ -> do prg <- getProgName - defaultDatadirs <- defaultUserDataDirs - UTF8.hPutStrLn stdout (prg ++ " " ++ T.unpack pandocVersion ++ - compileInfo ++ - "\nUser data directory: " ++ - intercalate " or " defaultDatadirs ++ - ('\n':copyrightMessage)) + defaultDatadir <- defaultUserDataDir + UTF8.hPutStrLn stdout + $ T.pack + $ prg ++ " " ++ T.unpack pandocVersion ++ + compileInfo ++ + "\nUser data directory: " ++ defaultDatadir ++ + ('\n':copyrightMessage) exitSuccess )) "" -- "Print version" @@ -941,7 +955,7 @@ options = (NoArg (\_ -> do prg <- getProgName - UTF8.hPutStr stdout (usageMessage prg options) + UTF8.hPutStr stdout (T.pack $ usageMessage prg options) exitSuccess )) "" -- "Show help" ] @@ -962,7 +976,7 @@ usageMessage programName = usageInfo (programName ++ " [OPTIONS] [FILES]") copyrightMessage :: String copyrightMessage = intercalate "\n" [ - "Copyright (C) 2006-2020 John MacFarlane. Web: https://pandoc.org", + "Copyright (C) 2006-2021 John MacFarlane. Web: https://pandoc.org", "This is free software; see the source for copying conditions. There is no", "warranty, not even for merchantability or fitness for a particular purpose." ] @@ -1002,38 +1016,16 @@ handleUnrecognizedOption "-R" = handleUnrecognizedOption "--parse-raw" handleUnrecognizedOption x = (("Unknown option " ++ x ++ ".") :) -readersNames :: [String] -readersNames = sort (map (T.unpack . fst) (readers :: [(Text, Reader PandocIO)])) +readersNames :: [Text] +readersNames = sort (map fst (readers :: [(Text, Reader PandocIO)])) -writersNames :: [String] +writersNames :: [Text] writersNames = sort - ("pdf" : map (T.unpack . fst) (writers :: [(Text, Writer PandocIO)])) + ("pdf" : map fst (writers :: [(Text, Writer PandocIO)])) splitField :: String -> (String, String) splitField = second (tailDef "true") . break (`elemText` ":=") --- | Apply defaults from --defaults file. -applyDefaults :: Opt -> FilePath -> IO Opt -applyDefaults opt file = runIOorExplode $ do - let fp = if null (takeExtension file) - then addExtension file "yaml" - else file - setVerbosity $ optVerbosity opt - dataDirs <- liftIO defaultUserDataDirs - let fps = fp : case optDataDir opt of - Nothing -> map (</> ("defaults" </> fp)) - dataDirs - Just dd -> [dd </> "defaults" </> fp] - fp' <- fromMaybe fp <$> findM fileExists fps - inp <- readFileLazy fp' - case Y.decode1 inp of - Right (f :: Opt -> Opt) -> return $ f opt - Left (errpos, errmsg) -> throwError $ - PandocParseError $ T.pack $ - "Error parsing " ++ fp' ++ " line " ++ - show (Y.posLine errpos) ++ " column " ++ - show (Y.posColumn errpos) ++ ":\n" ++ errmsg - lookupHighlightStyle :: PandocMonad m => String -> m Style lookupHighlightStyle s | takeExtension s == ".theme" = -- attempt to load KDE theme @@ -1062,6 +1054,27 @@ setVariable key val (Context ctx) = Context $ M.alter go key ctx go (Just (ListVal xs)) = Just $ ListVal $ xs ++ [toVal val] go (Just x) = Just $ ListVal [x, toVal val] +addMeta :: String -> String -> Meta -> Meta +addMeta k v meta = + case lookupMeta k' meta of + Nothing -> setMeta k' v' meta + Just (MetaList xs) -> + setMeta k' (MetaList (xs ++ [v'])) meta + Just x -> setMeta k' (MetaList [x, v']) meta + where + v' = readMetaValue v + k' = T.pack k + +readMetaValue :: String -> MetaValue +readMetaValue s + | s == "true" = MetaBool True + | s == "True" = MetaBool True + | s == "TRUE" = MetaBool True + | s == "false" = MetaBool False + | s == "False" = MetaBool False + | s == "FALSE" = MetaBool False + | otherwise = MetaString $ T.pack s + -- On Windows with ghc 8.6+, we need to rewrite paths -- beginning with \\ to \\?\UNC\. -- See #5127. normalizePath :: FilePath -> FilePath diff --git a/src/Text/Pandoc/App/FormatHeuristics.hs b/src/Text/Pandoc/App/FormatHeuristics.hs index 155b7e586..bdf8c6667 100644 --- a/src/Text/Pandoc/App/FormatHeuristics.hs +++ b/src/Text/Pandoc/App/FormatHeuristics.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.App.FormatHeuristics - Copyright : Copyright (C) 2006-2020 John MacFarlane + Copyright : Copyright (C) 2006-2021 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley@edu> @@ -15,18 +15,24 @@ module Text.Pandoc.App.FormatHeuristics ) where import Data.Char (toLower) +import Data.Foldable (asum) import Data.Text (Text) import System.FilePath (takeExtension) --- Determine default format based on file extensions. +-- | Determines default format based on file extensions; uses the format +-- of the first extension that's associated with a format. +-- +-- Examples: +-- +-- > formatFromFilePaths ["text.unknown", "no-extension"] +-- Nothing +-- +-- > formatFromFilePaths ["my.md", "other.rst"] +-- Just "markdown" formatFromFilePaths :: [FilePath] -> Maybe Text -formatFromFilePaths [] = Nothing -formatFromFilePaths (x:xs) = - case formatFromFilePath x of - Just f -> Just f - Nothing -> formatFromFilePaths xs +formatFromFilePaths = asum . map formatFromFilePath --- Determine format based on file extension +-- | Determines format based on file extension. formatFromFilePath :: FilePath -> Maybe Text formatFromFilePath x = case takeExtension (map toLower x) of @@ -48,6 +54,11 @@ formatFromFilePath x = ".lhs" -> Just "markdown+lhs" ".ltx" -> Just "latex" ".markdown" -> Just "markdown" + ".mkdn" -> Just "markdown" + ".mkd" -> Just "markdown" + ".mdwn" -> Just "markdown" + ".mdown" -> Just "markdown" + ".Rmd" -> Just "markdown" ".md" -> Just "markdown" ".ms" -> Just "ms" ".muse" -> Just "muse" diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs index 00b4b5523..d54d932b7 100644 --- a/src/Text/Pandoc/App/Opt.hs +++ b/src/Text/Pandoc/App/Opt.hs @@ -7,7 +7,7 @@ {-# LANGUAGE FlexibleContexts #-} {- | Module : Text.Pandoc.App.Opt - Copyright : Copyright (C) 2006-2020 John MacFarlane + Copyright : Copyright (C) 2006-2021 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley@edu> @@ -20,21 +20,31 @@ module Text.Pandoc.App.Opt ( Opt(..) , LineEnding (..) , IpynbOutput (..) + , DefaultsState (..) , defaultOpts - , addMeta + , applyDefaults + , fullDefaultsPath ) where +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.Maybe (fromMaybe) import GHC.Generics hiding (Meta) -import Text.Pandoc.Builder (setMeta) import Text.Pandoc.Filter (Filter (..)) -import Text.Pandoc.Logging (Verbosity (WARNING)) +import Text.Pandoc.Logging (Verbosity (WARNING), LogMessage(..)) import Text.Pandoc.Options (TopLevelDivision (TopLevelDefault), TrackChanges (AcceptChanges), WrapOption (WrapAuto), HTMLMathMethod (PlainMath), ReferenceLocation (EndOfDocument), ObfuscationMethod (NoObfuscation), CiteMethod (Citeproc)) -import Text.Pandoc.Shared (camelCaseStrToHyphenated) +import Text.Pandoc.Class (readFileLazy, fileExists, setVerbosity, report, + PandocMonad(lookupEnv), getUserDataDir) +import Text.Pandoc.Error (PandocError (PandocParseError, PandocSomeError)) +import Text.Pandoc.Shared (camelCaseStrToHyphenated, defaultUserDataDir, + findM, ordNub) import qualified Text.Pandoc.Parsing as P import Text.Pandoc.Readers.Metadata (yamlMap) import Text.Pandoc.Class.PandocPure @@ -43,7 +53,7 @@ import Data.Text (Text, unpack) import Data.Default (def) import qualified Data.Text as T import qualified Data.Map as M -import Text.Pandoc.Definition (Meta(..), MetaValue(..), lookupMeta) +import Text.Pandoc.Definition (Meta(..), MetaValue(..)) import Data.Aeson (defaultOptions, Options(..)) import Data.Aeson.TH (deriveJSON) import Control.Applicative ((<|>)) @@ -147,19 +157,194 @@ data Opt = Opt , optNoCheckCertificate :: Bool -- ^ Disable certificate validation , optEol :: LineEnding -- ^ Style of line-endings to use , optStripComments :: Bool -- ^ Skip HTML comments + , optCSL :: Maybe FilePath -- ^ CSL stylesheet + , optBibliography :: [FilePath] -- ^ Bibliography files + , optCitationAbbreviations :: Maybe FilePath -- ^ Citation abbreviations } deriving (Generic, Show) instance FromYAML (Opt -> Opt) where - parseYAML (Mapping _ _ m) = - foldr (.) id <$> mapM doOpt (M.toList m) + parseYAML (Mapping _ _ m) = chain doOpt (M.toList m) parseYAML n = failAtNode n "Expected a mapping" +data DefaultsState = DefaultsState + { + curDefaults :: Maybe FilePath -- currently parsed file + , inheritanceGraph :: [[FilePath]] -- defaults file inheritance graph + } 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" + +resolveVarsInOpt :: forall m. (PandocMonad m, MonadIO m) + => Opt -> StateT DefaultsState m Opt +resolveVarsInOpt + opt@Opt + { optTemplate = oTemplate + , optMetadataFiles = oMetadataFiles + , optOutputFile = oOutputFile + , optInputFiles = oInputFiles + , optSyntaxDefinitions = oSyntaxDefinitions + , optAbbreviations = oAbbreviations + , optReferenceDoc = oReferenceDoc + , optEpubMetadata = oEpubMetadata + , optEpubFonts = oEpubFonts + , optEpubCoverImage = oEpubCoverImage + , optLogFile = oLogFile + , optFilters = oFilters + , optDataDir = oDataDir + , optExtractMedia = oExtractMedia + , optCss = oCss + , optIncludeBeforeBody = oIncludeBeforeBody + , optIncludeAfterBody = oIncludeAfterBody + , optIncludeInHeader = oIncludeInHeader + , optResourcePath = oResourcePath + , optCSL = oCSL + , optBibliography = oBibliography + , optCitationAbbreviations = oCitationAbbreviations + } + = do + oTemplate' <- mapM resolveVars oTemplate + oMetadataFiles' <- mapM resolveVars oMetadataFiles + oOutputFile' <- mapM resolveVars oOutputFile + oInputFiles' <- mapM (mapM resolveVars) oInputFiles + oSyntaxDefinitions' <- mapM resolveVars oSyntaxDefinitions + oAbbreviations' <- mapM resolveVars oAbbreviations + oReferenceDoc' <- mapM resolveVars oReferenceDoc + oEpubMetadata' <- mapM resolveVars oEpubMetadata + oEpubFonts' <- mapM resolveVars oEpubFonts + oEpubCoverImage' <- mapM resolveVars oEpubCoverImage + oLogFile' <- mapM resolveVars oLogFile + oFilters' <- mapM resolveVarsInFilter oFilters + oDataDir' <- mapM resolveVars oDataDir + oExtractMedia' <- mapM resolveVars oExtractMedia + oCss' <- mapM resolveVars oCss + oIncludeBeforeBody' <- mapM resolveVars oIncludeBeforeBody + oIncludeAfterBody' <- mapM resolveVars oIncludeAfterBody + oIncludeInHeader' <- mapM resolveVars oIncludeInHeader + oResourcePath' <- mapM resolveVars oResourcePath + oCSL' <- mapM resolveVars oCSL + oBibliography' <- mapM resolveVars oBibliography + oCitationAbbreviations' <- mapM resolveVars oCitationAbbreviations + return opt{ optTemplate = oTemplate' + , optMetadataFiles = oMetadataFiles' + , optOutputFile = oOutputFile' + , optInputFiles = oInputFiles' + , optSyntaxDefinitions = oSyntaxDefinitions' + , optAbbreviations = oAbbreviations' + , optReferenceDoc = oReferenceDoc' + , optEpubMetadata = oEpubMetadata' + , optEpubFonts = oEpubFonts' + , optEpubCoverImage = oEpubCoverImage' + , optLogFile = oLogFile' + , optFilters = oFilters' + , optDataDir = oDataDir' + , optExtractMedia = oExtractMedia' + , optCss = oCss' + , optIncludeBeforeBody = oIncludeBeforeBody' + , optIncludeAfterBody = oIncludeAfterBody' + , optIncludeInHeader = oIncludeInHeader' + , optResourcePath = oResourcePath' + , optCSL = oCSL' + , optBibliography = oBibliography' + , optCitationAbbreviations = oCitationAbbreviations' + } + + where + resolveVars :: FilePath -> StateT DefaultsState m FilePath + resolveVars [] = return [] + resolveVars ('$':'{':xs) = + let (ys, zs) = break (=='}') xs + in if null zs + then return $ '$':'{':xs + else do + val <- lookupEnv' ys + (val ++) <$> resolveVars (drop 1 zs) + resolveVars (c:cs) = (c:) <$> resolveVars cs + lookupEnv' :: String -> StateT DefaultsState m String + lookupEnv' "." = do + mbCurDefaults <- gets curDefaults + maybe (return "") + (fmap takeDirectory . liftIO . canonicalizePath) + mbCurDefaults + lookupEnv' "USERDATA" = do + mbodatadir <- mapM resolveVars oDataDir + mbdatadir <- getUserDataDir + defdatadir <- liftIO defaultUserDataDir + return $ fromMaybe defdatadir (mbodatadir <|> mbdatadir) + lookupEnv' v = do + mbval <- fmap T.unpack <$> lookupEnv (T.pack v) + case mbval of + Nothing -> do + report $ EnvironmentVariableUndefined (T.pack v) + return mempty + Just x -> return x + resolveVarsInFilter (JSONFilter fp) = + JSONFilter <$> resolveVars fp + resolveVarsInFilter (LuaFilter fp) = + LuaFilter <$> resolveVars fp + resolveVarsInFilter CiteprocFilter = return CiteprocFilter + + + +parseDefaults :: (PandocMonad m, MonadIO m) + => Node Pos + -> Maybe FilePath + -> Parser (Opt -> StateT DefaultsState m Opt) +parseDefaults n dataDir = parseDefsNames n >>= \ds -> return $ \o -> do + -- get parent defaults: + defsParent <- gets $ fromMaybe "" . curDefaults + -- get child defaults: + defsChildren <- mapM (fullDefaultsPath dataDir) ds + -- expand parent in defaults inheritance graph by children: + defsGraph <- gets inheritanceGraph + let defsGraphExp = expand defsGraph defsChildren defsParent + modify $ \defsState -> defsState{ inheritanceGraph = defsGraphExp } + -- check for cyclic inheritance: + if cyclic defsGraphExp + then throwError $ + PandocSomeError $ T.pack $ + "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']) + +parseOptions :: Monad m + => [(Node Pos, Node Pos)] + -> Parser (Opt -> StateT DefaultsState m Opt) +parseOptions ns = do + f <- chain doOpt' ns + return $ return . f + +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' + case k of + "defaults" -> return id + _ -> doOpt (k',v) + doOpt :: (Node Pos, Node Pos) -> Parser (Opt -> Opt) doOpt (k',v) = do - k <- case k' of - Scalar _ (SStr t) -> return t - Scalar _ _ -> failAtNode k' "Non-string key" - _ -> failAtNode k' "Non-scalar key" + k <- parseStringKey k' case k of "tab-stop" -> parseYAML v >>= \x -> return (\o -> o{ optTabStop = x }) @@ -358,26 +543,18 @@ doOpt (k',v) = do (parseYAML v >>= \x -> return (\o -> o{ optCss = optCss o <> [unpack x] })) "bibliography" -> - do let addItem x o = o{ optMetadata = - addMeta "bibliography" (T.unpack x) - (optMetadata o) } - (parseYAML v >>= \(xs :: [Text]) -> return $ \o -> - foldr addItem o xs) - <|> - (parseYAML v >>= \(x :: Text) -> return $ \o -> addItem x o) + (parseYAML v >>= \x -> return (\o -> + o{ optBibliography = optBibliography o <> + map unpack x })) + <|> + (parseYAML v >>= \x -> return (\o -> + o{ optBibliography = optBibliography o <> + [unpack x] })) "csl" -> - do let addItem x o = o{ optMetadata = - addMeta "csl" (T.unpack x) - (optMetadata o) } - (parseYAML v >>= \(xs :: [Text]) -> return $ \o -> - foldr addItem o xs) - <|> - (parseYAML v >>= \(x :: Text) -> return $ \o -> addItem x o) + parseYAML v >>= \x -> return (\o -> o{ optCSL = unpack <$> x }) "citation-abbreviations" -> - parseYAML v >>= \x -> - return (\o -> o{ optMetadata = - addMeta "citation-abbreviations" (T.unpack x) - (optMetadata o) }) + parseYAML v >>= \x -> return (\o -> o{ optCitationAbbreviations = + unpack <$> x }) "ipynb-output" -> parseYAML v >>= \x -> return (\o -> o{ optIpynbOutput = x }) "include-before-body" -> @@ -406,7 +583,8 @@ doOpt (k',v) = do optIncludeInHeader o <> [unpack x] })) "resource-path" -> parseYAML v >>= \x -> - return (\o -> o{ optResourcePath = map unpack x }) + return (\o -> o{ optResourcePath = map unpack x <> + optResourcePath o }) "request-headers" -> parseYAML v >>= \x -> return (\o -> o{ optRequestHeaders = x }) @@ -492,38 +670,70 @@ defaultOpts = Opt , optNoCheckCertificate = False , optEol = Native , optStripComments = False + , optCSL = Nothing + , optBibliography = [] + , optCitationAbbreviations = Nothing } +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 = runPure (P.readWithM p def "") + runEverything p = + runPure (P.readWithM p (def :: P.ParserState) ("" :: Text)) >>= fmap (Meta . flip P.runF def) yamlToMeta _ = return mempty -addMeta :: String -> String -> Meta -> Meta -addMeta k v meta = - case lookupMeta k' meta of - Nothing -> setMeta k' v' meta - Just (MetaList xs) -> - setMeta k' (MetaList (xs ++ [v'])) meta - Just x -> setMeta k' (MetaList [x, v']) meta - where - v' = readMetaValue v - k' = T.pack k +-- | Apply defaults from --defaults file. +applyDefaults :: (PandocMonad m, MonadIO m) + => Opt + -> FilePath + -> StateT DefaultsState m Opt +applyDefaults opt file = do + setVerbosity $ optVerbosity opt + modify $ \defsState -> defsState{ curDefaults = Just file } + inp <- readFileLazy file + case decode1 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 -readMetaValue :: String -> MetaValue -readMetaValue s - | s == "true" = MetaBool True - | s == "True" = MetaBool True - | s == "TRUE" = MetaBool True - | s == "false" = MetaBool False - | s == "False" = MetaBool False - | s == "FALSE" = MetaBool False - | otherwise = MetaString $ T.pack s +fullDefaultsPath :: (PandocMonad m, MonadIO m) + => Maybe FilePath + -> FilePath + -> m FilePath +fullDefaultsPath dataDir file = do + let fp = if null (takeExtension file) + then addExtension file "yaml" + else file + defaultDataDir <- liftIO defaultUserDataDir + let defaultFp = fromMaybe defaultDataDir dataDir </> "defaults" </> fp + fromMaybe fp <$> findM fileExists [fp, defaultFp] +-- | In a list of lists, append another list in front of every list which +-- starts with specific element. +expand :: Ord a => [[a]] -> [a] -> a -> [[a]] +expand [] ns n = fmap (\x -> x : [n]) ns +expand ps ns n = concatMap (ext n ns) ps + where + ext x xs p = case p of + (l : _) | x == l -> fmap (: p) xs + _ -> [p] + +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 diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs index 139b408cb..3864ab188 100644 --- a/src/Text/Pandoc/App/OutputSettings.hs +++ b/src/Text/Pandoc/App/OutputSettings.hs @@ -5,7 +5,7 @@ {-# LANGUAGE TupleSections #-} {- | Module : Text.Pandoc.App - Copyright : Copyright (C) 2006-2020 John MacFarlane + Copyright : Copyright (C) 2006-2021 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley@edu> @@ -59,8 +59,8 @@ optToOutputSettings opts = do let outputFile = fromMaybe "-" (optOutputFile opts) when (optDumpArgs opts) . liftIO $ do - UTF8.hPutStrLn stdout outputFile - mapM_ (UTF8.hPutStrLn stdout) (fromMaybe [] $ optInputFiles opts) + UTF8.hPutStrLn stdout (T.pack outputFile) + mapM_ (UTF8.hPutStrLn stdout . T.pack) (fromMaybe [] $ optInputFiles opts) exitSuccess epubMetadata <- traverse readUtf8File $ optEpubMetadata opts |