add & use simpler readJournalFilesWithOpts/InputOpts api

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
 

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.

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

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

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

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

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 .

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 [

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 [

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{}}} =
+toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts}}} =
-  ui{aopts=uopts{cliopts_=copts{ignore_assertions_=not $ ignore_assertions_ copts}}}
+  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

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

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,