From 1b69d5ed9444de975b707ed9ef3cdd2611e05463 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Fri, 1 Nov 2019 09:52:22 -0700
Subject: Factor out applyDefaults in T.P.A.CommandLineOptions.
---
src/Text/Pandoc/App/CommandLineOptions.hs | 44 +++++++++++++++++--------------
1 file changed, 24 insertions(+), 20 deletions(-)
(limited to 'src/Text/Pandoc/App')
diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs
index c6d6f48a4..019ec9220 100644
--- a/src/Text/Pandoc/App/CommandLineOptions.hs
+++ b/src/Text/Pandoc/App/CommandLineOptions.hs
@@ -161,26 +161,11 @@ options =
, Option "d" ["defaults"]
(ReqArg
- (\arg opt -> runIOorExplode $ do
- setVerbosity $ optVerbosity opt
- let fp = if null (takeExtension arg)
- then addExtension arg "yaml"
- else arg
- dataDirs <- liftIO defaultUserDataDirs
- let fps = case optDataDir opt of
- Nothing -> (fp : map (</> ("defaults" </> fp))
- dataDirs)
- Just dd -> [fp, dd </> "defaults" </> fp]
- fp' <- fromMaybe fp <$> findFile fps
- inp <- readFileLazy fp'
- case Y.decode1 inp of
- Right (f :: Opt -> Opt) -> return $ f opt
- Left (errpos, errmsg) -> throwError $
- PandocParseError $
- "Error parsing " ++ fp' ++ " line " ++
- show (Y.posLine errpos) ++ " column " ++
- show (Y.posColumn errpos) ++ ":\n" ++ errmsg
-
+ (\arg opt -> do
+ let fp' = if null (takeExtension arg)
+ then addExtension arg "yaml"
+ else arg
+ foldM applyDefaults opt [fp']
)
"FILE")
""
@@ -995,6 +980,25 @@ splitField s =
(k,_:v) -> (k,v)
(k,[]) -> (k,"true")
+-- | Apply defaults from --defaults file.
+applyDefaults :: Opt -> FilePath -> IO Opt
+applyDefaults opt fp = runIOorExplode $ do
+ setVerbosity $ optVerbosity opt
+ dataDirs <- liftIO defaultUserDataDirs
+ let fps = case optDataDir opt of
+ Nothing -> (fp : map (</> ("defaults" </> fp))
+ dataDirs)
+ Just dd -> [fp, dd </> "defaults" </> fp]
+ fp' <- fromMaybe fp <$> findFile fps
+ inp <- readFileLazy fp'
+ case Y.decode1 inp of
+ Right (f :: Opt -> Opt) -> return $ f opt
+ Left (errpos, errmsg) -> throwError $
+ PandocParseError $
+ "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
--
cgit v1.2.3