{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Actions where

import qualified Text.XML.Light as X
import qualified Data.Map as Map
import Control.Monad.Error
import Control.Monad.State
import Data.Time.Calendar(addDays)

import LedgerT
import Balances
import Valuation
import HTML

----------------------------------------------------------------------
-- A monad combining IO with some state caching the last read data
-- files, to save reading and parsing them multiple times

data CState = CState {
    cs_last_file :: (FilePath,RawLedger),
    cs_last_price_file :: (FilePath,RawLedger)
}

emptyCIOState = CState ("",rawLedgerEmpty) ("",rawLedgerEmpty)
    
newtype CIO a = CIO { unCIO :: StateT CState IO a }
  deriving (Functor, Monad, MonadIO, MonadState CState)

loadFile0 :: (CState->(FilePath,RawLedger)) ->
             ((FilePath,RawLedger)->CState->CState) -> FilePath -> CIO RawLedger
loadFile0 getf setf fpath = do
    cs <- get
    let (curPath,curData) = getf cs
    if fpath == curPath
      then (return curData)
      else do
        text <- liftIO (readFile fpath)
        er <- liftIO $ parseRawLedger fpath text
        case er of
          Left _ -> error ("Parse Error in " ++ fpath)
          Right rl -> do
              put (setf (fpath,rl) cs)
              return rl

loadFile,loadPriceFile :: FilePath -> CIO RawLedger
loadFile = loadFile0 cs_last_file (\v cs->cs{cs_last_file=v})
loadPriceFile = loadFile0 cs_last_price_file (\v cs->cs{cs_last_price_file=v})

evalCIO action = evalStateT (unCIO action) emptyCIOState
----------------------------------------------------------------------

type EntriesSource = CIO [Entry]
type BalancesSource = CIO Balances
type ValuationEnvSource = [CommoditySymbol] -> CIO ValuationEnv

entriesFromFile :: FilePath -> EntriesSource
entriesFromFile fpath = fmap entries (loadFile fpath)

filterEntries :: (Day->Bool) -> EntriesSource -> EntriesSource
filterEntries dp = fmap (filter (dp.edate))

balancesFromEntries :: Day -> EntriesSource -> BalancesSource
balancesFromEntries t = fmap netEntries . filterEntries (<=t)

filterBalances :: (AccountNameC -> Bool) -> BalancesSource -> BalancesSource
filterBalances ap = fmap (Map.filterWithKey (\aname _ -> ap aname))

valuationEnvFromFile :: FilePath -> CommoditySymbol -> Day -> Int -> ValuationEnvSource
valuationEnvFromFile fp vcur ndays t commods = do
    rl <- loadPriceFile fp
    return (makeValuationEnv vcur commods (withinPrevDays t ndays) rl)
  where
    withinPrevDays n t1 t = (addDays (fromIntegral (-n)) t1) <= t && t <= t1

mkEntriesTable :: EntriesSource -> CIO X.Element
mkEntriesTable es = fmap entriesTable es

mkBalancesTable :: ConvBalanceTableSettings -> ValuationEnvSource -> BalancesSource -> CIO X.Element
mkBalancesTable flags venvS balsS = do
    bals <- balsS
    venv <- venvS (commoditySymbols bals)
    return (convBalanceTable flags venv bals)

mkBalanceChangeTable :: (ValuationEnvSource,BalancesSource)
                     -> (ValuationEnvSource,BalancesSource)
                     -> CIO X.Element
mkBalanceChangeTable (venvS1,balsS1) (venvS2,balsS2) = do
    bals1 <- balsS1
    venv1 <- venvS1 (commoditySymbols bals1)
    bals2 <- balsS2
    venv2 <- venvS2 (commoditySymbols bals2)
    return (balanceChangeTable (venv1,bals1) (venv2,bals2))