{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

module Tax.Canada.Province.AB (AB428, ab428Fields, fixAB428, fixReturns, returnFields, t1Fields) where

import Data.CAProvinceCodes (Code(AB))
import qualified Rank2

import Tax.Canada.Federal qualified as Federal
import Tax.Canada.Federal (Forms(t1), fixFederalForms)
import Tax.Canada.Federal.Schedule9 qualified as Schedule9
import Tax.Canada.T1.Types (T1 (T1, page7, page8), Page7(Page7, step6_RefundOrBalanceOwing), Page8(Page8))
import Tax.Canada.T1.Types qualified as T1
import Tax.Canada.T1.Types qualified as Page8 (Page8(..))
import Tax.Canada.T1.FieldNames.AB (t1Fields)

import Tax.Canada.Province.AB.AB428.Types qualified as AB
import Tax.Canada.Province.AB.AB428.Types qualified as AB.Page1 (Page1(..))
import Tax.Canada.Province.AB.AB428.Types qualified as AB.Page2 (Page2(..))
import Tax.Canada.Province.AB.AB428.Types (AB428 (AB428))
import Tax.Canada.Province.AB.AB428.Fix (fixAB428)
import Tax.Canada.Province.AB.AB428.FieldNames (ab428Fields)

import Tax.Canada.Shared(MedicalExpenses(..), BaseCredit(..))
import Tax.FDF (FieldConst, within)
import Tax.Util (fixEq)

import Data.Functor.Product (Product(Pair))

type Returns = Product Federal.Forms AB428

fixReturns :: Returns Maybe -> Returns Maybe
fixReturns :: Returns Maybe -> Returns Maybe
fixReturns =
  (Returns Maybe -> Returns Maybe) -> Returns Maybe -> Returns Maybe
forall a. Eq a => (a -> a) -> a -> a
fixEq ((Returns Maybe -> Returns Maybe)
 -> Returns Maybe -> Returns Maybe)
-> (Returns Maybe -> Returns Maybe)
-> Returns Maybe
-> Returns Maybe
forall a b. (a -> b) -> a -> b
$ \(Pair
            ff :: Forms Maybe
ff@Federal.Forms{$sel:t1:Forms :: forall (line :: * -> *). Forms line -> T1 line
t1 = t1 :: T1 Maybe
t1@T1{$sel:page7:T1 :: forall (line :: * -> *). T1 line -> Page7 line
page7 = page7 :: Page7 Maybe
page7@Page7{Page7Step6 Maybe
$sel:step6_RefundOrBalanceOwing:Page7 :: forall (line :: * -> *). Page7 line -> Page7Step6 line
step6_RefundOrBalanceOwing :: Page7Step6 Maybe
step6_RefundOrBalanceOwing},
                                        $sel:page8:T1 :: forall (line :: * -> *). T1 line -> Page8 line
page8 = page8 :: Page8 Maybe
page8@Page8{$sel:step6_RefundOrBalanceOwing:Page8 :: forall (line :: * -> *). Page8 line -> Page8Step6 line
step6_RefundOrBalanceOwing = Page8Step6 Maybe
page8step6}},
                             Schedule9 Maybe
schedule9 :: Schedule9 Maybe
$sel:schedule9:Forms :: forall (line :: * -> *). Forms line -> Schedule9 line
schedule9}
            ab428 :: AB428 Maybe
ab428@AB428{$sel:page1:AB428 :: forall (line :: * -> *). AB428 line -> Page1 line
page1 = page1 :: Page1 Maybe
page1@AB.Page1{Page1PartA Maybe
partA :: Page1PartA Maybe
$sel:partA:Page1 :: forall (line :: * -> *). Page1 line -> Page1PartA line
partA, $sel:partB:Page1 :: forall (line :: * -> *). Page1 line -> Page1PartB line
partB = partB1 :: Page1PartB Maybe
partB1@AB.Page1PartB{BaseCredit Maybe
spouseAmount :: BaseCredit Maybe
$sel:spouseAmount:Page1PartB :: forall (line :: * -> *). Page1PartB line -> BaseCredit line
spouseAmount}},
                        $sel:page2:AB428 :: forall (line :: * -> *). AB428 line -> Page2 line
page2 = page2 :: Page2 Maybe
page2@AB.Page2{$sel:partB:Page2 :: forall (line :: * -> *). Page2 line -> Page2PartB line
AB.partB = partB2 :: Page2PartB Maybe
partB2@AB.Page2PartB{MedicalExpenses Maybe
medicalExpenses :: MedicalExpenses Maybe
$sel:medicalExpenses:Page2PartB :: forall (line :: * -> *). Page2PartB line -> MedicalExpenses line
AB.medicalExpenses}},
                        $sel:page3:AB428 :: forall (line :: * -> *). AB428 line -> Page3 line
page3 = page3 :: Page3 Maybe
page3@AB.Page3{PartC Maybe
partC :: PartC Maybe
$sel:partC:Page3 :: forall (line :: * -> *). Page3 line -> PartC line
AB.partC}})
          -> (Forms Maybe -> Forms Maybe
fixFederalForms Forms Maybe
ff{t1 = t1{page7 =
                                         page7{step6_RefundOrBalanceOwing =
                                               step6_RefundOrBalanceOwing{T1.line_42800_ProvTerrTax =
                                                                          ab428.page3.partC.line66_tax}},
                                         page8 =
                                         page8{Page8.step6_RefundOrBalanceOwing =
                                               page8step6{T1.line_47900_ProvTerrCredits =
                                                          ab428.page3.partD.line69_credits}}}}
              Forms Maybe -> AB428 Maybe -> Returns Maybe
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
`Pair`
              AB428 Maybe -> AB428 Maybe
fixAB428 AB428 Maybe
ab428{AB.page1 =
                             page1{AB.Page1.income = t1.page5.step4_TaxableIncome.line_26000_TaxableIncome,
                                   AB.Page1.partB = partB1{AB.spouseAmount = spouseAmount{reduction = t1.page1.spouse.line23600},
                                                           AB.line19_cppQpp = t1.page6.line30800,
                                                           AB.line20_cppQpp = t1.page6.line31000,
                                                           AB.line21_employmentInsurance = t1.page6.line31200,
                                                           AB.line22_employmentInsurance = t1.page6.line31217}},
                             AB.page2 =
                             page2{AB.Page2.partB = partB2{AB.line33_interest = t1.page6.line31900,
                                                           AB.medicalExpenses =
                                                           medicalExpenses{
                                                              expenses = t1.page6.medical_expenses.familyExpenses,
                                                              netIncome = t1.page4.line_23600_NetIncome},
                                                                AB.donations = partB2.donations{
                                                                   AB.line48_base = schedule9.line13_min,
                                                                   AB.line49_base = schedule9.line14_difference}}},
                             AB.page3 =
                             page3{AB.partC = partC{AB.line57_copy = t1.page7.partC_NetFederalTax.line40427}}})

returnFields :: Returns FieldConst
returnFields :: Returns FieldConst
returnFields = Forms FieldConst -> AB428 FieldConst -> Returns FieldConst
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (Code -> Forms FieldConst
Federal.formFieldsForProvince Code
AB) (Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"428" (forall {a}. FieldConst a -> FieldConst a)
-> AB428 FieldConst -> AB428 FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> AB428 p -> AB428 q
Rank2.<$> AB428 FieldConst
ab428Fields)