slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add & use simpler readJournalFilesWithOpts/InputOpts api

Browse Source
This commit is contained in:
Simon Michael 2017-09-14 17:41:42 -07:00
parent a218ce12ad
commit e3c4a76119
12 changed files with 93 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
hledger-lib/Hledger/Read.hs
View File

@ -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

33
hledger-lib/Hledger/Read/Common.hs
View File

@ -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.

1
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -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

3
hledger-lib/Hledger/Utils.hs
View File

@ -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

2
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -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

2
hledger-ui/Hledger/UI/ErrorScreen.hs
View File

@ -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

3
hledger-ui/Hledger/UI/Main.hs
View File

@ -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 .

2
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -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 [

2
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -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 [

4
hledger-ui/Hledger/UI/UIState.hs
View File

@ -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

19
hledger/Hledger/Cli/CliOptions.hs
View File

@ -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

6
hledger/Hledger/Cli/Utils.hs
View File

@ -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,