slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

dev:close: refactor

Browse Source
This commit is contained in:
Simon Michael 2024-01-20 21:53:46 -10:00
parent 38d9f1760e
commit f53f3a0194
1 changed files with 107 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

209
hledger/Hledger/Cli/Commands/Close.hs
View File

@ -8,7 +8,6 @@ module Hledger.Cli.Commands.Close (
) )
where where
import Control.Monad (when)
import Data.Function (on) import Data.Function (on)
import Data.List (groupBy) import Data.List (groupBy)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
@ -20,6 +19,7 @@ import System.Console.CmdArgs.Explicit as C
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Safe (lastDef, readMay)
defretaindesc = "retain earnings" defretaindesc = "retain earnings"
defclosedesc = "closing balances" defclosedesc = "closing balances"
@ -54,25 +54,20 @@ closemode = hledgerCommandMode
) )
([], Just $ argsFlag "[--close | --open | --migrate | --retain] [ACCTQUERY]") ([], Just $ argsFlag "[--close | --open | --migrate | --retain] [ACCTQUERY]")
-- | The close command's mode. Really a subcommand.
data CloseMode = Migrate | Close | Open | Assert | Assign | Retain deriving (Eq,Show,Read,Enum)
-- | Pick the rightmost flag spelled like a CloseMode (--migrate, --close, --open, etc), or default to Close.
closeModeFromRawOpts :: RawOpts -> CloseMode
closeModeFromRawOpts rawopts = lastDef Close $ collectopts (\(name,_) -> readMay (capitalise name)) rawopts
-- Debugger, beware: close is incredibly devious; simple rules combine to make a horrid maze. -- Debugger, beware: close is incredibly devious; simple rules combine to make a horrid maze.
-- Tests are in hledger/test/close.test. -- Tests are in hledger/test/close.test.
-- This code is also used by the close command.
close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} j = do close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} j = do
let let
-- currently only one of the six mode flags takes effect at a time (hledger close --close --open only does --open). mode_ = closeModeFromRawOpts rawopts
(close_, open_, assert_, assign_, defclosedesc_, defopendesc_, defcloseacct_, defacctsq_) = if defacctsq_ = if mode_ == Retain then Type [Revenue, Expense] else Type [Asset, Liability]
| boolopt "retain" rawopts -> (True, False, False, False, defretaindesc, undefined, defretainacct, Type [Revenue, Expense]) defcloseacct_ = if mode_ == Retain then defretainacct else defcloseacct
| boolopt "migrate" rawopts -> (True, True, False, False, defclosedesc, defopendesc, defcloseacct, Type [Asset, Liability])
| boolopt "assign" rawopts -> (False, False, False, True, undefined, defopendesc, defcloseacct, Type [Asset, Liability])
| boolopt "assert" rawopts -> (False, False, True, False, defclosedesc, undefined, defcloseacct, Type [Asset, Liability])
| boolopt "open" rawopts -> (False, True, False, False, undefined, defopendesc, defcloseacct, Type [Asset, Liability])
| otherwise {- close -} -> (True, False, False, False, defclosedesc, undefined, defcloseacct, Type [Asset, Liability])
-- descriptions to use for the closing/opening transactions
closedesc = T.pack $ fromMaybe defclosedesc_ $ maybestringopt "close-desc" rawopts
opendesc = T.pack $ fromMaybe defopendesc_ $ maybestringopt "open-desc" rawopts
-- equity/balancing accounts to use
closeacct = T.pack $ fromMaybe defcloseacct_ $ maybestringopt "close-acct" rawopts closeacct = T.pack $ fromMaybe defcloseacct_ $ maybestringopt "close-acct" rawopts
openacct = maybe closeacct T.pack $ maybestringopt "open-acct" rawopts openacct = maybe closeacct T.pack $ maybestringopt "open-acct" rawopts
@ -115,100 +110,110 @@ close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} j = do
interleaved = boolopt "interleaved" rawopts interleaved = boolopt "interleaved" rawopts
-- the closing (balance-asserting or balance-zeroing) transaction -- the closing (balance-asserting or balance-zeroing) transaction
closetxn = nulltransaction{tdate=closedate, tdescription=closedesc, tpostings=closeps} mclosetxn
closeps | mode_ `notElem` [Migrate, Close, Assert, Retain] = Nothing
-- XXX some duplication | otherwise = Just nulltransaction{tdate=closedate, tdescription=closedesc, tpostings=closeps}
| assert_ = where
[ posting{ closedesc = T.pack $ fromMaybe defclosedesc_ $ maybestringopt "close-desc" rawopts
paccount = a where defclosedesc_ = if mode_ == Retain then defretaindesc else defclosedesc
,pamount = mixedAmount $ precise b{aquantity=0, aprice=Nothing} closeps
-- after each commodity's last posting, assert 0 balance (#1035) -- XXX some duplication
-- balance assertion amounts are unpriced (#824) | mode_ == Assert =
,pbalanceassertion = [ posting{
if islast paccount = a
then Just nullassertion{baamount=precise b} ,pamount = mixedAmount $ precise b{aquantity=0, aprice=Nothing}
else Nothing -- after each commodity's last posting, assert 0 balance (#1035)
} -- balance assertion amounts are unpriced (#824)
| -- get the balances for each commodity and transaction price ,pbalanceassertion =
(a,mb) <- acctbals if islast
, let bs0 = amounts mb then Just nullassertion{baamount=precise b}
-- mark the last balance in each commodity with True else Nothing
, let bs2 = concat [reverse $ zip (reverse bs1) (True : repeat False) }
| bs1 <- groupBy ((==) `on` acommodity) bs0] | -- get the balances for each commodity and transaction price
, (b, islast) <- bs2 (a,mb) <- acctbals
] , let bs0 = amounts mb
-- mark the last balance in each commodity with True
, let bs2 = concat [reverse $ zip (reverse bs1) (True : repeat False)
| bs1 <- groupBy ((==) `on` acommodity) bs0]
, (b, islast) <- bs2
]
| otherwise = | otherwise =
concat [ concat [
posting{paccount = a posting{paccount = a
,pamount = mixedAmount . precise $ negate b ,pamount = mixedAmount . precise $ negate b
-- after each commodity's last posting, assert 0 balance (#1035) -- after each commodity's last posting, assert 0 balance (#1035)
-- balance assertion amounts are unpriced (#824) -- balance assertion amounts are unpriced (#824)
,pbalanceassertion = ,pbalanceassertion =
if islast if islast
then Just nullassertion{baamount=precise b{aquantity=0, aprice=Nothing}} then Just nullassertion{baamount=precise b{aquantity=0, aprice=Nothing}}
else Nothing else Nothing
} }
-- maybe an interleaved posting transferring this balance to equity -- maybe an interleaved posting transferring this balance to equity
: [posting{paccount=closeacct, pamount=mixedAmount $ precise b} | interleaved] : [posting{paccount=closeacct, pamount=mixedAmount $ precise b} | interleaved]
| -- get the balances for each commodity and transaction price | -- get the balances for each commodity and transaction price
(a,mb) <- acctbals (a,mb) <- acctbals
, let bs0 = amounts mb , let bs0 = amounts mb
-- mark the last balance in each commodity with True -- mark the last balance in each commodity with True
, let bs2 = concat [reverse $ zip (reverse bs1) (True : repeat False) , let bs2 = concat [reverse $ zip (reverse bs1) (True : repeat False)
| bs1 <- groupBy ((==) `on` acommodity) bs0] | bs1 <- groupBy ((==) `on` acommodity) bs0]
, (b, islast) <- bs2 , (b, islast) <- bs2
] ]
-- or a final multicommodity posting transferring all balances to equity -- or a final multicommodity posting transferring all balances to equity
-- (print will show this as multiple single-commodity postings) -- (print will show this as multiple single-commodity postings)
++ [posting{paccount=closeacct, pamount=if explicit then mixedAmountSetFullPrecision totalamt else missingmixedamt} | not interleaved] ++ [posting{paccount=closeacct, pamount=if explicit then mixedAmountSetFullPrecision totalamt else missingmixedamt} | not interleaved]
-- the opening (balance-assigning or balance-unzeroing) transaction -- the opening (balance-assigning or balance-unzeroing) transaction
opentxn = nulltransaction{tdate=opendate, tdescription=opendesc, tpostings=openps} mopentxn
openps | mode_ `notElem` [Migrate, Open, Assign] = Nothing
| assign_ = | otherwise = Just nulltransaction{tdate=opendate, tdescription=opendesc, tpostings=openps}
[ posting{paccount = a where
,pamount = missingmixedamt opendesc = T.pack $ fromMaybe defopendesc $ maybestringopt "open-desc" rawopts
,pbalanceassertion = Just nullassertion{baamount=b} openps
-- case mcommoditysum of | mode_ == Assign =
-- Just s -> Just nullassertion{baamount=precise s} [ posting{paccount = a
-- Nothing -> Nothing ,pamount = missingmixedamt
} ,pbalanceassertion = Just nullassertion{baamount=b}
-- case mcommoditysum of
-- Just s -> Just nullassertion{baamount=precise s}
-- Nothing -> Nothing
}
| (a,mb) <- acctbals | (a,mb) <- acctbals
, let bs0 = amounts mb , let bs0 = amounts mb
-- mark the last balance in each commodity with the unpriced sum in that commodity (for a balance assertion) -- mark the last balance in each commodity with the unpriced sum in that commodity (for a balance assertion)
, let bs2 = concat [reverse $ zip (reverse bs1) (Just commoditysum : repeat Nothing) , let bs2 = concat [reverse $ zip (reverse bs1) (Just commoditysum : repeat Nothing)
| bs1 <- groupBy ((==) `on` acommodity) bs0 | bs1 <- groupBy ((==) `on` acommodity) bs0
, let commoditysum = (sum bs1)] , let commoditysum = (sum bs1)]
, (b, _mcommoditysum) <- bs2 , (b, _mcommoditysum) <- bs2
] ]
++ [posting{paccount=openacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | not interleaved] ++ [posting{paccount=openacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | not interleaved]
| otherwise = | otherwise =
concat [ concat [
posting{paccount = a posting{paccount = a
,pamount = mixedAmount $ precise b ,pamount = mixedAmount $ precise b
,pbalanceassertion = ,pbalanceassertion =
case mcommoditysum of case mcommoditysum of
Just s -> Just nullassertion{baamount=precise s{aprice=Nothing}} Just s -> Just nullassertion{baamount=precise s{aprice=Nothing}}
Nothing -> Nothing Nothing -> Nothing
} }
: [posting{paccount=openacct, pamount=mixedAmount . precise $ negate b} | interleaved] : [posting{paccount=openacct, pamount=mixedAmount . precise $ negate b} | interleaved]
| (a,mb) <- acctbals | (a,mb) <- acctbals
, let bs0 = amounts mb , let bs0 = amounts mb
-- mark the last balance in each commodity with the unpriced sum in that commodity (for a balance assertion) -- mark the last balance in each commodity with the unpriced sum in that commodity (for a balance assertion)
, let bs2 = concat [reverse $ zip (reverse bs1) (Just commoditysum : repeat Nothing) , let bs2 = concat [reverse $ zip (reverse bs1) (Just commoditysum : repeat Nothing)
| bs1 <- groupBy ((==) `on` acommodity) bs0 | bs1 <- groupBy ((==) `on` acommodity) bs0
, let commoditysum = (sum bs1)] , let commoditysum = (sum bs1)]
, (b, mcommoditysum) <- bs2 , (b, mcommoditysum) <- bs2
] ]
++ [posting{paccount=openacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | not interleaved] ++ [posting{paccount=openacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | not interleaved]
-- print them -- print them
when (close_ || assert_) . T.putStr $ showTransaction closetxn maybe (pure ()) (T.putStr . showTransaction) mclosetxn
when (open_ || assign_) . T.putStr $ showTransaction opentxn maybe (pure ()) (T.putStr . showTransaction) mopentxn