#!/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