From 0c3148ac7b0504c58f949fdc0d34c62ed51bbd15 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 1 Jul 2014 18:26:37 -0700 Subject: [PATCH] add an --ignore-assertions flag Can be helpful when reading Ledger files, where assertions may have different semantics; or for getting some answers from your journal to help you fix your assertions. Could be called --no-assertions, but this might create surprise when it has an effect contrary to --no-new-accounts. I had to add another flag throughout the parsers & journal read functions, ok for now. --- hledger-lib/Hledger/Data/Journal.hs | 10 +++++---- hledger-lib/Hledger/Data/Types.hs | 2 +- hledger-lib/Hledger/Read.hs | 26 ++++++++++++----------- hledger-lib/Hledger/Read/CsvReader.hs | 4 ++-- hledger-lib/Hledger/Read/JournalReader.hs | 8 +++---- hledger-lib/Hledger/Read/TimelogReader.hs | 2 +- hledger/Hledger/Cli.hs | 10 ++++----- hledger/Hledger/Cli/Options.hs | 4 ++++ hledger/Hledger/Cli/Utils.hs | 4 ++-- 9 files changed, 39 insertions(+), 31 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 7303f1ace..e50f09bf3 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -391,14 +391,14 @@ journalApplyAliases aliases j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} -- | Do post-parse processing on a journal to make it ready for use: check -- all transactions balance, canonicalise amount formats, close any open --- timelog entries and so on. -journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Journal -> Either String Journal -journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} = do +-- timelog entries, maybe check balance assertions and so on. +journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Bool -> Journal -> Either String Journal +journalFinalise tclock tlocal path txt ctx assrt j@Journal{files=fs} = do (journalBalanceTransactions $ journalCanonicaliseAmounts $ journalCloseTimeLogEntries tlocal j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx}) - >>= journalCheckBalanceAssertions + >>= if assrt then journalCheckBalanceAssertions else return -- | Check any balance assertions in the journal and return an error -- message if any of them fail. @@ -433,6 +433,8 @@ checkBalanceAssertion (errs,bal) ps | -- bal' /= assertedbal -- MixedAmount's Eq instance currently gets confused by different precisions not $ isReallyZeroMixedAmount (bal' - assertedbal) + -- or, compare only the balance of that commodity, like Ledger + -- not $ isReallyZeroMixedAmount (filterCommodity () bal' - assertedbal) = (errs++[err], bal') | otherwise = (errs,bal') where diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 21902f19f..15e998555 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -179,7 +179,7 @@ data Reader = Reader { -- quickly check if this reader can probably handle the given file path and file content ,rDetector :: FilePath -> String -> Bool -- parse the given string, using the given parse rules file if any, returning a journal or error aware of the given file path - ,rParser :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal + ,rParser :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal } instance Show Reader where show r = rFormat r ++ " reader" diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 37334fdb9..63f2d1f68 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -91,11 +91,11 @@ defaultJournalPath = do -- | Read the default journal file specified by the environment, or raise an error. defaultJournal :: IO Journal -defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing >>= either error' return +defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return -- | Read a journal from the given string, trying all known formats, or simply throw an error. readJournal' :: String -> IO Journal -readJournal' s = readJournal Nothing Nothing Nothing s >>= either error' return +readJournal' s = readJournal Nothing Nothing True Nothing s >>= either error' return tests_readJournal' = [ "readJournal' parses sample journal" ~: do @@ -114,8 +114,9 @@ tests_readJournal' = [ -- - otherwise, try them all. -- -- A CSV conversion rules file may also be specified for use by the CSV reader. -readJournal :: Maybe StorageFormat -> Maybe FilePath -> Maybe FilePath -> String -> IO (Either String Journal) -readJournal format rulesfile path s = +-- Also there is a flag specifying whether to check or ignore balance assertions in the journal. +readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> String -> IO (Either String Journal) +readJournal format rulesfile assrt path s = tryReaders $ readersFor (format, path, s) where -- try each reader in turn, returning the error of the first if all fail @@ -126,7 +127,7 @@ readJournal format rulesfile path s = firstSuccessOrBestError [] [] = return $ Left "no readers found" firstSuccessOrBestError errs (r:rs) = do dbgAtM 1 "trying reader" (rFormat r) - result <- (runErrorT . (rParser r) rulesfile path') s + result <- (runErrorT . (rParser r) rulesfile assrt path') s dbgAtM 1 "reader result" $ either id show result case result of Right j -> return $ Right j -- success! Left e -> firstSuccessOrBestError (errs++[e]) rs -- keep trying @@ -158,16 +159,17 @@ readersForPathAndData (f,s) = filter (\r -> (rDetector r) f s) readers -- | Read a Journal from this file (or stdin if the filename is -) or give -- an error message, using the specified data format or trying all known -- formats. A CSV conversion rules file may be specified for better --- conversion of that format. -readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> FilePath -> IO (Either String Journal) -readJournalFile format rulesfile "-" = do +-- conversion of that format. Also there is a flag specifying whether +-- to check or ignore balance assertions in the journal. +readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> FilePath -> IO (Either String Journal) +readJournalFile format rulesfile assrt "-" = do hSetNewlineMode stdin universalNewlineMode - getContents >>= readJournal format rulesfile (Just "-") -readJournalFile format rulesfile f = do + getContents >>= readJournal format rulesfile assrt (Just "-") +readJournalFile format rulesfile assrt f = do requireJournalFileExists f withFile f ReadMode $ \h -> do hSetNewlineMode h universalNewlineMode - hGetContents h >>= readJournal format rulesfile (Just f) + hGetContents h >>= readJournal format rulesfile assrt (Just f) -- | If the specified journal file does not exist, give a helpful error and quit. requireJournalFileExists :: FilePath -> IO () @@ -229,7 +231,7 @@ tests_Hledger_Read = TestList $ "journal" ~: do assertBool "journal should parse an empty file" (isRight $ parseWithCtx nullctx JournalReader.journal "") - jE <- readJournal Nothing Nothing Nothing "" -- don't know how to get it from journal + jE <- readJournal Nothing Nothing True Nothing "" -- don't know how to get it from journal either error' (assertBool "journal parsing an empty file should give an empty journal" . null . jtxns) jE ] diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 687eff7a2..1e4f7d163 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -61,8 +61,8 @@ detect f s -- | 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 -> FilePath -> String -> ErrorT String IO Journal -parse rulesfile f s = do +parse :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal +parse rulesfile _ f s = do r <- liftIO $ readJournalFromCsv rulesfile f s case r of Left e -> throwError e Right j -> return j diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 4772498c1..8924c3cee 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -85,7 +85,7 @@ detect f s -- | Parse and post-process a "Journal" from hledger's journal file -- format, or give an error. -parse :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal +parse :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal parse _ = parseJournalWith journal -- parsing utils @@ -96,15 +96,15 @@ combineJournalUpdates us = liftM (foldl' (.) id) $ sequence us -- | Given a JournalUpdate-generating parsec parser, file path and data string, -- parse and post-process a Journal so that it's ready to use, or give an error. -parseJournalWith :: (GenParser Char JournalContext (JournalUpdate,JournalContext)) -> FilePath -> String -> ErrorT String IO Journal -parseJournalWith p f s = do +parseJournalWith :: (GenParser Char JournalContext (JournalUpdate,JournalContext)) -> Bool -> FilePath -> String -> ErrorT String IO Journal +parseJournalWith p assrt f s = do tc <- liftIO getClockTime tl <- liftIO getCurrentLocalTime y <- liftIO getCurrentYear case runParser p nullctx{ctxYear=Just y} f s of Right (updates,ctx) -> do j <- updates `ap` return nulljournal - case journalFinalise tc tl f s ctx j of + case journalFinalise tc tl f s ctx assrt j of Right j' -> return j' Left estr -> throwError estr Left e -> throwError $ show e diff --git a/hledger-lib/Hledger/Read/TimelogReader.hs b/hledger-lib/Hledger/Read/TimelogReader.hs index bc8e78a9e..45e50f601 100644 --- a/hledger-lib/Hledger/Read/TimelogReader.hs +++ b/hledger-lib/Hledger/Read/TimelogReader.hs @@ -78,7 +78,7 @@ detect f s -- | Parse and post-process a "Journal" from timeclock.el's timelog -- format, saving the provided file path and the current time, or give an -- error. -parse :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal +parse :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal parse _ = parseJournalWith timelogFile timelogFile :: GenParser Char JournalContext (JournalUpdate,JournalContext) diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 21fca23bc..6861f3f7c 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -63,8 +63,8 @@ tests_Hledger_Cli = TestList ,"account directive" ~: - let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing Nothing str1 >>= either error' return - j2 <- readJournal Nothing Nothing Nothing str2 >>= either error' return + let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing True Nothing str1 >>= either error' return + j2 <- readJournal Nothing Nothing True Nothing str2 >>= either error' return j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1} in TestList [ @@ -95,7 +95,7 @@ tests_Hledger_Cli = TestList ) ,"account directive should preserve \"virtual\" posting type" ~: do - j <- readJournal Nothing Nothing Nothing "!account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return + j <- readJournal Nothing Nothing True Nothing "!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 @@ -103,7 +103,7 @@ tests_Hledger_Cli = TestList ] ,"account aliases" ~: do - j <- readJournal Nothing Nothing Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return + j <- readJournal Nothing Nothing True 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" @@ -125,7 +125,7 @@ tests_Hledger_Cli = TestList -- `is` "aa:aa:aaaaaaaaaaaaaa") ,"default year" ~: do - j <- readJournal Nothing Nothing Nothing defaultyear_journal_str >>= either error' return + j <- readJournal Nothing Nothing True Nothing defaultyear_journal_str >>= either error' return tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 return () diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index 47faef987..66ca581a1 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -91,6 +91,7 @@ inputflags = [ flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different input file. For stdin, use -" ,flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "RFILE" "CSV conversion rules file (default: FILE.rules)" ,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "OLD=NEW" "display accounts named OLD as NEW" + ,flagNone ["ignore-assertions"] (setboolopt "ignore-assertions") "ignore any balance assertions in the journal" ] -- | Common report-related flags: --period, --cost, etc. @@ -230,6 +231,7 @@ data CliOpts = CliOpts { ,file_ :: Maybe FilePath ,rules_file_ :: Maybe FilePath ,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 -- register @@ -249,6 +251,7 @@ defcliopts = CliOpts def def def + def -- | Convert possibly encoded option values to regular unicode strings. decodeRawOpts :: RawOpts -> RawOpts @@ -267,6 +270,7 @@ rawOptsToCliOpts rawopts = do ,rules_file_ = maybestringopt "rules-file" rawopts ,alias_ = map stripquotes $ 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 -- register ,reportopts_ = ropts diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 9e9162a51..534ec580c 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -65,7 +65,7 @@ withJournalDo opts cmd = do -- to let the add command work. rulespath <- rulesFilePathFromOpts opts journalpath <- journalFilePathFromOpts opts - ej <- readJournalFile Nothing rulespath journalpath + ej <- readJournalFile Nothing rulespath (not $ ignore_assertions_ opts) journalpath either error' (cmd opts . journalApplyAliases (aliasesFromOpts opts)) ej -- -- | Get a journal from the given string and options, or throw an error. @@ -74,7 +74,7 @@ withJournalDo opts cmd = do -- | Re-read a journal from its data file, or return an error string. journalReload :: Journal -> IO (Either String Journal) -journalReload j = readJournalFile Nothing Nothing $ journalFilePath j +journalReload j = readJournalFile Nothing Nothing True $ journalFilePath j -- | Re-read a journal from its data file mostly, only if the file has -- changed since last read (or if there is no file, ie data read from