{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Common types and functions shared by multiple Canadian tax forms
module Tax.Canada.Shared where

import Control.Monad (guard, mfilter)
import Data.Fixed (Centi)
import Data.Text (Text)
import Language.Haskell.TH qualified as TH
import Rank2.TH qualified
import Transformation.Shallow.TH qualified

import Tax.FDF (FieldConst(Field), Entry(Amount))
import Tax.Util (fixEq, fractionOf, nonNegativeDifference)

data TaxIncomeBracket line = TaxIncomeBracket {
   forall (line :: * -> *). TaxIncomeBracket line -> line Centi
income :: line Centi,
   forall (line :: * -> *). TaxIncomeBracket line -> line Centi
threshold :: line Centi,
   forall (line :: * -> *). TaxIncomeBracket line -> line Centi
overThreshold :: line Centi,
   forall (line :: * -> *). TaxIncomeBracket line -> line Rational
rate :: line Rational,
   forall (line :: * -> *). TaxIncomeBracket line -> line Centi
timesRate :: line Centi,
   forall (line :: * -> *). TaxIncomeBracket line -> line Centi
baseTax :: line Centi,
   forall (line :: * -> *). TaxIncomeBracket line -> line Centi
equalsTax :: line Centi}

data MedicalExpenses line = MedicalExpenses {
   forall (line :: * -> *). MedicalExpenses line -> line Centi
expenses :: line Centi,
   forall (line :: * -> *). MedicalExpenses line -> line Centi
netIncome :: line Centi,
   forall (line :: * -> *). MedicalExpenses line -> line Rational
incomeRate :: line Rational,
   forall (line :: * -> *). MedicalExpenses line -> line Centi
fraction :: line Centi,
   forall (line :: * -> *). MedicalExpenses line -> line Centi
lesser :: line Centi,
   forall (line :: * -> *). MedicalExpenses line -> line Centi
difference :: line Centi}

-- | Used in several provincial forms to calculate a fixed amount of tax credit reduced by income.
data BaseCredit line = BaseCredit {
   forall (line :: * -> *). BaseCredit line -> line Centi
baseAmount :: line Centi,
   forall (line :: * -> *). BaseCredit line -> line Centi
reduction :: line Centi,
   forall (line :: * -> *). BaseCredit line -> line Centi
difference :: line Centi,
   forall (line :: * -> *). BaseCredit line -> line Centi
cont :: line Centi}

-- | A pair of form fields appearing next to each other at the same line, the right field value always a copy of the
-- left one.
data SubCalculation line = SubCalculation {
   forall (line :: * -> *). SubCalculation line -> line Centi
calculation :: line Centi,
   forall (line :: * -> *). SubCalculation line -> line Centi
result :: line Centi}

$(foldMap
   (\t-> concat <$> sequenceA [
       [d|
           deriving instance (Show (line Centi), Show (line Rational))
                          => Show ($(TH.conT t) line)
           deriving instance (Eq (line Centi), Eq (line Rational))
                          => Eq ($(TH.conT t) line)
       |],
       Rank2.TH.deriveAll t,
       Transformation.Shallow.TH.deriveAll t])
   [''BaseCredit, ''MedicalExpenses, ''SubCalculation, ''TaxIncomeBracket])

fixTaxIncomeBracket :: Maybe Centi -> Maybe (TaxIncomeBracket Maybe) -> TaxIncomeBracket Maybe -> TaxIncomeBracket Maybe
fixTaxIncomeBracket :: Maybe Centi
-> Maybe (TaxIncomeBracket Maybe)
-> TaxIncomeBracket Maybe
-> TaxIncomeBracket Maybe
fixTaxIncomeBracket Maybe Centi
theIncome Maybe (TaxIncomeBracket Maybe)
nextBracket = (TaxIncomeBracket Maybe -> TaxIncomeBracket Maybe)
-> TaxIncomeBracket Maybe -> TaxIncomeBracket Maybe
forall a. Eq a => (a -> a) -> a -> a
fixEq ((TaxIncomeBracket Maybe -> TaxIncomeBracket Maybe)
 -> TaxIncomeBracket Maybe -> TaxIncomeBracket Maybe)
-> (TaxIncomeBracket Maybe -> TaxIncomeBracket Maybe)
-> TaxIncomeBracket Maybe
-> TaxIncomeBracket Maybe
forall a b. (a -> b) -> a -> b
$ \bracket :: TaxIncomeBracket Maybe
bracket@TaxIncomeBracket{Maybe Rational
Maybe Centi
$sel:income:TaxIncomeBracket :: forall (line :: * -> *). TaxIncomeBracket line -> line Centi
$sel:threshold:TaxIncomeBracket :: forall (line :: * -> *). TaxIncomeBracket line -> line Centi
$sel:overThreshold:TaxIncomeBracket :: forall (line :: * -> *). TaxIncomeBracket line -> line Centi
$sel:rate:TaxIncomeBracket :: forall (line :: * -> *). TaxIncomeBracket line -> line Rational
$sel:timesRate:TaxIncomeBracket :: forall (line :: * -> *). TaxIncomeBracket line -> line Centi
$sel:baseTax:TaxIncomeBracket :: forall (line :: * -> *). TaxIncomeBracket line -> line Centi
$sel:equalsTax:TaxIncomeBracket :: forall (line :: * -> *). TaxIncomeBracket line -> line Centi
income :: Maybe Centi
threshold :: Maybe Centi
overThreshold :: Maybe Centi
rate :: Maybe Rational
timesRate :: Maybe Centi
baseTax :: Maybe Centi
equalsTax :: Maybe Centi
..} -> TaxIncomeBracket Maybe
bracket{
   income = do i <- theIncome
               floor <- threshold
               let ceiling = Maybe (TaxIncomeBracket Maybe)
nextBracket Maybe (TaxIncomeBracket Maybe)
-> (TaxIncomeBracket Maybe -> Maybe Centi) -> Maybe Centi
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (.threshold)
               guard (floor <= i && all (i <) ceiling)
               Just i,
   overThreshold = liftA2 (-) income threshold,
   timesRate = fromRational <$> liftA2 (*) (toRational <$> overThreshold) rate,
   equalsTax = liftA2 (+) timesRate baseTax}

fixBaseCredit :: BaseCredit Maybe -> BaseCredit Maybe
fixBaseCredit :: BaseCredit Maybe -> BaseCredit Maybe
fixBaseCredit = (BaseCredit Maybe -> BaseCredit Maybe)
-> BaseCredit Maybe -> BaseCredit Maybe
forall a. Eq a => (a -> a) -> a -> a
fixEq ((BaseCredit Maybe -> BaseCredit Maybe)
 -> BaseCredit Maybe -> BaseCredit Maybe)
-> (BaseCredit Maybe -> BaseCredit Maybe)
-> BaseCredit Maybe
-> BaseCredit Maybe
forall a b. (a -> b) -> a -> b
$ \credit :: BaseCredit Maybe
credit@BaseCredit{Maybe Centi
$sel:baseAmount:BaseCredit :: forall (line :: * -> *). BaseCredit line -> line Centi
$sel:reduction:BaseCredit :: forall (line :: * -> *). BaseCredit line -> line Centi
$sel:difference:BaseCredit :: forall (line :: * -> *). BaseCredit line -> line Centi
$sel:cont:BaseCredit :: forall (line :: * -> *). BaseCredit line -> line Centi
baseAmount :: Maybe Centi
reduction :: Maybe Centi
difference :: Maybe Centi
cont :: Maybe Centi
..}-> BaseCredit Maybe
credit{
   difference = mfilter (> 0) $ liftA2 (-) baseAmount reduction,
   cont = difference}

fixMedicalExpenses :: Centi -> MedicalExpenses Maybe -> MedicalExpenses Maybe
fixMedicalExpenses :: Centi -> MedicalExpenses Maybe -> MedicalExpenses Maybe
fixMedicalExpenses Centi
ceiling = (MedicalExpenses Maybe -> MedicalExpenses Maybe)
-> MedicalExpenses Maybe -> MedicalExpenses Maybe
forall a. Eq a => (a -> a) -> a -> a
fixEq ((MedicalExpenses Maybe -> MedicalExpenses Maybe)
 -> MedicalExpenses Maybe -> MedicalExpenses Maybe)
-> (MedicalExpenses Maybe -> MedicalExpenses Maybe)
-> MedicalExpenses Maybe
-> MedicalExpenses Maybe
forall a b. (a -> b) -> a -> b
$ \part :: MedicalExpenses Maybe
part@MedicalExpenses{Maybe Rational
Maybe Centi
$sel:expenses:MedicalExpenses :: forall (line :: * -> *). MedicalExpenses line -> line Centi
$sel:netIncome:MedicalExpenses :: forall (line :: * -> *). MedicalExpenses line -> line Centi
$sel:incomeRate:MedicalExpenses :: forall (line :: * -> *). MedicalExpenses line -> line Rational
$sel:fraction:MedicalExpenses :: forall (line :: * -> *). MedicalExpenses line -> line Centi
$sel:lesser:MedicalExpenses :: forall (line :: * -> *). MedicalExpenses line -> line Centi
$sel:difference:MedicalExpenses :: forall (line :: * -> *). MedicalExpenses line -> line Centi
expenses :: Maybe Centi
netIncome :: Maybe Centi
incomeRate :: Maybe Rational
fraction :: Maybe Centi
lesser :: Maybe Centi
difference :: Maybe Centi
..} -> MedicalExpenses Maybe
part{
   fraction = incomeRate `fractionOf` netIncome,
   lesser = min ceiling <$> fraction,
   difference = nonNegativeDifference expenses lesser}

fixSubCalculation :: Maybe Centi -> SubCalculation Maybe
fixSubCalculation :: Maybe Centi -> SubCalculation Maybe
fixSubCalculation Maybe Centi
result = SubCalculation{
   $sel:calculation:SubCalculation :: Maybe Centi
calculation = Maybe Centi
result,
   $sel:result:SubCalculation :: Maybe Centi
result = Maybe Centi
result}

subCalculationFields :: Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields :: Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
parent [Text]
calculationPath [Text]
resultPath = SubCalculation{
   $sel:calculation:SubCalculation :: FieldConst Centi
calculation = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field (Text
parent Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
calculationPath) Entry Centi
Amount,
   $sel:result:SubCalculation :: FieldConst Centi
result = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field (Text
parent Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
resultPath) Entry Centi
Amount}