68 lines
2.4 KiB
Haskell
Executable File
68 lines
2.4 KiB
Haskell
Executable File
#!/usr/bin/env stack
|
|
{- stack runghc --verbosity info
|
|
--package hledger-lib
|
|
--package hledger
|
|
--package text
|
|
-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
import Data.List
|
|
import System.Console.CmdArgs
|
|
import Hledger.Cli
|
|
import Hledger.Cli.Main (mainmode)
|
|
import Hledger.Data.AutoTransaction
|
|
|
|
actions :: [(Mode RawOpts, CliOpts -> IO ())]
|
|
actions =
|
|
[ (manmode, man)
|
|
, (infomode, info')
|
|
, (balancemode, flip withJournalDo' balance)
|
|
, (balancesheetmode, flip withJournalDo' balancesheet)
|
|
, (cashflowmode, flip withJournalDo' cashflow)
|
|
, (incomestatementmode, flip withJournalDo' incomestatement)
|
|
, (registermode, flip withJournalDo' register)
|
|
, (printmode, flip withJournalDo' print')
|
|
]
|
|
|
|
cmdmode :: Mode RawOpts
|
|
cmdmode = (mainmode [])
|
|
{ modeNames = ["hledger-budget"]
|
|
, modeGroupModes = Group
|
|
{ groupUnnamed = map fst actions
|
|
, groupNamed = []
|
|
, groupHidden = []
|
|
}
|
|
}
|
|
|
|
journalBalanceTransactions' :: CliOpts -> Journal -> IO Journal
|
|
journalBalanceTransactions' opts j = do
|
|
let assrt = not $ ignore_assertions_ opts
|
|
either error' return $ journalBalanceTransactions assrt j
|
|
|
|
withJournalDo' :: CliOpts -> (CliOpts -> Journal -> IO ()) -> IO ()
|
|
withJournalDo' opts = withJournalDo opts . wrapper where
|
|
wrapper f opts' j = do
|
|
-- use original transactions as input for journalBalanceTransactions to re-infer balances/prices
|
|
let modifier = originalTransaction . foldr (flip (.) . runModifierTransaction') id mtxns
|
|
runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Any
|
|
mtxns = jmodifiertxns j
|
|
dates = jdatespan j
|
|
ts' = map modifier $ jtxns j
|
|
ts'' = [makeBudget t | pt <- jperiodictxns j, t <- runPeriodicTransaction pt dates] ++ ts'
|
|
makeBudget t = txnTieKnot $ t
|
|
{ tdescription = "Budget transaction"
|
|
, tpostings = map makeBudgetPosting $ tpostings t
|
|
}
|
|
makeBudgetPosting p = p { pamount = negate $ pamount p }
|
|
j' <- journalBalanceTransactions' opts' j{ jtxns = ts'' }
|
|
f opts' j'
|
|
|
|
main :: IO ()
|
|
main = do
|
|
rawopts <- fmap decodeRawOpts . processArgs $ cmdmode
|
|
opts <- rawOptsToCliOpts rawopts
|
|
let cmd = command_ opts
|
|
case find (\e -> cmd `elem` modeNames (fst e)) actions of
|
|
Just (amode, _) | "h" `elem` map fst (rawopts_ opts) -> print amode
|
|
Just (_, action) -> action opts
|
|
Nothing -> print cmdmode
|