From ecf49b1e4b6123293d982684a8731453f4c60b85 Mon Sep 17 00:00:00 2001 From: Dmitry Astapov Date: Mon, 16 Apr 2018 22:47:04 +0100 Subject: [PATCH] lib: auto postings generated before amount inference and balance checks (#729) --- hledger-api/hledger-api.cabal | 3 +- hledger-api/hledger-api.hs | 3 +- hledger-api/package.yaml | 1 + hledger-lib/Hledger/Data/Types.hs | 23 -------- hledger-lib/Hledger/Read.hs | 48 ++++++++--------- hledger-lib/Hledger/Read/Common.hs | 55 ++++++++++++++++---- hledger-lib/Hledger/Read/CsvReader.hs | 7 +-- hledger-lib/Hledger/Read/JournalReader.hs | 4 +- hledger-lib/Hledger/Read/TimeclockReader.hs | 4 +- hledger-lib/Hledger/Read/TimedotReader.hs | 4 +- hledger-lib/Hledger/Reports/ReportOptions.hs | 3 -- hledger-ui/Hledger/UI/Main.hs | 1 - hledger-web/Application.hs | 3 +- hledger-web/Hledger/Web/Main.hs | 4 +- hledger/Hledger/Cli/Commands.hs | 11 ++-- hledger/Hledger/Cli/Utils.hs | 12 ----- 16 files changed, 94 insertions(+), 92 deletions(-) diff --git a/hledger-api/hledger-api.cabal b/hledger-api/hledger-api.cabal index 9d45a0db9..6d278ec44 100644 --- a/hledger-api/hledger-api.cabal +++ b/hledger-api/hledger-api.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: c1aecc57a80b7a88ba2774d93d5b1eedc43d04d6dbae964ce94307b643868534 +-- hash: f3ae96bc4a552af6049713498efd77ef61e5ade3bac393e45e47b484335029bd name: hledger-api version: 1.9.99 @@ -51,6 +51,7 @@ executable hledger-api , base >=4.8 && <4.12 , bytestring , containers + , data-default >=0.5 , docopt , either , hledger >=1.9.99 && <2.0 diff --git a/hledger-api/hledger-api.hs b/hledger-api/hledger-api.hs index 72bb32643..ccd554415 100644 --- a/hledger-api/hledger-api.hs +++ b/hledger-api/hledger-api.hs @@ -17,6 +17,7 @@ import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as BL8 import Data.Decimal +import Data.Default import qualified Data.Map as M import Data.Proxy import Data.String (fromString) @@ -90,7 +91,7 @@ main = do let defd = "." d = getArgWithDefault args defd (longOption "static-dir") - readJournalFile Nothing Nothing True f >>= either error' (serveApi h p d f) + readJournalFile Nothing def f >>= either error' (serveApi h p d f) serveApi :: String -> Int -> FilePath -> FilePath -> Journal -> IO () serveApi h p d f j = do diff --git a/hledger-api/package.yaml b/hledger-api/package.yaml index e30380731..3e170a8cd 100644 --- a/hledger-api/package.yaml +++ b/hledger-api/package.yaml @@ -38,6 +38,7 @@ dependencies: - aeson - bytestring - containers +- data-default >=0.5 - Decimal - docopt - either diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 33acb3ab2..f38a2fdcd 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -22,7 +22,6 @@ where import GHC.Generics (Generic) import Control.DeepSeq (NFData) -import Control.Monad.Except (ExceptT) import Data.Data import Data.Decimal import Data.Default @@ -329,28 +328,6 @@ type ParsedJournal = Journal -- The --output-format option selects one of these for output. type StorageFormat = String --- | A hledger journal reader is a triple of storage format name, a --- detector of that format, and a parser from that format to Journal. -data Reader = Reader { - - -- The canonical name of the format handled by this reader - rFormat :: StorageFormat - - -- The file extensions recognised as containing this format - ,rExtensions :: [String] - - -- A text parser for this format, accepting an optional rules file, - -- assertion-checking flag, and file path for error messages, - -- producing an exception-raising IO action that returns a journal - -- or error message. - ,rParser :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal - - -- Experimental readers are never tried automatically. - ,rExperimental :: Bool - } - -instance Show Reader where show r = rFormat r ++ " reader" - -- | An account, with name, balances and links to parent/subaccounts -- which let you walk up or down the account tree. data Account = Account { diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 75f21561b..883c691f5 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -40,6 +40,7 @@ import Control.Applicative ((<|>)) import Control.Arrow (right) import qualified Control.Exception as C import Control.Monad.Except +import Data.Default import Data.List import Data.Maybe import Data.Ord @@ -90,7 +91,7 @@ type PrefixedFilePath = FilePath -- | Read the default journal file specified by the environment, or raise an error. defaultJournal :: IO Journal -defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return +defaultJournal = defaultJournalPath >>= readJournalFile Nothing def >>= either error' return -- | Get the default journal file path specified by the environment. -- Like ledger, we look first for the LEDGER_FILE environment @@ -123,14 +124,13 @@ defaultJournalPath = do -- (The final parse state saved in the Journal does span all files, however.) -- -- As with readJournalFile, --- file paths can optionally have a READER: prefix, --- and the @mformat@, @mrulesfile, and @assrt@ arguments are supported --- (and these are applied to all files). +-- input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data, +-- enable or disable balance assertion checking and automated posting generation. -- -readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [PrefixedFilePath] -> IO (Either String Journal) -readJournalFiles mformat mrulesfile assrt prefixedfiles = do +readJournalFiles :: Maybe StorageFormat -> InputOpts -> [PrefixedFilePath] -> IO (Either String Journal) +readJournalFiles mformat iopts prefixedfiles = do (right mconcat1 . sequence) - <$> mapM (readJournalFile mformat mrulesfile assrt) prefixedfiles + <$> mapM (readJournalFile mformat iopts) prefixedfiles where mconcat1 :: Monoid t => [t] -> t mconcat1 [] = mempty mconcat1 x = foldr1 mappend x @@ -146,17 +146,16 @@ readJournalFiles mformat mrulesfile assrt prefixedfiles = do -- a recognised file name extension (in readJournal); -- if none of these identify a known reader, all built-in readers are tried in turn. -- --- A CSV conversion rules file (@mrulesfiles@) can be specified to help convert CSV data. +-- Input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data, +-- enable or disable balance assertion checking and automated posting generation. -- --- Optionally, any balance assertions in the journal can be checked (@assrt@). --- -readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> PrefixedFilePath -> IO (Either String Journal) -readJournalFile mformat mrulesfile assrt prefixedfile = do +readJournalFile :: Maybe StorageFormat -> InputOpts -> PrefixedFilePath -> IO (Either String Journal) +readJournalFile mformat iopts prefixedfile = do let (mprefixformat, f) = splitReaderPrefix prefixedfile mfmt = mformat <|> mprefixformat requireJournalFileExists f - readFileOrStdinPortably f >>= readJournal mfmt mrulesfile assrt (Just f) + readFileOrStdinPortably f >>= readJournal mfmt iopts (Just f) -- | If a filepath is prefixed by one of the reader names and a colon, -- split that off. Eg "csv:-" -> (Just "csv", "-"). @@ -195,7 +194,7 @@ newJournalContent = do -- | Read a Journal from the given text trying all readers in turn, or throw an error. readJournal' :: Text -> IO Journal -readJournal' t = readJournal Nothing Nothing True Nothing t >>= either error' return +readJournal' t = readJournal Nothing def Nothing t >>= either error' return tests_readJournal' = [ "readJournal' parses sample journal" ~: do @@ -213,17 +212,16 @@ tests_readJournal' = [ -- If none of these identify a known reader, all built-in readers are tried in turn -- (returning the first one's error message if none of them succeed). -- --- A CSV conversion rules file (@mrulesfiles@) can be specified to help convert CSV data. +-- Input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data, +-- enable or disable balance assertion checking and automated posting generation. -- --- Optionally, any balance assertions in the journal can be checked (@assrt@). --- -readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal) -readJournal mformat mrulesfile assrt mfile txt = +readJournal :: Maybe StorageFormat -> InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal) +readJournal mformat iopts mfile txt = let stablereaders = filter (not.rExperimental) readers rs = maybe stablereaders (:[]) $ findReader mformat mfile in - tryReaders rs mrulesfile assrt mfile txt + tryReaders rs iopts mfile txt -- | @findReader mformat mpath@ -- @@ -245,14 +243,14 @@ findReader Nothing (Just path) = -- -- Try to parse the given text to a Journal using each reader in turn, -- returning the first success, or if all of them fail, the first error message. -tryReaders :: [Reader] -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal) -tryReaders readers mrulesfile assrt path t = firstSuccessOrFirstError [] readers +tryReaders :: [Reader] -> InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal) +tryReaders readers iopts path t = 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) mrulesfile assrt path') t + result <- (runExceptT . (rParser r) iopts path') t dbg1IO "reader result" $ either id show result case result of Right j -> return $ Right j -- success! Left e -> firstSuccessOrFirstError (errs++[e]) rs -- keep trying @@ -356,7 +354,7 @@ tryReadersWithOpts iopts mpath readers txt = firstSuccessOrFirstError [] readers 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 + result <- (runExceptT . (rParser r) 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 @@ -408,7 +406,7 @@ tests_Hledger_Read = TestList $ "journal" ~: do r <- runExceptT $ parseWithState mempty JournalReader.journalp "" assertBool "journalp should parse an empty file" (isRight $ r) - jE <- readJournal Nothing Nothing True Nothing "" -- don't know how to get it from journal + jE <- readJournal Nothing def Nothing "" -- don't know how to get it from journal either error' (assertBool "journalp parsing an empty file should give an empty journal" . null . jtxns) jE ] diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index caf5fd050..166360251 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -47,6 +47,28 @@ import Text.Megaparsec.Compat import Hledger.Data import Hledger.Utils +import qualified Hledger.Query as Q (Query(Any)) + +-- | A hledger journal reader is a triple of storage format name, a +-- detector of that format, and a parser from that format to Journal. +data Reader = Reader { + + -- The canonical name of the format handled by this reader + rFormat :: StorageFormat + + -- The file extensions recognised as containing this format + ,rExtensions :: [String] + + -- A text parser for this format, accepting input options, file + -- path for error messages and file contents, producing an exception-raising IO + -- action that returns a journal or error message. + ,rParser :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal + + -- Experimental readers are never tried automatically. + ,rExperimental :: Bool + } + +instance Show Reader where show r = rFormat r ++ " reader" -- $setup @@ -63,12 +85,13 @@ data InputOpts = InputOpts { ,new_ :: Bool -- ^ read only new transactions since this file was last read ,new_save_ :: Bool -- ^ save latest new transactions state for next time ,pivot_ :: String -- ^ use the given field's value as the account name + ,auto_ :: Bool -- ^ generate automatic postings when journal is parsed } deriving (Show, Data) --, Typeable) instance Default InputOpts where def = definputopts definputopts :: InputOpts -definputopts = InputOpts def def def def def def True def +definputopts = InputOpts def def def def def def True def def rawOptsToInputOpts :: RawOpts -> InputOpts rawOptsToInputOpts rawopts = InputOpts{ @@ -81,6 +104,7 @@ rawOptsToInputOpts rawopts = InputOpts{ ,new_ = boolopt "new" rawopts ,new_save_ = True ,pivot_ = stringopt "pivot" rawopts + ,auto_ = boolopt "auto" rawopts } --- * parsing utils @@ -115,27 +139,40 @@ journalSourcePos p p' = JournalSourcePos (sourceName p) (fromIntegral . unPos $ | otherwise = unPos $ sourceLine p' -- might be at end of file withat last new-line --- | Given a megaparsec ParsedJournal parser, balance assertion flag, file +-- | Generate Automatic postings and add them to the current journal. +generateAutomaticPostings :: Journal -> Journal +generateAutomaticPostings j = j { jtxns = map modifier $ jtxns j } + where + modifier = foldr (flip (.) . runModifierTransaction') id mtxns + runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Q.Any + mtxns = jmodifiertxns j + +-- | Given a megaparsec ParsedJournal parser, input options, file -- path and file content: parse and post-process a Journal, or give an error. -parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> Bool - -> FilePath -> Text -> ExceptT String IO Journal -parseAndFinaliseJournal parser assrt f txt = do +parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts + -> FilePath -> Text -> ExceptT String IO Journal +parseAndFinaliseJournal parser iopts f txt = do t <- liftIO getClockTime y <- liftIO getCurrentYear ep <- runParserT (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt case ep of - Right pj -> case journalFinalise t f txt assrt pj of + Right pj -> + let pj' = if auto_ iopts then generateAutomaticPostings pj else pj in + case journalFinalise t f txt (not $ ignore_assertions_ iopts) pj' of Right j -> return j Left e -> throwError e Left e -> throwError $ parseErrorPretty e -parseAndFinaliseJournal' :: JournalParser Identity ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal -parseAndFinaliseJournal' parser assrt f txt = do +parseAndFinaliseJournal' :: JournalParser Identity ParsedJournal -> InputOpts + -> FilePath -> Text -> ExceptT String IO Journal +parseAndFinaliseJournal' parser iopts f txt = do t <- liftIO getClockTime y <- liftIO getCurrentYear let ep = runParser (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt case ep of - Right pj -> case journalFinalise t f txt assrt pj of + Right pj -> + let pj' = if auto_ iopts then generateAutomaticPostings pj else pj in + case journalFinalise t f txt (not $ ignore_assertions_ iopts) pj' of Right j -> return j Left e -> throwError e Left e -> throwError $ parseErrorPretty e diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index ebf595757..86f0031b0 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -60,7 +60,7 @@ import Text.Printf (printf) import Hledger.Data import Hledger.Utils.UTF8IOCompat (getContents) import Hledger.Utils -import Hledger.Read.Common (amountp, statusp, genericSourcePos) +import Hledger.Read.Common (Reader(..),InputOpts(..),amountp, statusp, genericSourcePos) reader :: Reader @@ -73,8 +73,9 @@ reader = Reader -- | Parse and post-process a "Journal" from CSV data, or give an error. -- XXX currently ignores the string and reads from the file path -parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal -parse rulesfile _ f t = do +parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal +parse iopts f t = do + let rulesfile = mrules_file_ iopts r <- liftIO $ readJournalFromCsv rulesfile f t case r of Left e -> throwError e Right j -> return $ journalNumberAndTieTransactions j diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 5effefd60..861a3a0ef 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -119,8 +119,8 @@ reader = Reader -- | Parse and post-process a "Journal" from hledger's journal file -- format, or give an error. -parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal -parse _ = parseAndFinaliseJournal journalp +parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal +parse = parseAndFinaliseJournal journalp --- * parsers --- ** journal diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 6dc993cd4..07a61692a 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -79,8 +79,8 @@ reader = Reader -- | Parse and post-process a "Journal" from timeclock.el's timeclock -- format, saving the provided file path and the current time, or give an -- error. -parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal -parse _ = parseAndFinaliseJournal timeclockfilep +parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal +parse = parseAndFinaliseJournal timeclockfilep timeclockfilep :: ErroringJournalParser IO ParsedJournal timeclockfilep = do many timeclockitemp diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index 1ad99db43..375fe9423 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -65,8 +65,8 @@ reader = Reader } -- | Parse and post-process a "Journal" from the timedot format, or give an error. -parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal -parse _ = parseAndFinaliseJournal timedotfilep +parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal +parse = parseAndFinaliseJournal timedotfilep timedotfilep :: JournalParser m ParsedJournal timedotfilep = do many timedotfileitemp diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 440390e82..39c05d2b2 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -115,7 +115,6 @@ data ReportOpts = ReportOpts { -- normally positive for a more conventional display. ,color_ :: Bool ,forecast_ :: Bool - ,auto_ :: Bool } deriving (Show, Data, Typeable) instance Default ReportOpts where def = defreportopts @@ -148,7 +147,6 @@ defreportopts = ReportOpts def def def - def rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = checkReportOpts <$> do @@ -181,7 +179,6 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do ,pretty_tables_ = boolopt "pretty-tables" rawopts' ,color_ = color ,forecast_ = boolopt "forecast" rawopts' - ,auto_ = boolopt "auto" rawopts' } -- | Do extra validation of raw option values, raising an error if there's a problem. diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 105eb2fd1..1aea84163 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -81,7 +81,6 @@ withJournalDoUICommand uopts@UIOpts{cliopts_=copts} cmd = do . journalApplyAliases (aliasesFromOpts copts) <=< journalApplyValue (reportopts_ copts) <=< journalAddForecast copts - . generateAutomaticPostings (reportopts_ copts) either error' fn ej runBrickUi :: UIOpts -> Journal -> IO () diff --git a/hledger-web/Application.hs b/hledger-web/Application.hs index 821aabdd9..390476963 100644 --- a/hledger-web/Application.hs +++ b/hledger-web/Application.hs @@ -6,6 +6,7 @@ module Application , makeFoundation ) where +import Data.Default import Data.IORef import Import import Yesod.Default.Config @@ -79,7 +80,7 @@ makeFoundation conf opts = do getApplicationDev :: IO (Int, Application) getApplicationDev = do f <- head `fmap` journalFilePathFromOpts defcliopts -- XXX head should be safe for now - j <- either error' id `fmap` readJournalFile Nothing Nothing True f + j <- either error' id `fmap` readJournalFile Nothing def f defaultDevelApp loader (makeApplication defwebopts j) where loader = Yesod.Default.Config.loadConfig (configSettings Development) diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 28099eb4d..968e0b387 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -23,6 +23,7 @@ import Network.Wai.Handler.Launch (runHostPortUrl) import Control.Applicative ((<$>)) #endif import Control.Monad +import Data.Default import Data.Text (pack) import System.Exit (exitSuccess) import System.IO (hFlush, stdout) @@ -65,8 +66,7 @@ withJournalDo' opts@WebOpts {cliopts_ = cliopts} cmd = do . journalApplyAliases (aliasesFromOpts cliopts) <=< journalApplyValue (reportopts_ cliopts) <=< journalAddForecast cliopts - . generateAutomaticPostings (reportopts_ cliopts) - readJournalFile Nothing Nothing True f >>= either error' fn + readJournalFile Nothing def f >>= either error' fn -- | The web command. web :: WebOpts -> Journal -> IO () diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index c558da51c..96dcea160 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -37,6 +37,7 @@ module Hledger.Cli.Commands ( where import Control.Monad +import Data.Default import Data.List import Data.List.Split (splitOn) #if !(MIN_VERSION_base(4,11,0)) @@ -269,8 +270,8 @@ tests_Hledger_Cli_Commands = TestList [ ,"apply account directive" ~: let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in - let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing True Nothing str1 >>= either error' (return . ignoresourcepos) - j2 <- readJournal Nothing Nothing True Nothing str2 >>= either error' (return . ignoresourcepos) + let sameParse str1 str2 = do j1 <- readJournal Nothing def Nothing str1 >>= either error' (return . ignoresourcepos) + j2 <- readJournal Nothing def Nothing str2 >>= either error' (return . ignoresourcepos) j1 `is` j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1} in sameParse ("2008/12/07 One\n alpha $-1\n beta $1\n" <> @@ -287,13 +288,13 @@ tests_Hledger_Cli_Commands = TestList [ ) ,"apply account directive should preserve \"virtual\" posting type" ~: do - j <- readJournal Nothing Nothing True Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return + j <- readJournal Nothing def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j assertBool "" $ paccount p == "test:from" assertBool "" $ ptype p == VirtualPosting ,"account aliases" ~: do - j <- readJournal Nothing Nothing True Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return + j <- readJournal Nothing def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j assertBool "" $ paccount p == "equity:draw:personal:food" @@ -315,7 +316,7 @@ tests_Hledger_Cli_Commands = TestList [ -- `is` "aa:aa:aaaaaaaaaaaaaa") ,"default year" ~: do - j <- readJournal Nothing Nothing True Nothing defaultyear_journal_txt >>= either error' return + j <- readJournal Nothing def Nothing defaultyear_journal_txt >>= either error' return tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 return () diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 8f272e50f..8e62c124c 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -57,8 +57,6 @@ import Hledger.Data import Hledger.Read import Hledger.Reports import Hledger.Utils -import Hledger.Query (Query(Any)) - -- | Parse the user's specified journal file, maybe apply some transformations -- (aliases, pivot) and run a hledger command on it, or throw an error. @@ -75,7 +73,6 @@ withJournalDo opts cmd = do . journalApplyAliases (aliasesFromOpts opts) <=< journalApplyValue (reportopts_ opts) <=< journalAddForecast opts - . generateAutomaticPostings (reportopts_ opts) either error' f ej -- | Apply the pivot transformation on a journal, if option is present. @@ -147,15 +144,6 @@ journalAddForecast opts j = do in either error' id $ journalBalanceTransactions assrt j --- | Generate Automatic postings and add them to the current journal. -generateAutomaticPostings :: ReportOpts -> Journal -> Journal -generateAutomaticPostings ropts j = - if auto_ ropts then j { jtxns = map modifier $ jtxns j } else j - where - modifier = foldr (flip (.) . runModifierTransaction') id mtxns - runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Any - mtxns = jmodifiertxns j - -- | Write some output to stdout or to a file selected by --output-file. -- If the file exists it will be overwritten. writeOutput :: CliOpts -> String -> IO ()