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

module Tax.Canada.ON428.FieldNames (on428Fields) where

import Data.Fixed (Centi)
import Rank2 qualified

import Tax.Canada.ON428.Types
import Tax.FDF (Entry (Count, Amount, Percent), FieldConst (Field), within)

on428Fields :: ON428 FieldConst
on428Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (forall {a}. FieldConst a -> FieldConst a)
-> ON428 FieldConst -> ON428 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) -> ON428 p -> ON428 q
Rank2.<$> ON428 {
   $sel:page1:ON428 :: 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:ON428 :: 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:ON428 :: 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,
   $sel:page4:ON428 :: Page4 FieldConst
page4 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page4" (forall {a}. FieldConst a -> FieldConst a)
-> Page4 FieldConst -> Page4 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) -> Page4 p -> Page4 q
Rank2.<$> Page4 FieldConst
page4Fields}


page1Fields :: Page1 FieldConst
page1Fields = Page1 {
   $sel:line1:Page1 :: FieldConst Centi
line1 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
   $sel:partA:Page1 :: Page1PartA FieldConst
partA = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Chart" (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
"Part_B" (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: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.<$> TaxIncomeBracket FieldConst
taxIncomeBracketFields,
   $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.<$> TaxIncomeBracket FieldConst
taxIncomeBracketFields,
   $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.<$> TaxIncomeBracket FieldConst
taxIncomeBracketFields,
   $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.<$> TaxIncomeBracket FieldConst
taxIncomeBracketFields,
   $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.<$> TaxIncomeBracket FieldConst
taxIncomeBracketFields}

taxIncomeBracketFields :: TaxIncomeBracket FieldConst
taxIncomeBracketFields = TaxIncomeBracket {
   $sel:line2_income:TaxIncomeBracket :: FieldConst Centi
line2_income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount"] Entry Centi
Amount,
   $sel:line3_threshold:TaxIncomeBracket :: FieldConst Centi
line3_threshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", Text
"Amount"] Entry Centi
Amount,
   $sel:line4_overThreshold:TaxIncomeBracket :: FieldConst Centi
line4_overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line4", Text
"Amount"] Entry Centi
Amount,
   $sel:line5_rate:TaxIncomeBracket :: FieldConst Rational
line5_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5", Text
"Percent"] Entry Rational
Percent,
   $sel:line6_timesRate:TaxIncomeBracket :: FieldConst Centi
line6_timesRate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"Amount"] Entry Centi
Amount,
   $sel:line7_baseTax:TaxIncomeBracket :: FieldConst Centi
line7_baseTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount"] Entry Centi
Amount,
   $sel:line8_equalsTax:TaxIncomeBracket :: FieldConst Centi
line8_equalsTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", Text
"Amount"] Entry Centi
Amount}

page1PartBFields :: Page1PartB FieldConst
page1PartBFields = Page1PartB {
   $sel:line9_basic:Page1PartB :: FieldConst Centi
line9_basic = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount"] Entry Centi
Amount,
   $sel:line10_age:Page1PartB :: FieldConst Centi
line10_age = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", Text
"Amount"] Entry Centi
Amount,
   $sel:line11_base:Page1PartB :: FieldConst Centi
line11_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Spouse-Amount", Text
"Line11", Text
"Amount"] Entry Centi
Amount,
   $sel:line12_spouseIncome:Page1PartB :: FieldConst Centi
line12_spouseIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Spouse-Amount", Text
"Line12", Text
"Amount"] Entry Centi
Amount,
   $sel:line13_difference:Page1PartB :: FieldConst Centi
line13_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Spouse-Amount", Text
"Line13", Text
"Amount1"] Entry Centi
Amount,
   $sel:line13_cont:Page1PartB :: FieldConst Centi
line13_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Spouse-Amount", Text
"Line13", Text
"Amount2"] Entry Centi
Amount,
   $sel:line14_base:Page1PartB :: FieldConst Centi
line14_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Eligible-Dependant", Text
"Line14", Text
"Amount"] Entry Centi
Amount,
   $sel:line15_dependentIncome:Page1PartB :: FieldConst Centi
line15_dependentIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Eligible-Dependant", Text
"Line15", Text
"Amount"] Entry Centi
Amount,
   $sel:line16_difference:Page1PartB :: FieldConst Centi
line16_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Eligible-Dependant", Text
"Line16", Text
"Amount1"] Entry Centi
Amount,
   $sel:line16_cont:Page1PartB :: FieldConst Centi
line16_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Eligible-Dependant", Text
"Line16", Text
"Amount2"] Entry Centi
Amount,
   $sel:line17_caregiver:Page1PartB :: FieldConst Centi
line17_caregiver = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", Text
"Amount"] Entry Centi
Amount,
   $sel:line18:Page1PartB :: FieldConst Centi
line18 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount"] Entry Centi
Amount,
   $sel:line19_cppQpp:Page1PartB :: FieldConst Centi
line19_cppQpp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"CPP-QPP", Text
"Line19", Text
"Amount"] Entry Centi
Amount,
   $sel:line20_cppQpp:Page1PartB :: FieldConst Centi
line20_cppQpp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"CPP-QPP", Text
"Line20", Text
"Amount"] Entry Centi
Amount,
   $sel:line21_employmentInsurance:Page1PartB :: FieldConst Centi
line21_employmentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Employment-Insurance", Text
"Line21", Text
"Amount"] Entry Centi
Amount,
   $sel:line22_employmentInsurance:Page1PartB :: FieldConst Centi
line22_employmentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Employment-Insurance", Text
"Line22", Text
"Amount"] Entry Centi
Amount,
   $sel:line23_adoption:Page1PartB :: FieldConst Centi
line23_adoption = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount"] Entry Centi
Amount,
   $sel:line24_sum:Page1PartB :: FieldConst Centi
line24_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Amount1"] Entry Centi
Amount,
   $sel:line24_cont:Page1PartB :: FieldConst Centi
line24_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Amount2"] 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,
  $sel:partC:Page2 :: Page2PartC FieldConst
partC = Page2PartC FieldConst
page2PartCFields}

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_pension:Page2PartB :: FieldConst Centi
line27_pension = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line27", Text
"Amount"] Entry Centi
Amount,
   $sel:line28:Page2PartB :: FieldConst Centi
line28 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line28", Text
"Amount"] Entry Centi
Amount,
   $sel:line29_disability:Page2PartB :: FieldConst Centi
line29_disability = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line29", Text
"Amount"] Entry Centi
Amount,
   $sel:line30:Page2PartB :: FieldConst Centi
line30 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30", Text
"Amount"] Entry Centi
Amount,
   $sel:line31:Page2PartB :: FieldConst Centi
line31 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31", Text
"Amount"] Entry Centi
Amount,
   $sel:line32_interest:Page2PartB :: FieldConst Centi
line32_interest = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32", Text
"Amount"] Entry Centi
Amount,
   $sel:line33_education:Page2PartB :: FieldConst Centi
line33_education = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33", Text
"Amount"] Entry Centi
Amount,
   $sel:line34_transferred:Page2PartB :: FieldConst Centi
line34_transferred = [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:medicalExpenses:Page2PartB :: MedicalExpenses FieldConst
medicalExpenses = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Medical-Expenses" (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:line42:Page2PartB :: FieldConst Centi
line42 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42", Text
"Amount"] Entry Centi
Amount,
   $sel:line43_sum:Page2PartB :: FieldConst Centi
line43_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line43", Text
"Amount1"] Entry Centi
Amount,
   $sel:line43_cont:Page2PartB :: FieldConst Centi
line43_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line43", Text
"Amount2"] Entry Centi
Amount,
   $sel:line44:Page2PartB :: FieldConst Centi
line44 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line44", Text
"Amount"] Entry Centi
Amount,
   $sel:line45_rate:Page2PartB :: FieldConst Rational
line45_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line45", Text
"Percent_ReadOnly"] Entry Rational
Percent,
   $sel:line46_fraction:Page2PartB :: FieldConst Centi
line46_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line46", Text
"Amount"] Entry Centi
Amount,
   $sel:donations:Page2PartB :: Donations FieldConst
donations = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Donations" (forall {a}. FieldConst a -> FieldConst a)
-> Donations FieldConst -> Donations 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) -> Donations p -> Donations q
Rank2.<$> Donations FieldConst
donationsFields,
   $sel:line50:Page2PartB :: FieldConst Centi
line50 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line50", Text
"Amount"] Entry Centi
Amount}

medicalExpensesFields :: MedicalExpenses FieldConst
medicalExpensesFields = MedicalExpenses {
   $sel:line36_expenses:MedicalExpenses :: FieldConst Centi
line36_expenses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36", Text
"Amount"] Entry Centi
Amount,
   $sel:line37_income:MedicalExpenses :: FieldConst Centi
line37_income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line37", Text
"Amount"] Entry Centi
Amount,
   $sel:line38_rate:MedicalExpenses :: FieldConst Rational
line38_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38", Text
"Percent_ReadOnly"] Entry Rational
Percent,
   $sel:line39_fraction:MedicalExpenses :: FieldConst Centi
line39_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line39", Text
"Amount"] Entry Centi
Amount,
   $sel:line40_lesser:MedicalExpenses :: FieldConst Centi
line40_lesser = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40", Text
"Amount"] Entry Centi
Amount,
   $sel:line41_difference:MedicalExpenses :: FieldConst Centi
line41_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41", Text
"Amount"] Entry Centi
Amount}

donationsFields :: Donations FieldConst
donationsFields = Donations {
   $sel:line47_base:Donations :: FieldConst Centi
line47_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line47", Text
"Amount1"] Entry Centi
Amount,
   $sel:line47_fraction:Donations :: FieldConst Centi
line47_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line47", Text
"Amount2"] Entry Centi
Amount,
   $sel:line48_base:Donations :: FieldConst Centi
line48_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line48", Text
"Amount1"] Entry Centi
Amount,
   $sel:line48_fraction:Donations :: FieldConst Centi
line48_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line48", Text
"Amount2"] Entry Centi
Amount,
   $sel:line49_sum:Donations :: FieldConst Centi
line49_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line49", Text
"Amount1"] Entry Centi
Amount,
   $sel:line49_cont:Donations :: FieldConst Centi
line49_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line49", Text
"Amount2"] Entry Centi
Amount}

page2PartCFields :: Page2PartC FieldConst
page2PartCFields = Page2PartC {
   $sel:line51_tax:Page2PartC :: FieldConst Centi
line51_tax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line51", Text
"Amount"] Entry Centi
Amount,
   $sel:line52_credits:Page2PartC :: FieldConst Centi
line52_credits = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line52", Text
"Amount"] Entry Centi
Amount,
   $sel:line53:Page2PartC :: FieldConst Centi
line53 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line53", Text
"Amount"] Entry Centi
Amount,
   $sel:line54:Page2PartC :: 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:Page2PartC :: FieldConst Centi
line55 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line55", Text
"Amount"] Entry Centi
Amount,
   $sel:line56:Page2PartC :: FieldConst Centi
line56 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line56", Text
"Amount"] Entry Centi
Amount,
   $sel:line57:Page2PartC :: FieldConst Centi
line57 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line57", Text
"Amount"] Entry Centi
Amount,
   $sel:line58:Page2PartC :: FieldConst Centi
line58 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line58", Text
"Amount"] Entry Centi
Amount,
   $sel:line59_copy:Page2PartC :: FieldConst Centi
line59_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line59", Text
"Amount1"] Entry Centi
Amount,
   $sel:line59_product:Page2PartC :: FieldConst Centi
line59_product = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line59", Text
"Amount2"] Entry Centi
Amount,
   $sel:line60_lesser:Page2PartC :: FieldConst Centi
line60_lesser = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line60", Text
"Amount"] Entry Centi
Amount,
   $sel:line61:Page2PartC :: FieldConst Centi
line61 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line61", Text
"Amount"] Entry Centi
Amount}

page3Fields :: Page3 FieldConst
page3Fields = Page3 {
   $sel:line62:Page3 :: FieldConst Centi
line62 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line62", Text
"Amount"] Entry Centi
Amount,
   $sel:line63:Page3 :: FieldConst Centi
line63 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON-Surtax", Text
"Line63", Text
"Amount"] Entry Centi
Amount,
   $sel:line64:Page3 :: FieldConst Centi
line64 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON-Surtax", Text
"Line64", Text
"Amount"] Entry Centi
Amount,
   $sel:line65:Page3 :: FieldConst Centi
line65 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON-Surtax", Text
"Line65", Text
"Amount"] Entry Centi
Amount,
   $sel:line66_copy:Page3 :: FieldConst Centi
line66_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Amount1"] Entry Centi
Amount,
   $sel:line66_surtax:Page3 :: FieldConst Centi
line66_surtax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Amount2"] Entry Centi
Amount,
   $sel:line67_copy:Page3 :: FieldConst Centi
line67_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line67", Text
"Amount1"] Entry Centi
Amount,
   $sel:line67_surtax:Page3 :: FieldConst Centi
line67_surtax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line67", Text
"Amount2"] Entry Centi
Amount,
   $sel:line68_sum:Page3 :: FieldConst Centi
line68_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line68", Text
"Amount1"] Entry Centi
Amount,
   $sel:line68_cont:Page3 :: FieldConst Centi
line68_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line68", Text
"Amount2"] Entry Centi
Amount,
   $sel:line69:Page3 :: FieldConst Centi
line69 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line69", Text
"Amount2"] Entry Centi
Amount,
   $sel:line70:Page3 :: 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:Page3 :: FieldConst Centi
line71 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line71", Text
"Amount"] Entry Centi
Amount,
   $sel:line72:Page3 :: FieldConst Centi
line72 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line72", Text
"Amount"] Entry Centi
Amount,
   $sel:line73:Page3 :: FieldConst Centi
line73 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line73", Text
"Amount"] Entry Centi
Amount,
   $sel:line74_basicReduction:Page3 :: FieldConst Centi
line74_basicReduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line74", Text
"Amount"] Entry Centi
Amount,
   $sel:line75_childrenNum:Page3 :: FieldConst Word
line75_childrenNum = [Text] -> Entry Word -> FieldConst Word
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line75", Text
"Line_60969", Text
"Number"] Entry Word
Count,
   $sel:line75_amount:Page3 :: FieldConst Centi
line75_amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line75", Text
"Amount"] Entry Centi
Amount,
   $sel:line76_childrenNum:Page3 :: FieldConst Word
line76_childrenNum = [Text] -> Entry Word -> FieldConst Word
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line76", Text
"Line_60970", Text
"Number"] Entry Word
Count,
   $sel:line76_amount:Page3 :: FieldConst Centi
line76_amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line76", Text
"Amount"] Entry Centi
Amount,
   $sel:line77:Page3 :: FieldConst Centi
line77 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line77", Text
"Amount"] Entry Centi
Amount,
   $sel:line78_copy:Page3 :: FieldConst Centi
line78_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line78", Text
"Amount1"] Entry Centi
Amount,
   $sel:line78_product:Page3 :: FieldConst Centi
line78_product = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line78", Text
"Amount2"] Entry Centi
Amount,
   $sel:line79:Page3 :: FieldConst Centi
line79 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line79", Text
"Amount"] Entry Centi
Amount,
   $sel:line80_difference:Page3 :: FieldConst Centi
line80_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line80", Text
"Amount1"] Entry Centi
Amount,
   $sel:line80_cont:Page3 :: FieldConst Centi
line80_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line80", Text
"Amount2"] Entry Centi
Amount,
   $sel:line81:Page3 :: FieldConst Centi
line81 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line81", Text
"Amount"] Entry Centi
Amount,
   $sel:line82:Page3 :: FieldConst Centi
line82 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line82", Text
"Amount"] Entry Centi
Amount,
   $sel:line83:Page3 :: FieldConst Centi
line83 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line83", Text
"Amount"] Entry Centi
Amount}

page4Fields :: Page4 FieldConst
page4Fields = Page4 {
   $sel:line84:Page4 :: FieldConst Centi
line84 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line84", Text
"Amount"] Entry Centi
Amount,
   $sel:line85_lift:Page4 :: FieldConst Centi
line85_lift = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line85", Text
"Amount"] Entry Centi
Amount,
   $sel:line86:Page4 :: FieldConst Centi
line86 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line86", Text
"Amount"] Entry Centi
Amount,
   $sel:line87_foodDonations:Page4 :: FieldConst Centi
line87_foodDonations = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line87", Text
"Line62150", Text
"Amount1"] Entry Centi
Amount,
   $sel:line87_fraction:Page4 :: FieldConst Centi
line87_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line87", Text
"Amount2"] Entry Centi
Amount,
   $sel:line88:Page4 :: FieldConst Centi
line88 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line88", Text
"Amount"] Entry Centi
Amount,
   $sel:line89_health:Page4 :: FieldConst Centi
line89_health = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line89", Text
"Amount"] Entry Centi
Amount,
   $sel:line90:Page4 :: FieldConst Centi
line90 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line90", Text
"Amount"] Entry Centi
Amount,
   $sel:healthPremium:Page4 :: HealthPremium FieldConst
healthPremium = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"ON_Health_Prenium-worksheet" (FieldConst a -> FieldConst a)
-> (FieldConst a -> FieldConst a) -> FieldConst a -> FieldConst a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Chart_ON_Health_Prenium" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremium FieldConst -> HealthPremium 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) -> HealthPremium p -> HealthPremium q
Rank2.<$> HealthPremium FieldConst
healthPremiumFields}

healthPremiumFields :: HealthPremium FieldConst
healthPremiumFields = HealthPremium {
   $sel:row1:HealthPremium :: HealthPremiumBracket FieldConst
row1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Taxable_Line2" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremiumBracket FieldConst
-> HealthPremiumBracket 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)
-> HealthPremiumBracket p -> HealthPremiumBracket q
Rank2.<$> HealthPremiumBracket FieldConst
healthPremiumBracketFields{$sel:equalsTax:HealthPremiumBracket :: FieldConst Centi
equalsTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount3"] Entry Centi
Amount},
   $sel:row2:HealthPremium :: HealthPremiumBracket FieldConst
row2 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Taxable_Line4" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremiumBracket FieldConst
-> HealthPremiumBracket 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)
-> HealthPremiumBracket p -> HealthPremiumBracket q
Rank2.<$> HealthPremiumBracket FieldConst
healthPremiumBracketFields,
   $sel:row3:HealthPremium :: HealthPremiumBracket FieldConst
row3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Taxable_Line6" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremiumBracket FieldConst
-> HealthPremiumBracket 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)
-> HealthPremiumBracket p -> HealthPremiumBracket q
Rank2.<$> HealthPremiumBracket FieldConst
healthPremiumBracketFields,
   $sel:row4:HealthPremium :: HealthPremiumBracket FieldConst
row4 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Taxable_Line8" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremiumBracket FieldConst
-> HealthPremiumBracket 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)
-> HealthPremiumBracket p -> HealthPremiumBracket q
Rank2.<$> HealthPremiumBracket FieldConst
healthPremiumBracketFields,
   $sel:row5:HealthPremium :: HealthPremiumBracket FieldConst
row5 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Taxable_Line10" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremiumBracket FieldConst
-> HealthPremiumBracket 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)
-> HealthPremiumBracket p -> HealthPremiumBracket q
Rank2.<$> HealthPremiumBracket FieldConst
healthPremiumBracketFields}

healthPremiumBracketFields :: HealthPremiumBracket FieldConst
healthPremiumBracketFields = HealthPremiumBracket {
   $sel:taxableIncome:HealthPremiumBracket :: FieldConst Centi
taxableIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount1"] Entry Centi
Amount,
   $sel:overThreshold:HealthPremiumBracket :: FieldConst Centi
overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount2"] Entry Centi
Amount,
   $sel:timesRate:HealthPremiumBracket :: FieldConst Centi
timesRate     = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount3"] Entry Centi
Amount,
   $sel:equalsTax:HealthPremiumBracket :: FieldConst Centi
equalsTax     = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount4"] Entry Centi
Amount}