module Internal.History
  ( splitHistory
  , insertHistTransfer
  , readHistStmt
  , insertHistStmt
  )
where

import Control.Monad.Except
import Database.Persist.Monad
import Internal.Database.Ops
import Internal.Statement
import Internal.Types.Main
import Internal.Utils
import RIO hiding (to)
import qualified RIO.Text as T
import RIO.Time

--------------------------------------------------------------------------------
-- budget

-- each budget (designated at the top level by a 'name') is processed in the
-- following steps
-- 1. expand all transactions given the desired date range and date patterns for
--    each directive in the budget
-- 2. sort all transactions by date
-- 3. propagate all balances forward, and while doing so assign values to each
--    transaction (some of which depend on the 'current' balance of the
--    target account)
-- 4. assign shadow transactions (TODO)
-- 5. insert all transactions

--------------------------------------------------------------------------------
-- statements

splitHistory :: [History] -> ([HistTransfer], [Statement])
splitHistory = partitionEithers . fmap go
  where
    go (HistTransfer x) = Left x
    go (HistStatement x) = Right x

-- insertStatement
--   :: (MonadUnliftIO m, MonadSqlQuery m, MonadFinance m)
--   => History
--   -> m ()
-- insertStatement (HistTransfer m) = liftIOExceptT $ insertManual m
-- insertStatement (HistStatement i) = insertImport i

insertHistTransfer
  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
  => HistTransfer
  -> m ()
insertHistTransfer
  m@Transfer
    { transFrom = from
    , transTo = to
    , transCurrency = u
    , transAmounts = amts
    } = do
    whenHash CTManual m () $ \c -> do
      bounds <- askDBState kmStatementInterval
      let precRes = lookupCurrencyPrec u
      let go Amount {amtWhen, amtValue, amtDesc} = do
            let dayRes = liftExcept $ expandDatePat bounds amtWhen
            (days, precision) <- combineError dayRes precRes (,)
            let tx day = txPair day from to u (roundPrecision precision amtValue) amtDesc
            keys <- combineErrors $ fmap tx days
            mapM_ (insertTx c) keys
      void $ combineErrors $ fmap go amts

readHistStmt :: (MonadUnliftIO m, MonadFinance m) => Statement -> m (Maybe (CommitR, [KeyTx]))
readHistStmt i = whenHash_ CTImport i $ do
  bs <- readImport i
  bounds <- askDBState kmStatementInterval
  liftIOExceptT $ mapErrors resolveTx $ filter (inDaySpan bounds . txDate) bs

insertHistStmt :: (MonadSqlQuery m) => CommitR -> [KeyTx] -> m ()
insertHistStmt c ks = do
  ck <- insert c
  mapM_ (insertTx ck) ks

-- insertImport
--   :: (MonadUnliftIO m, MonadSqlQuery m, MonadFinance m)
--   => Statement
--   -> m ()
-- insertImport i = whenHash CTImport i () $ \c -> do
--   -- TODO this isn't efficient, the whole file will be read and maybe no
--   -- transactions will be desired
--   bs <- readImport i
--   bounds <- expandBounds <$> askDBState kmStatementInterval
--   keys <- liftIOExceptT $ mapErrors resolveTx $ filter (inBounds bounds . txDate) bs
--   mapM_ (insertTx c) keys

--------------------------------------------------------------------------------
-- low-level transaction stuff

-- TODO tags here?
txPair
  :: (MonadInsertError m, MonadFinance m)
  => Day
  -> AcntID
  -> AcntID
  -> CurID
  -> Rational
  -> T.Text
  -> m KeyTx
txPair day from to cur val desc = resolveTx tx
  where
    split a v =
      Entry
        { eAcnt = a
        , eValue = v
        , eComment = ""
        , eCurrency = cur
        , eTags = []
        }
    tx =
      Tx
        { txDescr = desc
        , txDate = day
        , txSplits = [split from (-val), split to val]
        }

resolveTx :: (MonadInsertError m, MonadFinance m) => BalTx -> m KeyTx
resolveTx t@Tx {txSplits = ss} =
  fmap (\kss -> t {txSplits = kss}) $
    combineErrors $
      fmap resolveSplit ss

insertTx :: MonadSqlQuery m => CommitRId -> KeyTx -> m ()
insertTx c Tx {txDate = d, txDescr = e, txSplits = ss} = do
  k <- insert $ TransactionR c d e
  mapM_ (insertSplit k) ss