@@ -20,6 +20,7 @@ Most of the code for reading rules files and csv files is in this module.
20
20
{-# LANGUAGE ScopedTypeVariables #-}
21
21
{-# LANGUAGE ViewPatterns #-}
22
22
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
23
+ {-# LANGUAGE LambdaCase #-}
23
24
24
25
--- ** exports
25
26
module Hledger.Read.RulesReader (
@@ -33,6 +34,7 @@ module Hledger.Read.RulesReader (
33
34
-- CsvRules,
34
35
dataFileFor ,
35
36
rulesFileFor ,
37
+ parseBalanceAssertionType ,
36
38
-- * Tests
37
39
tests_RulesReader ,
38
40
)
@@ -2361,16 +2363,26 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}
2361
2363
where
2362
2364
assrt =
2363
2365
case getDirective " balance-type" rules of
2364
- Nothing -> nullassertion
2365
- Just " =" -> nullassertion
2366
- Just " ==" -> nullassertion{batotal= True }
2367
- Just " =*" -> nullassertion{bainclusive= True }
2368
- Just " ==*" -> nullassertion{batotal= True , bainclusive= True }
2369
- Just x -> error' . T. unpack $ T. unlines -- PARTIAL:
2370
- [ " balance-type \" " <> x <> " \" is invalid. Use =, ==, =* or ==*."
2371
- , showRecord record
2372
- , showRules rules record
2373
- ]
2366
+ Nothing -> nullassertion
2367
+ Just x ->
2368
+ case parseBalanceAssertionType $ T. unpack x of
2369
+ Just (total, inclusive) -> nullassertion{batotal= total, bainclusive= inclusive}
2370
+ Nothing -> error' . T. unpack $ T. unlines -- PARTIAL:
2371
+ [ " balance-type \" " <> x <> " \" is invalid. Use =, ==, =* or ==*."
2372
+ , showRecord record
2373
+ , showRules rules record
2374
+ ]
2375
+
2376
+ -- | Detect from a balance assertion's syntax (=, ==, =*, ==*)
2377
+ -- whether it is (a) total (multi-commodity) and (b) subaccount-inclusive.
2378
+ -- Returns nothing if invalid syntax was provided.
2379
+ parseBalanceAssertionType :: String -> Maybe (Bool , Bool )
2380
+ parseBalanceAssertionType = \ case
2381
+ " =" -> Just (False , False )
2382
+ " ==" -> Just (True , False )
2383
+ " =*" -> Just (False , True )
2384
+ " ==*" -> Just (True , True )
2385
+ _ -> Nothing
2374
2386
2375
2387
-- | Figure out the account name specified for posting N, if any.
2376
2388
-- And whether it is the default unknown account (which may be
0 commit comments