From 1b69d5ed9444de975b707ed9ef3cdd2611e05463 Mon Sep 17 00:00:00 2001 From: John MacFarlane 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(-) 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