---------------------------------------------------------
--
-- Module        : FinancingType
-- Copyright     : Bartosz Wójcik (2010)
-- License       : All rights reserved
--
-- Maintainer    : bartek@sudety.it
-- Stability     : Unstable
-- Portability   : portable
--
-- Financing types.
---------------------------------------------------------

module FinancingType
where

import Text.PrettyShow (showWithLen
                       ,showAmtWithLen
                       )
import BasicType 
import InstalmentPlan
import InstalmentPlanProps (  instalmentPlanLineCheckM
                             ,initIPL
                           )                             
import CalcCalendar (Day
                    ,CalendarType (..)
                    )
import ErrorHandling
import Parameters


-- | Details of tranche. There can be any number of tranches per loan.
--   Each tranche can be financed any time. 
data Tranche = Tr { trAmount  :: Amount   -- ^ Amount of this tranche
                  , trNbrDays :: Int      -- ^ Nbr of days between tranche date and next interest maturity date
                  , trInt     :: Amount   -- ^ Interest adjustment generated by this tranche. Can be negative.
                                          --   Interest of grace period - one between date of tranche
                                          --   and next interest maturity date - is caluclated separately, depending
                                          --   on 'FstIntRule'.
                  , trRate    :: Rate     -- ^ interest rate for adjustment purposes
                  , trIntAdv  :: Amount   -- ^ Advanced interest introduced with this tranche. This is a way to transfer
                                          --   interest payment to earlier period of a loan.
                  }
                 deriving (Eq,Ord)

instance Show Tranche where
         show (Tr a nd i _ iA)
            | iA == 0     =   "       " ++
                              showAmtWithLen 10 a ++ " " ++
                              showAmtWithLen 8 i ++
                              "   (" ++ showWithLen 4 nd ++ ")"
            | otherwise   =   "       " ++
                              showAmtWithLen 10 a ++ " " ++
                              showAmtWithLen 8 i ++ " " ++
                              showAmtWithLen 8 iA

newTr r c = Tr c 0 0 r 0
newTrIA a = Tr 0 0 0 0 a

-- | Financing is a data type which describes loan situation after all tranches
--   of financing were given to customer.
data Financed = Fin { finParams        :: FinancingParameters
                    , fin1stInstDay    :: Int            -- ^ Number of day in the freq period when
                                                         --   instalment matures. Ignored when freq==Daily.
                    , finInstPlan      :: FullPlan       -- ^ Instalment plan after financing
                    }
                 deriving (Eq)
                 
-- | Interest has to be adjusted when financial event happens not on interest maturity day.
--   In such case adjustment will be assigned to particular date. On this date given amount
--   will adjust late interest.
type IntAdjustment = (Day,Amount)                 
                 
-- | Element of loan full instalment plan.
--   Consists of following constructors:
--   * @INT@ - represents matured interst. Interest may be due or not.
--   * @TPL@ - represents tranche
--   * @APL@ - represents due interest adjustment.
data FullPlanLine = INT { intIntAdj   :: Maybe IntAdjustment
                        , intIPL      :: InstalmentPlanLine
                        }
                  | TPL { tplTranche  :: Tranche
                        , tplCapital  :: Amount                -- ^ Capital after
                        , tplIntLate  :: Interest              -- ^ Sum not paid late interest after current instalment
                        , tplIntAdj   :: Maybe IntAdjustment   -- ^ Adjustment of interest
                        }
                  | APL { aplCapital :: Amount                 -- ^ Capital after
                        , aplIntLate :: Interest               -- ^ Sum not paid late interest after
                        , aplAdjust  :: Amount                 -- ^ Amount of adjustment (= additional instalment)
                        }
                 deriving (Eq,Ord)

instance Show FullPlanLine where
         show (TPL t c iL iA) = "[" ++ show t ++ "] "
                              ++ showAmtWithLen 8 c ++ " "
                              ++ showAmtWithLen 8 ((round iL)::Int) ++ " "
                              ++ "(" ++ showIA iA ++ ")"
            where showIA Nothing = "No adjustment"
                  showIA (Just (iAD,iAA)) = show iAD ++ ":"
                                          ++ showAmtWithLen 8 iAA
         show (INT _ ipl)    = show ipl
         show (APL _ _ iAA)  = ' ' : showAmtWithLen 8 iAA ++ " Interest adjustment due"

isINT (INT _ _) = True
isINT _         = False

-- | Control function with diagnostic for humans.
fullPlanLineCheckM :: FullPlanLine
                   -> FullPlanLine
                   -> ValidMonad FullPlanLine
fullPlanLineCheckM (INT (Just (iAD,iAA1)) ipl) apl@(APL cap iL iAA2)
   | iplPrincipal ipl /= cap = throwError $ SimplerFollowUpError "Capital after interest adjustment /= expected"
                                                               cap (iplPrincipal ipl)
   | iplIntLate ipl /= iL = throwError $ SimplerFollowUpError "Late interest after interest adjustment /= expected"
                                                              (round iL) (round $ iplIntLate ipl)
   | iAA1 /= iAA2 = throwError $ SimplerFollowUpError "Interest adjustment /= expected"
                                                      iAA2 iAA1
   | otherwise    = return apl

fullPlanLineCheckM (INT Nothing ipl) (APL cap iL iAA) = throwError $ OtherError "Not traceable instalment adjustment"
fullPlanLineCheckM tr@(TPL _ _ _ _) a@(APL _ _ _) = throwError $ OtherError $ "Interest adjustment" ++
                                                          show a ++ " after tranche " ++
                                                          show tr ++ " without instalment between two"
fullPlanLineCheckM a1@(APL _ _ _) a2@(APL _ _ _) = throwError $ OtherError $ "2 consecutive interest adjustments" ++
                                                          show a1 ++ show a2
fullPlanLineCheckM fpl (INT mIA ipl) = INT mIA `liftM` instalmentPlanLineCheckM 
                                                       (initIPL
                                                            (fplCapitalAfter fpl) 
                                                            (fplLateInterestAfter fpl))
                                                       ipl
fullPlanLineCheckM fpl tpl@(TPL tr cap iL mIA) = 
   checkLateInterestM >> checkCapitalAfterM >> checkIntAdjustment
   where checkLateInterestM | lateIntBefore == iL = return tpl
                            | otherwise           = throwError $ FollowUpError "FPL tranche discrepancy :\
                                                               \ late interest before  /= late interest after "
                                                                 (round iL) 0 (round lateIntBefore)
         checkCapitalAfterM | capBefore + trAmount tr == cap = return tpl
                            | otherwise                      = throwError $ FollowUpError
                                                                           "FPL capital_after discrepancy:\
                                                       \ capital before + tranche amount /= capital after "
                                                                           cap (trAmount tr) capBefore
         checkIntAdjustment | fplIntAdjAfterAmt fpl + trInt tr == fplIntAdjAfterAmt tpl = return tpl
                            | otherwise                                                 = throwError $ FollowUpError
                                                                     "Interest adjustment mismatch:"
                                                                     (fplIntAdjAfterAmt fpl)
                                                                     (trInt tr)
                                                                     (fplIntAdjAfterAmt tpl)
         capBefore = fplCapitalAfter fpl
         lateIntBefore = fplLateInterestAfter fpl
--         trIL = trIntLate tr

type FullPlanDay = (Day,FullPlanLine)

-- | Convenience functions.
fpdCapitalAfter (_,fpl) = fplCapitalAfter fpl

fplCapitalAfter (INT _ ipl) = iplPrincipal ipl
fplCapitalAfter (TPL _ cap _ _) = cap
fplCapitalAfter (APL cap _ _) = cap

fpdLateInterestAfter (_,fpl) = fplLateInterestAfter fpl

fplLateInterestAfter (INT _ ipl) = iplIntLate ipl
fplLateInterestAfter (TPL _ _ iL _) = iL
fplLateInterestAfter (APL _ iL _) = iL

fpdIntAdjAfterAmt (_,fpl) = fplIntAdjAfterAmt fpl

fplIntAdjAfterAmt (INT Nothing _) = 0
fplIntAdjAfterAmt (INT (Just (iAD,iAA)) _) = iAA
fplIntAdjAfterAmt (TPL _ _ _ Nothing) = 0
fplIntAdjAfterAmt (TPL _ _ _ (Just (iAD,iAA))) = iAA
fplIntAdjAfterAmt (APL _ _ _) = 0

fpdIntAdjAfter (_,INT mIA _) = mIA
fpdIntAdjAfter (_,TPL _ _ _ mIA) = mIA
fpdIntAdjAfter (_,APL _ _ _) = Nothing

fpdAdvInterestAfter (_,fpl) = fplAdvInterestAfter fpl

fplAdvInterestAfter (TPL tr _ _ _) = trIntAdv tr
fplAdvInterestAfter _ = 0



-- | In case two events happen the same day, there are following rules to follow:
--   * TPL record is to be placed _after_ INT record.
--   * Must not be 2 records of the same constructor on the same day.
type FullPlan = [FullPlanDay]

-- | Control function with diagnostic for humans.
fullPlanCheckM :: FullPlan -> ValidMonad () --Either FinancingError ()
fullPlanCheckM fp = (\_ -> ()) `liftM` foldM check (APL 0 0 0) fp
    where check :: FullPlanLine -> FullPlanDay -> ValidMonad FullPlanLine --Either FinancingError FullPlanLine
          check fpl1 (d2,fpl2) = fullPlanLineCheckM fpl1 fpl2 `catchError` liftDate d2
--    where check :: FullPlanLine -> FullPlanDay -> ValidMonad FullPlanLine
--          check fpl1 (d2,fpl2) = errDate d2 $ fullPlanLineCheckM fpl1 fpl2


