refactor/fix balanced entry checking and test it properly

Ledger/Entry.hs

@@ -49,7 +49,13 @@ pcommentwidth = no limit -- 22
 @
 -}
 showEntry :: Entry -> String
-showEntry e = 
+showEntry = showEntry' True
+
+showEntryUnelided :: Entry -> String
+showEntryUnelided = showEntry' False
+
+showEntry' :: Bool -> Entry -> String
+showEntry' elide e = 
     unlines $ [{-precedingcomment ++ -}description] ++ (showtxns $ etransactions e) ++ [""]
     where
       precedingcomment = epreceding_comment_lines e
@@ -59,8 +65,9 @@ showEntry e =
       code = if (length $ ecode e) > 0 then (printf " (%s)" $ ecode e) else ""
       desc = " " ++ edescription e
       comment = if (length $ ecomment e) > 0 then "  ; "++(ecomment e) else ""
-      showtxns (t1:t2:[]) = [showtxn t1, showtxnnoamt t2]
+      showtxns ts
-      showtxns ts = map showtxn ts
+          | elide && length ts == 2 = [showtxn (ts !! 0), showtxnnoamt (ts !! 1)]
+          | otherwise = map showtxn ts
       showtxn t = showacct t ++ "  " ++ (showamount $ tamount t) ++ (showcomment $ tcomment t)
       showtxnnoamt t = showacct t ++ "              " ++ (showcomment $ tcomment t)
       showacct t = "    " ++ (showaccountname $ taccount t)
@@ -77,19 +84,19 @@ isEntryBalanced (Entry {etransactions=ts}) =
 -- amount first. We can auto-fill if there is just one non-virtual
 -- transaction without an amount. The auto-filled balance will be
 -- converted to cost basis if possible. If the entry can not be balanced,
--- raise an error.
+-- return an error message instead.
-balanceEntry :: Entry -> Entry
+balanceEntry :: Entry -> Either String Entry
-balanceEntry e@Entry{etransactions=ts} = (e{etransactions=ts'})
+balanceEntry e@Entry{etransactions=ts}
+    | length missingamounts > 1 = Left $ showerr "could not balance this entry, too many missing amounts"
+    | not $ isEntryBalanced e' = Left $ showerr "could not balance this entry, amounts do not balance"
+    | otherwise = Right e'
     where
-      check e
-          | isEntryBalanced e = e
-          | otherwise = error $ "could not balance this entry:\n" ++ show e
       (withamounts, missingamounts) = partition hasAmount $ filter isReal ts
-      ts' = case (length missingamounts) of
+      e' = e{etransactions=ts'}
-              0 -> ts
+      ts' | length missingamounts == 1 = map balance ts
-              1 -> map balance ts
+          | otherwise = ts
-              otherwise -> error $ "could not balance this entry, too many missing amounts:\n" ++ show e
+          where 
-      otherstotal = sum $ map tamount withamounts
+            balance t | isReal t && not (hasAmount t) = t{tamount = costOfMixedAmount (-otherstotal)}
-      balance t
+                      | otherwise = t
-          | isReal t && not (hasAmount t) = t{tamount = costOfMixedAmount (-otherstotal)}
+                      where otherstotal = sum $ map tamount withamounts
-          | otherwise = t
+      showerr s = printf "%s:\n%s" s (showEntryUnelided e)

Ledger/Parse.hs

@@ -301,6 +301,8 @@ ledgerDefaultYear = do
   setYear y'
   return $ return id
 
+-- | Try to parse a ledger entry. If we successfully parse an entry, ensure it is balanced,
+-- and if we cannot, raise an error.
 ledgerEntry :: GenParser Char LedgerFileCtx Entry
 ledgerEntry = do
   date <- ledgerdate <?> "entry"
@@ -313,7 +315,10 @@ ledgerEntry = do
   comment <- ledgercomment
   restofline
   transactions <- ledgertransactions
-  return $ balanceEntry $ Entry date status code description comment transactions ""
+  let e = Entry date status code description comment transactions ""
+  case balanceEntry e of
+    Right e' -> return e'
+    Left err -> error err
 
 ledgerdate :: GenParser Char LedgerFileCtx Day
 ledgerdate = try ledgerfulldate <|> ledgerpartialdate

Ledger/Utils.hs

@@ -239,3 +239,13 @@ spacenonewline = satisfy (\c -> c `elem` " \v\f\t")
 restofline :: GenParser Char st String
 restofline = anyChar `manyTill` newline
 
+
+
+
+isLeft :: Either a b -> Bool
+isLeft (Left _) = True
+isLeft _        = False
+
+isRight :: Either a b -> Bool
+isRight = not . isLeft
+

NOTES

@@ -10,24 +10,8 @@ clever tricks like the plague." --Edsger Dijkstra
 
 * to do
 ** errors
-*** not catching some unbalanced entries, two ways:
-**** 1
-1/1 test1
-    a             $-100
-    b        -10h @ $10
-; $ hledger -B reg -- test1
-; 2009/01/01 test1                a                          $-100.00     $-100.00
-**** 2
-1/1 test2
-    a             $-100
-    b             $-100
-; $ hledger -B reg -- test2
-; 2009/01/01 test2                a                          $-100.00     $-100.00
-;                                 b                          $-100.00     $-200.00
-
 *** --depth works with reg -W but not with reg
 *** register report should sort by date
-*** too many dependencies, hard to install esp. without cabal install
 ** features
 *** more ledger features
 **** rename entry -> transaction, transaction -> posting

Tests.hs

@@ -259,7 +259,27 @@ tests = [
    ]
 
   ,"balanceEntry" ~: do
-    (tamount $ last $ etransactions $ balanceEntry entry1) `is` Mixed [dollars (-47.18)]
+     let fromeither (Left err) = error err
+         fromeither (Right e) = e
+     (tamount $ last $ etransactions $ fromeither $ balanceEntry entry1) `is` Mixed [dollars (-47.18)]
+     assertBool "detect unbalanced entry, sign error"
+                    (isLeft $ balanceEntry
+                           (Entry (parsedate "2007/01/28") False "" "test" ""
+                            [RawTransaction False "a" (Mixed [dollars 1]) "" RegularTransaction, 
+                             RawTransaction False "b" (Mixed [dollars 1]) "" RegularTransaction
+                            ] ""))
+     assertBool "detect unbalanced entry, multiple missing amounts"
+                    (isLeft $ balanceEntry
+                           (Entry (parsedate "2007/01/28") False "" "test" ""
+                            [RawTransaction False "a" missingamt "" RegularTransaction, 
+                             RawTransaction False "b" missingamt "" RegularTransaction
+                            ] ""))
+     assertBool "one missing amount should be ok"
+                    (isRight $ balanceEntry
+                           (Entry (parsedate "2007/01/28") False "" "test" ""
+                            [RawTransaction False "a" (Mixed [dollars 1]) "" RegularTransaction, 
+                             RawTransaction False "b" missingamt "" RegularTransaction
+                            ] ""))
 
   ,"balancereportacctnames" ~: 
    let gives (opt,pats) e = do