From e3c4a761192e2298143cc8311f9bd8dfeec8d695 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 14 Sep 2017 17:41:42 -0700 Subject: [PATCH] add & use simpler readJournalFilesWithOpts/InputOpts api --- hledger-lib/Hledger/Read.hs | 42 ++++++++++++++++++++ hledger-lib/Hledger/Read/Common.hs | 33 ++++++++++++++- hledger-lib/Hledger/Reports/ReportOptions.hs | 1 - hledger-lib/Hledger/Utils.hs | 3 ++ hledger-ui/Hledger/UI/AccountsScreen.hs | 2 +- hledger-ui/Hledger/UI/ErrorScreen.hs | 2 +- hledger-ui/Hledger/UI/Main.hs | 3 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 2 +- hledger-ui/Hledger/UI/TransactionScreen.hs | 2 +- hledger-ui/Hledger/UI/UIState.hs | 4 +- hledger/Hledger/Cli/CliOptions.hs | 19 ++++----- hledger/Hledger/Cli/Utils.hs | 6 +-- 12 files changed, 93 insertions(+), 26 deletions(-) diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index d83ae9eda..c961ffc11 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -14,6 +14,7 @@ module Hledger.Read ( PrefixedFilePath, defaultJournal, defaultJournalPath, + readJournalFilesWithOpts, readJournalFiles, readJournalFile, requireJournalFileExists, @@ -258,6 +259,47 @@ tryReaders readers mrulesfile assrt path t = firstSuccessOrFirstError [] readers path' = fromMaybe "(string)" path +--- New versions of readJournal* with easier arguments + +readJournalFilesWithOpts :: InputOpts -> [FilePath] -> IO (Either String Journal) +readJournalFilesWithOpts iopts = + (right mconcat1 . sequence <$>) . mapM (readJournalFileWithOpts iopts) + where + mconcat1 :: Monoid t => [t] -> t + mconcat1 [] = mempty + mconcat1 x = foldr1 mappend x + +readJournalFileWithOpts :: InputOpts -> PrefixedFilePath -> IO (Either String Journal) +readJournalFileWithOpts iopts prefixedfile = do + let + (mfmt, f) = splitReaderPrefix prefixedfile + iopts' = iopts{mformat_=firstJust [mfmt, mformat_ iopts]} + requireJournalFileExists f + readFileOrStdinAnyLineEnding f >>= readJournalWithOpts iopts' (Just f) + +readJournalWithOpts :: InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal) +readJournalWithOpts iopts mfile txt = + tryReadersWithOpts iopts mfile specifiedorallreaders txt + where + specifiedorallreaders = maybe stablereaders (:[]) $ findReader (mformat_ iopts) mfile + stablereaders = filter (not.rExperimental) readers + +tryReadersWithOpts :: InputOpts -> Maybe FilePath -> [Reader] -> Text -> IO (Either String Journal) +tryReadersWithOpts iopts mpath readers txt = firstSuccessOrFirstError [] readers + where + firstSuccessOrFirstError :: [String] -> [Reader] -> IO (Either String Journal) + firstSuccessOrFirstError [] [] = return $ Left "no readers found" + firstSuccessOrFirstError errs (r:rs) = do + dbg1IO "trying reader" (rFormat r) + result <- (runExceptT . (rParser r) (mrules_file_ iopts) (not $ ignore_assertions_ iopts) path) txt + dbg1IO "reader result" $ either id show result + case result of Right j -> return $ Right j -- success! + Left e -> firstSuccessOrFirstError (errs++[e]) rs -- keep trying + firstSuccessOrFirstError (e:_) [] = return $ Left e -- none left, return first error + path = fromMaybe "(string)" mpath + +--- + -- tests diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index d099a3971..ea3aa4946 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -13,7 +13,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read. -} --- * module -{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} +{-# LANGUAGE CPP, DeriveDataTypeable, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} module Hledger.Read.Common where @@ -24,6 +24,8 @@ import Control.Monad.Compat import Control.Monad.Except (ExceptT(..), runExceptT, throwError) --, catchError) import Control.Monad.State.Strict import Data.Char (isNumber) +import Data.Data +import Data.Default import Data.Functor.Identity import Data.List.Compat import Data.List.NonEmpty (NonEmpty(..)) @@ -43,6 +45,35 @@ import Hledger.Utils -- $setup +-- | Various options to use when reading journal files. +-- Similar to CliOptions.inputflags, simplifies the journal-reading functions. +data InputOpts = InputOpts { + -- files_ :: [FilePath] + mformat_ :: Maybe StorageFormat -- ^ a file/storage format to try, unless overridden + -- by a filename prefix. Nothing means try all. + ,mrules_file_ :: Maybe FilePath -- ^ a conversion rules file to use (when reading CSV) + ,aliases_ :: [String] -- ^ account name aliases to apply + ,anon_ :: Bool -- ^ do light anonymisation/obfuscation of the data + ,ignore_assertions_ :: Bool -- ^ don't check balance assertions + ,pivot_ :: String -- ^ use the given field's value as the account name + } deriving (Show, Data) --, Typeable) + +instance Default InputOpts where def = definputopts + +definputopts :: InputOpts +definputopts = InputOpts def def def def def def + +rawOptsToInputOpts :: RawOpts -> InputOpts +rawOptsToInputOpts rawopts = InputOpts{ + -- files_ = map (T.unpack . stripquotes . T.pack) $ listofstringopt "file" rawopts + mformat_ = Nothing + ,mrules_file_ = maybestringopt "rules-file" rawopts + ,aliases_ = map (T.unpack . stripquotes . T.pack) $ listofstringopt "alias" rawopts + ,anon_ = boolopt "anon" rawopts + ,ignore_assertions_ = boolopt "ignore-assertions" rawopts + ,pivot_ = stringopt "pivot" rawopts + } + --- * parsing utils -- | Run a string parser with no state in the identity monad. diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index ef45052ee..193108c53 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -101,7 +101,6 @@ data ReportOpts = ReportOpts { } deriving (Show, Data, Typeable) instance Default ReportOpts where def = defreportopts -instance Default Bool where def = False defreportopts :: ReportOpts defreportopts = ReportOpts diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index c826e985d..41fb05c39 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -35,6 +35,7 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c where import Control.Monad (liftM) -- import Data.Char +import Data.Default import Data.List -- import Data.Maybe -- import Data.PPrint @@ -117,6 +118,8 @@ getCurrentZonedTime = do -- misc +instance Default Bool where def = False + isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft _ = False diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index cf40b7ae6..f1ee2d183 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -185,7 +185,7 @@ asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} <+> str "/" <+> total <+> str ")" - <+> (if ignore_assertions_ copts + <+> (if ignore_assertions_ $ inputopts_ copts then withAttr (borderAttr <> "query") (str " ignoring balance assertions") else str "") where diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index 4ed10852b..9549f05e9 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -151,7 +151,7 @@ uiReloadJournalIfChanged copts d j ui = do -- are disabled, do nothing. uiCheckBalanceAssertions :: Day -> UIState -> UIState uiCheckBalanceAssertions d ui@UIState{aopts=UIOpts{cliopts_=copts}, ajournal=j} - | ignore_assertions_ copts = ui + | ignore_assertions_ $ inputopts_ copts = ui | otherwise = case journalCheckBalanceAssertions j of Right _ -> ui diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index fca6b95d8..1f43f6666 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -74,9 +74,8 @@ main = do -- XXX withJournalDo specialised for UIOpts withJournalDoUICommand :: UIOpts -> (UIOpts -> Journal -> IO ()) -> IO () withJournalDoUICommand uopts@UIOpts{cliopts_=copts} cmd = do - rulespath <- rulesFilePathFromOpts copts journalpath <- journalFilePathFromOpts copts - ej <- readJournalFiles Nothing rulespath (not $ ignore_assertions_ copts) journalpath + ej <- readJournalFilesWithOpts (inputopts_ copts) journalpath let fn = cmd uopts . pivotByOpts copts . anonymiseByOpts copts . diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 285b578b0..90de6f404 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -200,7 +200,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} <+> str "/" <+> total <+> str ")" - <+> (if ignore_assertions_ copts then withAttr (borderAttr <> "query") (str " ignoring balance assertions") else str "") + <+> (if ignore_assertions_ $ inputopts_ copts then withAttr (borderAttr <> "query") (str " ignoring balance assertions") else str "") where togglefilters = case concat [ diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 65d94527a..0d96ed165 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -74,7 +74,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} <+> togglefilters <+> borderQueryStr (query_ ropts) <+> str (" in "++T.unpack (replaceHiddenAccountsNameWith "All" acct)++")") - <+> (if ignore_assertions_ copts then withAttr (borderAttr <> "query") (str " ignoring balance assertions") else str "") + <+> (if ignore_assertions_ $ inputopts_ copts then withAttr (borderAttr <> "query") (str " ignoring balance assertions") else str "") where togglefilters = case concat [ diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 00d731526..45ebbf1a0 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -133,8 +133,8 @@ toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropt -- | Toggle the ignoring of balance assertions. toggleIgnoreBalanceAssertions :: UIState -> UIState -toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{}}} = - ui{aopts=uopts{cliopts_=copts{ignore_assertions_=not $ ignore_assertions_ copts}}} +toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts}}} = + ui{aopts=uopts{cliopts_=copts{inputopts_=iopts{ignore_assertions_=not $ ignore_assertions_ iopts}}}} -- | Step through larger report periods, up to all. growReportPeriod :: Day -> UIState -> UIState diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 6bc40c3df..0b8e4039d 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -340,11 +340,10 @@ data CliOpts = CliOpts { rawopts_ :: RawOpts ,command_ :: String ,file_ :: [FilePath] - ,rules_file_ :: Maybe FilePath + ,inputopts_ :: InputOpts + ,reportopts_ :: ReportOpts ,output_file_ :: Maybe FilePath ,output_format_ :: Maybe String - ,alias_ :: [String] - ,ignore_assertions_ :: Bool ,debug_ :: Int -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'. ,no_new_accounts_ :: Bool -- add ,width_ :: Maybe String -- ^ the --width value provided, if any @@ -352,7 +351,6 @@ data CliOpts = CliOpts { -- 1. the COLUMNS env var, if set -- 2. the width reported by the terminal, if supported -- 3. the default (80) - ,reportopts_ :: ReportOpts } deriving (Show, Data, Typeable) instance Default CliOpts where def = defcliopts @@ -369,9 +367,7 @@ defcliopts = CliOpts def def def - def defaultWidth - def -- | Convert possibly encoded option values to regular unicode strings. decodeRawOpts :: RawOpts -> RawOpts @@ -387,6 +383,7 @@ defaultWidth = 80 -- Also records the terminal width, if supported. rawOptsToCliOpts :: RawOpts -> IO CliOpts rawOptsToCliOpts rawopts = checkCliOpts <$> do + let iopts = rawOptsToInputOpts rawopts ropts <- rawOptsToReportOpts rawopts mcolumns <- readMay <$> getEnvSafe "COLUMNS" mtermwidth <- @@ -401,16 +398,14 @@ rawOptsToCliOpts rawopts = checkCliOpts <$> do rawopts_ = rawopts ,command_ = stringopt "command" rawopts ,file_ = map (T.unpack . stripquotes . T.pack) $ listofstringopt "file" rawopts - ,rules_file_ = maybestringopt "rules-file" rawopts + ,inputopts_ = iopts + ,reportopts_ = ropts ,output_file_ = maybestringopt "output-file" rawopts ,output_format_ = maybestringopt "output-format" rawopts - ,alias_ = map (T.unpack . stripquotes . T.pack) $ listofstringopt "alias" rawopts ,debug_ = intopt "debug" rawopts - ,ignore_assertions_ = boolopt "ignore-assertions" rawopts ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add ,width_ = maybestringopt "width" rawopts ,available_width_ = availablewidth - ,reportopts_ = ropts } -- | Do final validation of processed opts, raising an error if there is trouble. @@ -480,7 +475,7 @@ getHledgerCliOpts mode' = do -- | Get the account name aliases from options, if any. aliasesFromOpts :: CliOpts -> [AccountAlias] aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp ("--alias "++quoteIfNeeded a) $ T.pack a) - . alias_ + . aliases_ . inputopts_ -- | Get the (tilde-expanded, absolute) journal file path from -- 1. options, 2. an environment variable, or 3. the default. @@ -544,7 +539,7 @@ filePathExtension = dropWhile (=='.') . snd . splitExtension . snd . splitFileNa rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath) rulesFilePathFromOpts opts = do d <- getCurrentDirectory - maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts + maybe (return Nothing) (fmap Just . expandPath d) $ mrules_file_ $ inputopts_ opts -- | Get the width in characters to use for console output. -- This comes from the --width option, or the COLUMNS environment diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index ff9850c93..1934b3f71 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -63,9 +63,8 @@ withJournalDo opts cmd = do -- We kludgily read the file before parsing to grab the full text, unless -- it's stdin, or it doesn't exist and we are adding. We read it strictly -- to let the add command work. - rulespath <- rulesFilePathFromOpts opts journalpaths <- journalFilePathFromOpts opts - ej <- readJournalFiles Nothing rulespath (not $ ignore_assertions_ opts) journalpaths + ej <- readJournalFilesWithOpts (inputopts_ opts) journalpaths let f = cmd opts . pivotByOpts opts . anonymiseByOpts opts @@ -134,10 +133,9 @@ writeOutput opts s = do -- Reads the full journal, without filtering. journalReload :: CliOpts -> IO (Either String Journal) journalReload opts = do - rulespath <- rulesFilePathFromOpts opts journalpaths <- journalFilePathFromOpts opts ((pivotByOpts opts . journalApplyAliases (aliasesFromOpts opts)) <$>) <$> - readJournalFiles Nothing rulespath (not $ ignore_assertions_ opts) journalpaths + readJournalFilesWithOpts (inputopts_ opts) journalpaths -- | Re-read the option-specified journal file(s), but only if any of -- them has changed since last read. (If the file is standard input,