simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-12-25 03:13:25 +03:00
Code Issues Projects Releases Wiki Activity

bin: hledger-move, helps make subaccount/cost-preserving transfers

Browse Source
This commit is contained in:
Simon Michael 2022-10-01 18:38:48 -10:00
parent 7fd25809e8
commit 8f06cefab4
4 changed files with 335 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
bin/README.md
View File

@ -155,6 +155,11 @@ uses one balance report to set budget goals for another balance report.
[`hledger-smooth.hs`](https://github.com/simonmichael/hledger/blob/master/bin/hledger-smooth.hs) [`hledger-smooth.hs`](https://github.com/simonmichael/hledger/blob/master/bin/hledger-smooth.hs)
is an incomplete attempt at automatically splitting infrequent/irregular transactions. is an incomplete attempt at automatically splitting infrequent/irregular transactions.
### hledger-move
[`hledger-move.hs`](https://github.com/simonmichael/hledger/blob/master/bin/hledger-move.hs)
helps make subaccount/cost-preserving transfers.
## hledger-related scripts ## hledger-related scripts
These don't run hledger, but are probably related to it in some way: These don't run hledger, but are probably related to it in some way:

2
bin/compile.sh
View File

@ -8,7 +8,7 @@ echo "building hledger libraries for scripts"
stack build hledger stack build hledger
echo "installing extra libraries for scripts" echo "installing extra libraries for scripts"
stack install string-qq stack install string-qq microlens
echo "compiling the hledger-* scripts" echo "compiling the hledger-* scripts"
for f in `git ls-files 'hledger-*.hs'`; do stack ghc -- "$f"; done for f in `git ls-files 'hledger-*.hs'`; do stack ghc -- "$f"; done

268
bin/hledger-move.hs Executable file
View File

@ -0,0 +1,268 @@
#!/usr/bin/env stack
-- stack runghc --verbosity info
-- --package hledger --package string-qq --package text --package time --package microlens
--
-- Using unreleased hledger: from inside the hledger source tree,
--
-- Run interpreted:
-- bin/hledger-move.hs
--
-- Compile:
-- stack ghc -- bin/hledger-move.hs -ihledger-lib -ihledger
-- or use bin/compile.sh
--
-- Debug:
-- stack ghci bin/hledger-move.hs --ghc-options=-'ihledger-lib -ihledger'
--
-- Watch compilation:
-- stack exec ghcid bin/hledger-move.hs -- --command="ghci -ihledger-lib -ihledger"
--
-- There are some tests in hledger/test/_move.test
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
import Control.Monad (when)
import Data.Function (on)
import Data.List (find, groupBy, mapAccumL)
import Data.Maybe (fromMaybe, isNothing)
import Data.String.QQ (s)
import Data.Time (addDays)
import Safe (headDef)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
import System.IO.Unsafe (unsafePerformIO)
import Lens.Micro ((^.))
import Text.Printf
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Hledger.Cli
------------------------------------------------------------------------------
cmdmode = hledgerCommandMode
-- Command name and help text goes here. Current limitations:
-- help text must be above _FLAGS, blank lines will not be displayed.
[s| hledger-move
Print an entry to move funds between accounts, preserving costs and subaccounts
Usage: hledger-move AMT FROMACCT TOACCT
AMT is a positive hledger amount, as in journal format.
FROMACCT is an account name or regular expression, as in an acct: query.
The alphabetically first account name it matches is the source account.
TOACCT is an account name or regexp selecting the destination account.
This command prints a journal entry which you can add to your journal,
representing a transfer of the requested amount from the source account
to the destination account.
The commodity to be moved is determined by AMT's commodity symbol.
As a convenience, no symbol means "move the account's only commodity";
this works when the source account contains just one commodity.
This command can also move amounts from subaccounts (one level, at least).
It will move amounts first out of the main source account if possible,
then as needed out of each subaccount in alphanumerical order of names,
until the total requested amount is moved.
(This is useful when withdrawing from an account with subaccounts
representing investment lots; if these are named by acquisition date
(eg ":YYYYMMDD"), they will be moved in FIFO order.)
This command is mainly intended for moving assets.
If there are not sufficient positive balances in the source account(s)
to supply the requested amount, the command will fail.
Any source subaccounts used will be recreated under the destination account.
Or, to consolidate amounts in the main destination account
(discarding lot information), use the --consolidate flag.
Examples:
$ hledger-move $50 assets:checking assets:cash # withdraw cash from bank
$ hledger-move 50 checking cash # the same, less typing
$ hledger-move 1000 ada:wallet1 ada:wallet2 # move 1000, keeping lots
_FLAGS
|]
{- NOT YET IMPLEMENTED:
A zero AMT means "move all of the specified commodity".
or the keyword "all"
An "all" AMT does the same, but for all commodities present;
it works when all of the source account's commodities are positive.
$ hledger-move all savings checking # all savings -> checking
$ hledger-move all assets:broker1:FOO assets:broker2:FOO # move all lots
It is aware of account balances, and prevents overdraft/overpay:
it will fail if the requested transfer would make
the source account go negative (as when overdrawing an asset)
or the destination account go positive (as when over-paying a liability).
You can disable this validation by adding the --force flag.
balance assertions
-}
------------------------------------------------------------------------------
[flagNone ["consolidate"] (setboolopt "consolidate") "don't recreate subaccounts"
-- ,flagNone ["force"] (setboolopt "force") "don't prevent overdraw/overpay"
]
[generalflagsgroup1]
[]
([arg "AMT"
,arg "FROMACCT"
,arg "TOACCT"
],
Nothing
)
where
arg name = flagArg (\val rawopts -> Right $ setopt name val rawopts) name
------------------------------------------------------------------------------
main :: IO ()
main = do
copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} <- getHledgerCliOpts cmdmode
withJournalDo copts $ \j -> do
-- d <- getCurrentDay
let
-- arg errors
-- clunky
shortusage = "Usage: hledger-move AMT FROMACCT TOACCT"
longusage = unlines
[ shortusage
, "AMT the total amount to move, as a hledger amount with commodity symbol"
, "FROMACCT the main account to move it from; subaccounts can also be drained"
, "TOACCT the main account to move it to; subaccounts can be recreated here"
]
-- No args should show usage, not "Error:" (but I guess still needs a failure exit code)
exitUsage = unsafePerformIO $ hPutStrLn stderr longusage >> exitFailure
mamtarg = maybestringopt "AMT" rawopts
mfromacctarg = maybestringopt "FROMACCT" rawopts
mtoacctarg = maybestringopt "TOACCT" rawopts
noargs = all isNothing [mamtarg, mfromacctarg, mtoacctarg]
amtarg = fromMaybe (error' $ "Please specify the amount to move as first argument.\n"++shortusage) mamtarg -- won't happen
fromacctarg = fromMaybe (error' $ "Please specify a source account name or pattern as second argument.\n"++shortusage) mfromacctarg
toacctarg = fromMaybe (error' $ "Please specify a destination account name or pattern as third argument.\n"++shortusage) mtoacctarg
consolidate = boolopt "consolidate" rawopts
force = boolopt "force" rawopts
-- parse the AMT arg as a cost-less Amount (any provided cost is ignored)
eamt = styleAmount (journalCommodityStyles j) . amountStripPrices <$> parseamount amtarg
amt = case eamt of
Left err ->
error' $ "could not parse " ++ show amtarg ++ " as a hledger amount\n" ++ customErrorBundlePretty err ++ "\n" ++shortusage
Right a | isNegativeAmount a ->
error' $ amtarg ++ " is negative, please specify a positive amount to move.\n"++shortusage
Right a -> a
comm = acommodity amt
-- when comparing with zero, it needs to have the same commodity
zero = amt{aquantity=0}
accts = journalAccountNamesDeclaredOrImplied j
fromacct = amt `seq` fromMaybe (error' $ fromacctarg ++ " did not match any account.") $ firstMatch (T.pack fromacctarg) accts
fromacctlen = length $ accountNameComponents fromacct
toacct = fromacct `seq` fromMaybe (error' $ toacctarg ++ " did not match any account.") $ firstMatch (T.pack toacctarg) accts
-- get account names and balances of fromacct and any subs, ordered by name
ropts = (_rsReportOpts rspec0){balanceaccum_=Historical, accountlistmode_=ALFlat}
rspec =
setDefaultConversionOp NoConversionOp -- ?
rspec0{
_rsReportOpts = ropts
,_rsQuery = Acct $ accountNameToAccountRegex $ fromacct
}
acctbals = fst $ balanceReport rspec j
availablebal =
headDef zero $ amounts $
filterMixedAmountByCommodity comm $
mixedAmountStripPrices $ sum $ map fourth4 acctbals
-- Take just enough of these account balances, in the order given,
-- to cover the requested AMT. Or if there is not enough, take what is there.
-- AMT is a single-commodity, cost-less amount.
-- Account balances can be multi-commodity, but only AMT's commodity will be moved.
-- An account balance could also possibly have multiple costs in that commodity;
-- in that case we raise an error, for now. (Could take amounts in order of cost's
-- commodity and amount).
(unmoved, moveamts) = go (dbgamt "requested amt to move" amt) [] acctbals
where
dbgamt lbl = id -- dbg0With (((lbl++": ")++).showAmount)
dbgmamt lbl = id -- dbg0With (((lbl++": ")++).showMixedAmountOneLine)
go :: Amount -> [(AccountName, MixedAmount)] -> [BalanceReportItem] -> (Amount, [(AccountName, MixedAmount)])
go stilltomove balscollected [] = (stilltomove, reverse balscollected)
go stilltomove balscollected ((acct,_,_,bal):rest)
| stilltomovenext > zero = go stilltomovenext ((acct,balincomm) : balscollected) rest
| otherwise =
let
-- the final balance portion to move
finalamt = dbgamt "final amt to move" $
(balincommsinglecost + stilltomovenext)
{aprice=aprice balincommsinglecost} -- + discards cost, need to restore it
in (0, reverse $ (acct, mixed [finalamt]) : balscollected)
where
-- how much of the requested commodity is in this account
comm = acommodity stilltomove
balincomm = filterMixedAmountByCommodity comm bal
-- for now, ensure there is at most one cost basis (and convert to Amount)
balincommsinglecost =
case amounts $ balincomm of
[b] -> dbgamt ("acct balance in "++show comm) b
_ -> error' $ "sorry, we can't yet move funds out of a multi-cost balance ("
++ showMixedAmountOneLine balincomm ++ ")"
-- subtract this from the amount remaining to move (ignoring cost)
stilltomovenext = dbgamt "remaining amt to move" $
stilltomove - amountStripPrices balincommsinglecost
-- since balance assertion amounts are required to be exact, the
-- amounts in opening/closing transactions should be too (#941, #1137)
-- amountSetFullPrecision
fromps = [
posting{paccount = a
,pamount = mixedAmount $ negate b
-- ,pbalanceassertion = Just nullassertion{baamount=precise b{aquantity=0, aprice=Nothing}}
}
| -- get the balances for each commodity and transaction price
(a,mixedb) <- moveamts
, let bs0 = amounts mixedb
-- 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
]
tops = if consolidate
then [
posting{paccount = toacct, pamount = mixed [amt]}
]
else [
posting{paccount = a', pamount = negate b}
| Posting{paccount=a, pamount=b} <- fromps
, let subacctcomps = drop fromacctlen $ accountNameComponents a
, let a' = accountNameFromComponents $ toacctcomps ++ subacctcomps
]
where
toacctcomps = accountNameComponents toacct
if
| noargs -> exitUsage
| unmoved > zero -> error' $
"could not move " ++ showAmount amt ++ ", only " ++ showAmount availablebal ++ " is available in commodity " ++ show comm
| otherwise ->
T.putStr $ showTransaction $ nulltransaction{
tdate = _rsDay rspec
,tdescription = ""
,tpostings = fromps ++ tops
}
firstMatch :: T.Text -> [T.Text] -> Maybe T.Text
firstMatch pat vals =
let re = toRegexCI' pat
in find (regexMatchText re) vals

61
hledger/test/_move.test Normal file
View File

@ -0,0 +1,61 @@
# Tests for bin/hledger-move.hs
2022/01/01
(f) 1
(f:ff) 1
(f:ff:fff) 1
(n) -1
(t) 0
comment
# 1. TOACCT must exist
$ hledger-move -f- --today=2000-01-01 0 f unknown
>2 /Error: unknown did not match any account./
>=1
# 2. Can create an entry moving zero
$ hledger-move -f- --today=2000-01-01 0 f t
2000-01-01
f 0
t 0
>=
# 3. Funds are moved from parent account first
$ hledger-move -f- --today=2000-01-01 1 f t
2000-01-01
f -1
t 1
>=
# 4. Then from subaccounts as needed
$ hledger-move -f- --today=2000-01-01 2 f t
2000-01-01
f -1
f:ff -1
t 1
t:ff 1
>=
# 5. Insufficient funds to move gives an error
$ hledger-move -f- --today=2000-01-01 10 f t
>2 /Error: could not move 10, only 3 is available/
>=1
# 6. And you can't move funds from a negative balance
$ hledger-move -f- --today=2000-01-01 1 n t
>2 /Error: could not move 1, only -1 is available/
>=1
# 7. A negative amount is not easily entered
$ hledger-move -f- --today=2000-01-01 '-1' f t
>2 /Error: Unknown flag: -1/
>=1
# 8. It can be done with -- (and hledger-move, not hledger move), but will be rejected.
$ hledger-move -f- --today=2000-01-01 -- -1 f t
>2 /please specify a positive amount/
>=1