{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}

module Tax.Canada.Province.BC.BC428.FieldNames (bc428Fields) where

import Data.Fixed (Centi)
import Rank2 qualified

import Tax.Canada.Province.BC.BC428.Types
import Tax.Canada.Shared (BaseCredit(..), MedicalExpenses(..), TaxIncomeBracket (..), subCalculationFields)
import Tax.FDF (Entry (Count, Constant, Amount, Percent), FieldConst (Field, NoField), within)

bc428Fields :: BC428 FieldConst
bc428Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (forall {a}. FieldConst a -> FieldConst a)
-> BC428 FieldConst -> BC428 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) -> BC428 p -> BC428 q
Rank2.<$> BC428 {
   $sel:page1:BC428 :: Page1 FieldConst
page1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page1" (forall {a}. FieldConst a -> FieldConst a)
-> Page1 FieldConst -> Page1 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) -> Page1 p -> Page1 q
Rank2.<$> Page1 FieldConst
page1Fields,
   $sel:page2:BC428 :: Page2 FieldConst
page2 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page2" (forall {a}. FieldConst a -> FieldConst a)
-> Page2 FieldConst -> Page2 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) -> Page2 p -> Page2 q
Rank2.<$> Page2 FieldConst
page2Fields,
   $sel:page3:BC428 :: Page3 FieldConst
page3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page3" (forall {a}. FieldConst a -> FieldConst a)
-> Page3 FieldConst -> Page3 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) -> Page3 p -> Page3 q
Rank2.<$> Page3 FieldConst
page3Fields}


page1Fields :: Page1 FieldConst
page1Fields = Page1 {
   $sel:partA:Page1 :: Page1PartA FieldConst
partA = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartA" (forall {a}. FieldConst a -> FieldConst a)
-> Page1PartA FieldConst -> Page1PartA 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) -> Page1PartA p -> Page1PartA q
Rank2.<$> Page1PartA FieldConst
page1PartAFields,
   $sel:partB:Page1 :: Page1PartB FieldConst
partB = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartB" (forall {a}. FieldConst a -> FieldConst a)
-> Page1PartB FieldConst -> Page1PartB 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) -> Page1PartB p -> Page1PartB q
Rank2.<$> Page1PartB FieldConst
page1PartBFields}

page1PartAFields :: Page1PartA FieldConst
page1PartAFields = Page1PartA {
   $sel:income:Page1PartA :: FieldConst Centi
income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
   $sel:column1:Page1PartA :: TaxIncomeBracket FieldConst
column1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column1" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket 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) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$>  Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields        Centi
0 Rational
0.0506      Centi
0,
   $sel:column2:Page1PartA :: TaxIncomeBracket FieldConst
column2 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column2" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket 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) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$>  Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields   Centi
45_654 Rational
0.077   Centi
2_310.09,
   $sel:column3:Page1PartA :: TaxIncomeBracket FieldConst
column3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column3" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket 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) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$>  Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields   Centi
91_310 Rational
0.105   Centi
5_825.60,
   $sel:column4:Page1PartA :: TaxIncomeBracket FieldConst
column4 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column4" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket 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) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$>  Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields  Centi
104_835 Rational
0.1229  Centi
7_245.73,
   $sel:column5:Page1PartA :: TaxIncomeBracket FieldConst
column5 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column5" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket 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) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$> (Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields' Centi
127_299 Rational
0.147  Centi
10_006.56){equalsTax = Field ["LIne15", "Amount"] Amount},
   $sel:column6:Page1PartA :: TaxIncomeBracket FieldConst
column6 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column6" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket 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) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$> (Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields' Centi
172_602 Rational
0.168  Centi
16_666.10){rate = Field ["Line12", "Percent_amount"] $ Constant 0.168 Percent},
   $sel:column7:Page1PartA :: TaxIncomeBracket FieldConst
column7 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column7" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket 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) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$>  Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields' Centi
240_716 Rational
0.205  Centi
28_109.25}

taxIncomeBracketFields :: Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields :: Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields Centi
threshold Rational
rate Centi
baseTax = TaxIncomeBracket {
   $sel:income:TaxIncomeBracket :: FieldConst Centi
income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount"] Entry Centi
Amount,
   $sel:threshold:TaxIncomeBracket :: FieldConst Centi
threshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", Text
"Amount_ReadOnly"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
threshold Entry Centi
Amount,
   $sel:overThreshold:TaxIncomeBracket :: FieldConst Centi
overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line4", Text
"Amount"] Entry Centi
Amount,
   $sel:rate:TaxIncomeBracket :: FieldConst Rational
rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5", Text
"Percent_Amount"] (Entry Rational -> FieldConst Rational)
-> Entry Rational -> FieldConst Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Entry Rational -> Entry Rational
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Rational
rate Entry Rational
Percent,
   $sel:timesRate:TaxIncomeBracket :: FieldConst Centi
timesRate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"Amount"] Entry Centi
Amount,
   $sel:baseTax:TaxIncomeBracket :: FieldConst Centi
baseTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount_ReadOnly"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
baseTax Entry Centi
Amount,
   $sel:equalsTax:TaxIncomeBracket :: FieldConst Centi
equalsTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", Text
"Amount"] Entry Centi
Amount}

taxIncomeBracketFields' :: Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields' :: Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields' Centi
threshold Rational
rate Centi
baseTax = TaxIncomeBracket {
   $sel:income:TaxIncomeBracket :: FieldConst Centi
income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount"] Entry Centi
Amount,
   $sel:threshold:TaxIncomeBracket :: FieldConst Centi
threshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", Text
"Amount_ReadOnly"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
threshold Entry Centi
Amount,
   $sel:overThreshold:TaxIncomeBracket :: FieldConst Centi
overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line11", Text
"Amount"] Entry Centi
Amount,
   $sel:rate:TaxIncomeBracket :: FieldConst Rational
rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line12", Text
"Percent_Amount"] (Entry Rational -> FieldConst Rational)
-> Entry Rational -> FieldConst Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Entry Rational -> Entry Rational
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Rational
rate Entry Rational
Percent,
   $sel:timesRate:TaxIncomeBracket :: FieldConst Centi
timesRate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line13", Text
"Amount"] Entry Centi
Amount,
   $sel:baseTax:TaxIncomeBracket :: FieldConst Centi
baseTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line14", Text
"Amount_ReadOnly"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
baseTax Entry Centi
Amount,
   $sel:equalsTax:TaxIncomeBracket :: FieldConst Centi
equalsTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line15", Text
"Amount"] Entry Centi
Amount}

page1PartBFields :: Page1PartB FieldConst
page1PartBFields = Page1PartB {
   $sel:line16_basic:Page1PartB :: FieldConst Centi
line16_basic = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount"] Entry Centi
Amount,
   $sel:line17_age:Page1PartB :: FieldConst Centi
line17_age = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", Text
"Amount"] Entry Centi
Amount,
   $sel:spouseAmount:Page1PartB :: BaseCredit FieldConst
spouseAmount = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Spouse_CPL_Amount" (forall {a}. FieldConst a -> FieldConst a)
-> BaseCredit FieldConst -> BaseCredit 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) -> BaseCredit p -> BaseCredit q
Rank2.<$> BaseCredit{
       $sel:baseAmount:BaseCredit :: FieldConst Centi
baseAmount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
11_285 Entry Centi
Amount,
       $sel:reduction:BaseCredit :: FieldConst Centi
reduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line19", Text
"Amount"] Entry Centi
Amount,
       $sel:difference:BaseCredit :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Amount1"] Entry Centi
Amount,
       $sel:cont:BaseCredit :: FieldConst Centi
cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Amount2"] Entry Centi
Amount},
   $sel:dependantAmount:Page1PartB :: BaseCredit FieldConst
dependantAmount = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Amount_Eligible_Dependant" (forall {a}. FieldConst a -> FieldConst a)
-> BaseCredit FieldConst -> BaseCredit 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) -> BaseCredit p -> BaseCredit q
Rank2.<$> BaseCredit{
       $sel:baseAmount:BaseCredit :: FieldConst Centi
baseAmount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line21", Text
"Amount"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
11_285 Entry Centi
Amount,
       $sel:reduction:BaseCredit :: FieldConst Centi
reduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"Amount"] Entry Centi
Amount,
       $sel:difference:BaseCredit :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount1"] Entry Centi
Amount,
       $sel:cont:BaseCredit :: FieldConst Centi
cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount2"] Entry Centi
Amount},
   $sel:line24_caregiver:Page1PartB :: FieldConst Centi
line24_caregiver = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Amount"] Entry Centi
Amount,
   $sel:line25:Page1PartB :: FieldConst Centi
line25 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line25", Text
"Amount"] Entry Centi
Amount}

page2Fields :: Page2 FieldConst
page2Fields = Page2 {
  $sel:partB:Page2 :: Page2PartB FieldConst
partB = Page2PartB FieldConst
page2PartBFields}

page2PartBFields :: Page2PartB FieldConst
page2PartBFields = Page2PartB {
   $sel:line26:Page2PartB :: FieldConst Centi
line26 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line26", Text
"Amount"] Entry Centi
Amount,
   $sel:line27_cppQpp:Page2PartB :: FieldConst Centi
line27_cppQpp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line27", Text
"Amount"] Entry Centi
Amount,
   $sel:line28_cppQpp:Page2PartB :: FieldConst Centi
line28_cppQpp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line28", Text
"Amount"] Entry Centi
Amount,
   $sel:line29_employmentInsurance:Page2PartB :: FieldConst Centi
line29_employmentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line29", Text
"Amount"] Entry Centi
Amount,
   $sel:line30_employmentInsurance:Page2PartB :: FieldConst Centi
line30_employmentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30", Text
"Amount"] Entry Centi
Amount,
   $sel:line31_firefighters:Page2PartB :: FieldConst Centi
line31_firefighters = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31", Text
"Amount"] Entry Centi
Amount,
   $sel:line32_rescue:Page2PartB :: FieldConst Centi
line32_rescue = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32", Text
"Amount"] Entry Centi
Amount,
   $sel:line33_sum:Page2PartB :: SubCalculation FieldConst
line33_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line33" [Text
"I1", Text
"Amount"] [Text
"I2", Text
"Amount"],
   $sel:line34_adoption:Page2PartB :: FieldConst Centi
line34_adoption = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line34", Text
"Amount"] Entry Centi
Amount,
   $sel:line35:Page2PartB :: FieldConst Centi
line35 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line35", Text
"Amount"] Entry Centi
Amount,
   $sel:line36_pension:Page2PartB :: FieldConst Centi
line36_pension = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36", Text
"Amount"] Entry Centi
Amount,
   $sel:line37:Page2PartB :: FieldConst Centi
line37 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line37", Text
"Amount"] Entry Centi
Amount,
   $sel:line38_disability:Page2PartB :: FieldConst Centi
line38_disability = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38", Text
"Amount"] Entry Centi
Amount,
   $sel:line39:Page2PartB :: FieldConst Centi
line39 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line39", Text
"Amount"] Entry Centi
Amount,
   $sel:line40:Page2PartB :: FieldConst Centi
line40 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40", Text
"Amount"] Entry Centi
Amount,
   $sel:line41_interest:Page2PartB :: FieldConst Centi
line41_interest = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41", Text
"Amount"] Entry Centi
Amount,
   $sel:line42_education:Page2PartB :: FieldConst Centi
line42_education = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42", Text
"Amount"] Entry Centi
Amount,
   $sel:line43_transferredChild:Page2PartB :: FieldConst Centi
line43_transferredChild = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line43", Text
"Amount"] Entry Centi
Amount,
   $sel:line44_transferredSpouse:Page2PartB :: FieldConst Centi
line44_transferredSpouse = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line44", Text
"Amount"] Entry Centi
Amount,
   $sel:line45:Page2PartB :: FieldConst Centi
line45 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line45", Text
"Amount"] Entry Centi
Amount,
   $sel:medicalExpenses:Page2PartB :: MedicalExpenses FieldConst
medicalExpenses = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"MedicalExp" (forall {a}. FieldConst a -> FieldConst a)
-> MedicalExpenses FieldConst -> MedicalExpenses 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) -> MedicalExpenses p -> MedicalExpenses q
Rank2.<$> MedicalExpenses FieldConst
medicalExpensesFields,
   $sel:line52:Page2PartB :: FieldConst Centi
line52 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line52", Text
"Amount"] Entry Centi
Amount,
   $sel:line53_sum:Page2PartB :: SubCalculation FieldConst
line53_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line53" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line54:Page2PartB :: FieldConst Centi
line54 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line54", Text
"Amount"] Entry Centi
Amount,
   $sel:line55_rate:Page2PartB :: FieldConst Rational
line55_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line55", Text
"PercentAmount_ReadOnly"] (Entry Rational -> FieldConst Rational)
-> Entry Rational -> FieldConst Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Entry Rational -> Entry Rational
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Rational
0.0506 Entry Rational
Percent,
   $sel:line56_fraction:Page2PartB :: FieldConst Centi
line56_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line56", Text
"Amount"] Entry Centi
Amount,
   $sel:line57_donations:Page2PartB :: FieldConst Centi
line57_donations = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line57", Text
"Amount"] Entry Centi
Amount,
   $sel:line58:Page2PartB :: FieldConst Centi
line58 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line58", Text
"Amount"] Entry Centi
Amount,
   $sel:line59_food:Page2PartB :: FieldConst Centi
line59_food = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line59", Text
"Gifts_from_57", Text
"Amount"] Entry Centi
Amount,
   $sel:line59_fraction:Page2PartB :: FieldConst Centi
line59_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line59", Text
"Amount"] Entry Centi
Amount,
   $sel:line60:Page2PartB :: FieldConst Centi
line60 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line60", Text
"Amount"] Entry Centi
Amount}

medicalExpensesFields :: MedicalExpenses FieldConst
medicalExpensesFields = MedicalExpenses {
   $sel:expenses:MedicalExpenses :: FieldConst Centi
expenses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line46", Text
"Amount"] Entry Centi
Amount,
   $sel:netIncome:MedicalExpenses :: FieldConst Centi
netIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line47", Text
"Amount"] Entry Centi
Amount,
   $sel:incomeRate:MedicalExpenses :: FieldConst Rational
incomeRate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line48", Text
"PercentAmount_ReadOnly"] (Entry Rational -> FieldConst Rational)
-> Entry Rational -> FieldConst Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Entry Rational -> Entry Rational
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Rational
0.03 Entry Rational
Percent,
   $sel:fraction:MedicalExpenses :: FieldConst Centi
fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line49", Text
"Amount"] Entry Centi
Amount,
   $sel:lesser:MedicalExpenses :: FieldConst Centi
lesser = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line50", Text
"Amount"] Entry Centi
Amount,
   $sel:difference:MedicalExpenses :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line51", Text
"Amount"] Entry Centi
Amount}

partCFields :: PartC FieldConst
partCFields = PartC {
   $sel:line61_tax:PartC :: FieldConst Centi
line61_tax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line61", Text
"Amount"] Entry Centi
Amount,
   $sel:line62_splitIncomeTax:PartC :: FieldConst Centi
line62_splitIncomeTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line62", Text
"Amount"] Entry Centi
Amount,
   $sel:line63:PartC :: FieldConst Centi
line63 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line63", Text
"Amount"] Entry Centi
Amount,
   $sel:line64_copy:PartC :: FieldConst Centi
line64_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line64", Text
"Amount"] Entry Centi
Amount,
   $sel:line65_dividendCredits:PartC :: FieldConst Centi
line65_dividendCredits = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line65", Text
"Amount"] Entry Centi
Amount,
   $sel:line66_copy:PartC :: FieldConst Centi
line66_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Line40427", Text
"Amount"] Entry Centi
Amount,
   $sel:line66_fraction:PartC :: FieldConst Centi
line66_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Amount"] Entry Centi
Amount,
   $sel:line67_sum:PartC :: SubCalculation FieldConst
line67_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line67" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line68:PartC :: FieldConst Centi
line68 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line68", Text
"Amount"] Entry Centi
Amount,
   $sel:line69_copy:PartC :: FieldConst Centi
line69_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line69", Text
"Line120", Text
"Amount"] Entry Centi
Amount,
   $sel:line69_fraction:PartC :: FieldConst Centi
line69_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line69", Text
"Amount"] Entry Centi
Amount,
   $sel:line70:PartC :: FieldConst Centi
line70 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line70", Text
"Amount"] Entry Centi
Amount,
   $sel:line71_foreignCredit:PartC :: FieldConst Centi
line71_foreignCredit = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line71", Text
"Amount"] Entry Centi
Amount,
   $sel:line72:PartC :: FieldConst Centi
line72 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line72", Text
"Amount"] Entry Centi
Amount}

page3Fields :: Page3 FieldConst
page3Fields = Page3 {
   $sel:partC:Page3 :: PartC FieldConst
partC = PartC FieldConst
partCFields,
   $sel:line73_basicReduction:Page3 :: FieldConst Centi
line73_basicReduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line73", Text
"Amount"] Entry Centi
Amount,
   $sel:line74_copy:Page3 :: FieldConst Centi
line74_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line74", Text
"Amount"] Entry Centi
Amount,
   $sel:line75_base:Page3 :: FieldConst Centi
line75_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line75", Text
"Amount_ReadOnly"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
23_179 Entry Centi
Amount,
   $sel:line76_difference:Page3 :: FieldConst Centi
line76_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line76", Text
"Amount"] Entry Centi
Amount,
   $sel:line77_rate:Page3 :: FieldConst Rational
line77_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line77", Text
"PercentAmount_ReadOnly"] (Entry Rational -> FieldConst Rational)
-> Entry Rational -> FieldConst Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Entry Rational -> Entry Rational
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Rational
0.0356 Entry Rational
Percent,
   $sel:line78_fraction:Page3 :: SubCalculation FieldConst
line78_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line78" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line79_difference:Page3 :: SubCalculation FieldConst
line79_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line79" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line80_difference:Page3 :: FieldConst Centi
line80_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line80", Text
"Amount"] Entry Centi
Amount,
   $sel:line81_logging:Page3 :: FieldConst Centi
line81_logging = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line81", Text
"Amount"] Entry Centi
Amount,
   $sel:line82_difference:Page3 :: FieldConst Centi
line82_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line82", Text
"Amount"] Entry Centi
Amount,
   $sel:line83_political:Page3 :: FieldConst Centi
line83_political = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line83", Text
"Amount"] Entry Centi
Amount,
   $sel:line84_political:Page3 :: FieldConst Centi
line84_political = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line84", Text
"Amount"] Entry Centi
Amount,
   $sel:line85_difference:Page3 :: FieldConst Centi
line85_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line85", Text
"Amount"] Entry Centi
Amount,
   $sel:line86_esop20:Page3 :: FieldConst Centi
line86_esop20 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line86", Text
"Amount"] Entry Centi
Amount,
   $sel:line87_evcc30:Page3 :: FieldConst Centi
line87_evcc30 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line87", Text
"Amount"] Entry Centi
Amount,
   $sel:line88_sum:Page3 :: SubCalculation FieldConst
line88_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line88" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line89_difference:Page3 :: FieldConst Centi
line89_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line89", Text
"Amount"] Entry Centi
Amount,
   $sel:line90_mining:Page3 :: FieldConst Centi
line90_mining = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line90", Text
"Amount"] Entry Centi
Amount,
   $sel:line91_tax:Page3 :: FieldConst Centi
line91_tax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line91", Text
"Amount"] Entry Centi
Amount}