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

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

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"

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
 
   ]

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

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

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)

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 ()
 

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

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