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

module Tax.Canada.T1.FieldNames (t1Fields) where

import Data.Fixed (Centi)
import Data.Text (Text)
import Data.Time (Day)
import Rank2 qualified

import Tax.FDF (FieldConst (Field), Entry (..), within)
import Tax.Canada.T1.Types

t1Fields :: T1 FieldConst
t1Fields :: T1 FieldConst
t1Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (forall {a}. FieldConst a -> FieldConst a)
-> T1 FieldConst -> T1 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) -> T1 p -> T1 q
Rank2.<$> T1 {
   $sel:page1:T1 :: Page1 FieldConst
page1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page1" (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
"Step1" (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:T1 :: 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:T1 :: Page3 FieldConst
page3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page3" (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
"Step2" (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:T1 :: Page4 FieldConst
page4 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page4" (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
"Step3" (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,
   $sel:page5:T1 :: Page5 FieldConst
page5 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page5" (forall {a}. FieldConst a -> FieldConst a)
-> Page5 FieldConst -> Page5 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) -> Page5 p -> Page5 q
Rank2.<$> Page5 FieldConst
page5Fields,
   $sel:page6:T1 :: Page6 FieldConst
page6 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page6" (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
"PartB" (forall {a}. FieldConst a -> FieldConst a)
-> Page6 FieldConst -> Page6 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) -> Page6 p -> Page6 q
Rank2.<$> Page6 FieldConst
page6Fields,
   $sel:page7:T1 :: Page7 FieldConst
page7 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page7" (forall {a}. FieldConst a -> FieldConst a)
-> Page7 FieldConst -> Page7 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) -> Page7 p -> Page7 q
Rank2.<$> Page7 FieldConst
page7Fields,
   $sel:page8:T1 :: Page8 FieldConst
page8 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page8" (forall {a}. FieldConst a -> FieldConst a)
-> Page8 FieldConst -> Page8 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) -> Page8 p -> Page8 q
Rank2.<$> Page8 FieldConst
page8Fields}

page1Fields :: Page1 FieldConst
page1Fields = Page1 {
   $sel:identification:Page1 :: Identification FieldConst
identification = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Identification" (forall {a}. FieldConst a -> FieldConst a)
-> Identification FieldConst -> Identification 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) -> Identification p -> Identification q
Rank2.<$> Identification FieldConst
page1IdentificationFields,
   $sel:residence:Page1 :: Residence FieldConst
residence = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Residence_Info" (forall {a}. FieldConst a -> FieldConst a)
-> Residence FieldConst -> Residence 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) -> Residence p -> Residence q
Rank2.<$> Residence FieldConst
page1ResidenceFields,
   $sel:spouse:Page1 :: Spouse FieldConst
spouse = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Info_Spouse_CLP" (forall {a}. FieldConst a -> FieldConst a)
-> Spouse FieldConst -> Spouse 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) -> Spouse p -> Spouse q
Rank2.<$> Spouse FieldConst
page1SpouseFields}

page1IdentificationFields :: Identification FieldConst
page1IdentificationFields = Identification {
   $sel:emailAddress:Identification :: FieldConst Text
emailAddress = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"EmailAddress"] Entry Text
Textual,
   $sel:dateDeath:Identification :: FieldConst Day
dateDeath = [Text] -> Entry Day -> FieldConst Day
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"DateDeath_Comb_BordersAll", Text
"DateDeath_Comb"] Entry Day
Date,
   $sel:postalCode:Identification :: FieldConst Text
postalCode = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"PostalCode_Comb_BordersAll", Text
"PostalCode"] Entry Text
Textual,
   $sel:your_Language:Identification :: FieldConst LanguageOfCorrespondence
your_Language = [Text]
-> Entry LanguageOfCorrespondence
-> FieldConst LanguageOfCorrespondence
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Your_Language", Text
"RadioButtonlanguaget"] (Entry LanguageOfCorrespondence
 -> FieldConst LanguageOfCorrespondence)
-> Entry LanguageOfCorrespondence
-> FieldConst LanguageOfCorrespondence
forall a b. (a -> b) -> a -> b
$ [LanguageOfCorrespondence] -> Entry LanguageOfCorrespondence
forall a. (Bounded a, Enum a, Eq a, Show a) => [a] -> Entry a
RadioButton [LanguageOfCorrespondence
English, LanguageOfCorrespondence
French],
   $sel:id_City:Identification :: FieldConst Text
id_City = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ID_City"] Entry Text
Textual,
   $sel:sin:Identification :: FieldConst Text
sin = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"SIN_Comb_BordersAll", Text
"SIN_Comb"] Entry Text
Textual,
   $sel:id_LastName:Identification :: FieldConst Text
id_LastName = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ID_LastName"] Entry Text
Textual,
   $sel:dateBirth:Identification :: FieldConst Day
dateBirth = [Text] -> Entry Day -> FieldConst Day
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"DateBirth_Comb_BordersAll", Text
"DateBirth_Comb"] Entry Day
Date,
   $sel:id_FirstNameInitial:Identification :: FieldConst Text
id_FirstNameInitial = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ID_FirstNameInitial"] Entry Text
Textual,
   $sel:id_MailingAddress:Identification :: FieldConst Text
id_MailingAddress = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ID_MailingAddress"] Entry Text
Textual,
   $sel:maritalStatus:Identification :: FieldConst MaritalStatus
maritalStatus = [Text] -> Entry MaritalStatus -> FieldConst MaritalStatus
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"MaritalStatus_Checkbox"] (Entry MaritalStatus -> FieldConst MaritalStatus)
-> Entry MaritalStatus -> FieldConst MaritalStatus
forall a b. (a -> b) -> a -> b
$ Text -> [MaritalStatus] -> Entry MaritalStatus
forall a.
(Bounded a, Enum a, Eq a, Show a) =>
Text -> [a] -> Entry a
RadioButtons Text
"MaritalStatus" [MaritalStatus
Married .. MaritalStatus
Single],
   $sel:id_RuralRoute:Identification :: FieldConst Text
id_RuralRoute = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ID_RuralRoute"] Entry Text
Textual,
   $sel:id_POBox:Identification :: FieldConst Text
id_POBox = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ID_POBox"] Entry Text
Textual,
   $sel:prov_DropDown:Identification :: FieldConst Code
prov_DropDown = [Text] -> Entry Code -> FieldConst Code
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Prov_DropDown"] Entry Code
Province}

page1ResidenceFields :: Residence FieldConst
page1ResidenceFields = Residence {
   $sel:prov_DropDown_Business:Residence :: FieldConst Code
prov_DropDown_Business = [Text] -> Entry Code -> FieldConst Code
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Prov_DropDown-Business"] Entry Code
Province,
   $sel:prov_DropDown_Residence:Residence :: FieldConst Code
prov_DropDown_Residence = [Text] -> Entry Code -> FieldConst Code
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Prov_DropDown-Residence"] Entry Code
Province,
   $sel:date_Departure:Residence :: FieldConst Day
date_Departure = [Text] -> Entry Day -> FieldConst Day
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Date_Departure", Text
"DateMMDD_Comb_BordersAll_Std", Text
"DateMMDD_Comb"] Entry Day
Date,
   $sel:date_Entry:Residence :: FieldConst Day
date_Entry = [Text] -> Entry Day -> FieldConst Day
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Date_Entry", Text
"DateMMDD_Comb_BordersAll_Std", Text
"DateMMDD_Comb"] Entry Day
Date,
   $sel:prov_DropDown:Residence :: FieldConst Text
prov_DropDown = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Prov_DropDown"] Entry Text
Textual}
  
page1SpouseFields :: Spouse FieldConst
page1SpouseFields = Spouse {
   $sel:line23600:Spouse :: FieldConst Centi
line23600 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23600", Text
"Amount"] Entry Centi
Amount,
   $sel:self_employment:Spouse :: FieldConst Bool
self_employment = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Self-employment", Text
"Checkbox"] Entry Bool
Checkbox,
   $sel:spouse_First_Name:Spouse :: FieldConst Text
spouse_First_Name = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Spouse_First_Name"] Entry Text
Textual,
   $sel:line11700:Spouse :: FieldConst Centi
line11700 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line11700", Text
"Amount"] Entry Centi
Amount,
   $sel:line21300:Spouse :: FieldConst Centi
line21300 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line21300", Text
"Amount"] Entry Centi
Amount,
   $sel:sin:Spouse :: FieldConst Text
sin = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"SIN_Comb_BordersAll", Text
"SIN_Comb"] Entry Text
Textual}

page2Fields :: Page2 FieldConst
page2Fields = Page2 {
   $sel:foreign_property:Page2 :: FieldConst Bool
foreign_property = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Foreign_property", Text
"Line26600"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Entry Bool
Switch Text
"Option1" Text
"Option2" Text
"ForeignProperty_CheckBox",
   $sel:tax_exempt:Page2 :: FieldConst Bool
tax_exempt = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Tax_exempt", Text
"Exempt", Text
"Spouse_SelfEmployed"] Entry Bool
Checkbox,
   $sel:electionsCanada:Page2 :: ElectionsCanada FieldConst
electionsCanada = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"ElectionsCanada" (forall {a}. FieldConst a -> FieldConst a)
-> ElectionsCanada FieldConst -> ElectionsCanada 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) -> ElectionsCanada p -> ElectionsCanada q
Rank2.<$> ElectionsCanada FieldConst
page2ElectionsCanadaFields,
   $sel:cai:Page2 :: FieldConst Bool
cai = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"CAI", Text
"CAI_ON", Text
"Tick_box"] Entry Bool
Checkbox,
   $sel:organ_donor:Page2 :: FieldConst Bool
organ_donor = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Organ_donor", Text
"Question"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Entry Bool
Switch Text
"Option1" Text
"Option2" Text
"OrganDonor_CheckBox"
}

page2ElectionsCanadaFields :: ElectionsCanada FieldConst
page2ElectionsCanadaFields = ElectionsCanada {
   $sel:citizenship:ElectionsCanada :: FieldConst Bool
citizenship = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"LineA"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Entry Bool
Switch Text
"Option1" Text
"Option2" Text
"A_CheckBox",
   $sel:authorization:ElectionsCanada :: FieldConst Bool
authorization = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"LineB"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Entry Bool
Switch Text
"Option1" Text
"Option2" Text
"B_Authorize_CheckBox"}

page3Fields :: Page3 FieldConst
page3Fields = Page3 {
   $sel:line_10400_OtherEmploymentIncome:Page3 :: FieldConst Centi
line_10400_OtherEmploymentIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_10400_OtherEmploymentIncome", Text
"Line_10400_Amount"] Entry Centi
Amount,
   $sel:line_12100_InvestmentIncome:Page3 :: FieldConst Centi
line_12100_InvestmentIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12100_InvestmentIncome", Text
"Line_12100_Amount"] Entry Centi
Amount,
   $sel:line_11300_OldAgeSecurityPension:Page3 :: FieldConst Centi
line_11300_OldAgeSecurityPension = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_11300_OldAgeSecurityPension", Text
"Line_11300_Amount"] Entry Centi
Amount,
   $sel:line_11500_OtherPensions:Page3 :: FieldConst Centi
line_11500_OtherPensions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_11500_OtherPensions", Text
"Line_11500_Amount"] Entry Centi
Amount,
   $sel:line_13000_OtherIncome:Page3 :: FieldConst Centi
line_13000_OtherIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_13000_OtherIncome", Text
"Line_13000_Amount"] Entry Centi
Amount,
   $sel:line_13000_OtherIncomeSource:Page3 :: FieldConst Text
line_13000_OtherIncomeSource = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_13000_OtherIncome", Text
"Line_13000_Specify"] Entry Text
Textual,
   $sel:line_11410_DisabilityBenefits:Page3 :: FieldConst Centi
line_11410_DisabilityBenefits = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_11410_DisabilityBenefits", Text
"Line_11410_Amount"] Entry Centi
Amount,
   $sel:line_14400_WorkersCompBen:Page3 :: FieldConst Centi
line_14400_WorkersCompBen = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_14400_WorkersCompBen", Text
"Line_14400_Amount"] Entry Centi
Amount,
   $sel:line_11400_CPP_QPP:Page3 :: FieldConst Centi
line_11400_CPP_QPP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_11400_CPP_QPP", Text
"Line_11400_Amount"] Entry Centi
Amount,
   $sel:line_25_sum:Page3 :: FieldConst Centi
line_25_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25", Text
"Amount1"] Entry Centi
Amount,
   $sel:line_25_cont:Page3 :: FieldConst Centi
line_25_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25", Text
"Amount2"] Entry Centi
Amount,
   $sel:line_11700_UCCB:Page3 :: FieldConst Centi
line_11700_UCCB = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_11700_UCCB", Text
"Line_11700_Amount"] Entry Centi
Amount,
   $sel:line_10100_EmploymentIncome:Page3 :: FieldConst Centi
line_10100_EmploymentIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_10100_EmploymentIncome", Text
"Line_10100_Amount"] Entry Centi
Amount,
   $sel:line_12700_TaxableCapitalGains:Page3 :: FieldConst Centi
line_12700_TaxableCapitalGains = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12700_TaxableCapitalGains", Text
"Line_12700_Amount"] Entry Centi
Amount,
   $sel:line_13700_Amount:Page3 :: FieldConst Centi
line_13700_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line21", Text
"Line_13700_Amount"] Entry Centi
Amount,
   $sel:line_13699_Amount:Page3 :: FieldConst Centi
line_13699_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line21", Text
"Line_13699_Amount"] Entry Centi
Amount,
   $sel:line_11900_EmploymentInsurance:Page3 :: FieldConst Centi
line_11900_EmploymentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_11900_EmploymentInsurance", Text
"Line_11900_Amount"] Entry Centi
Amount,
   $sel:line_14100_Amount:Page3 :: FieldConst Centi
line_14100_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Line_14100_Amount"] Entry Centi
Amount,
   $sel:line_14099_Amount:Page3 :: FieldConst Centi
line_14099_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Line_14099_Amount"] Entry Centi
Amount,
   $sel:line_10120_Commissions:Page3 :: FieldConst Centi
line_10120_Commissions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_10120_Commissions", Text
"Line_10120_Amount"] Entry Centi
Amount,
   $sel:line_11600_ElectedSplitPension:Page3 :: FieldConst Centi
line_11600_ElectedSplitPension = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_11600_ElectedSplitPension", Text
"Line_11600_Amount"] Entry Centi
Amount,
   $sel:line_14700_EqualsAmount:Page3 :: FieldConst Centi
line_14700_EqualsAmount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_14700_AddLines", Text
"Line_14700_EqualsAmount"] Entry Centi
Amount,
   $sel:line_14700_PlusAmount:Page3 :: FieldConst Centi
line_14700_PlusAmount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_14700_AddLines", Text
"Line_14700_PlusAmount"] Entry Centi
Amount,
   $sel:line_13010_Taxablescholarship:Page3 :: FieldConst Centi
line_13010_Taxablescholarship = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_13010_Taxablescholarship", Text
"Amount"] Entry Centi
Amount,
   $sel:line_19:Page3 :: FieldConst Centi
line_19 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_19", Text
"Amount"] Entry Centi
Amount,
   $sel:line_12599_12600_RentalIncome:Page3 :: FieldConst Centi
line_12599_12600_RentalIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12599_12600_RentalIncome", Text
"Line_12599_Amount"] Entry Centi
Amount,
   $sel:line_12600_Amount:Page3 :: FieldConst Centi
line_12600_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12599_12600_RentalIncome", Text
"Line_12600_Amount"] Entry Centi
Amount,
   $sel:line_12200_PartnershipIncome:Page3 :: FieldConst Centi
line_12200_PartnershipIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12200_PartnershipIncome", Text
"Line_12200_Amount"] Entry Centi
Amount,
   $sel:line_11905_Employmentmaternity:Page3 :: FieldConst Centi
line_11905_Employmentmaternity = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_11905_Employmentmaternity", Text
"Line_11905_Amount"] Entry Centi
Amount,
   $sel:line_14500_SocialAssistPay:Page3 :: FieldConst Centi
line_14500_SocialAssistPay = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_14500_SocialAssistPay", Text
"Line_14500_Amount"] Entry Centi
Amount,
   $sel:line_15000_TotalIncome:Page3 :: FieldConst Centi
line_15000_TotalIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_15000_TotalIncome", Text
"Line_15000_Amount"] Entry Centi
Amount,
   $sel:line_10105_Taxexemptamount:Page3 :: FieldConst Centi
line_10105_Taxexemptamount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_10105_Taxexemptamount", Text
"Line_10105_Amount"] Entry Centi
Amount,
   $sel:line_12900_RRSPIncome:Page3 :: FieldConst Centi
line_12900_RRSPIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12900_RRSPIncome", Text
"Line_12900_Amount"] Entry Centi
Amount,
   $sel:line_12500_RDSP:Page3 :: FieldConst Centi
line_12500_RDSP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12500_RDSP", Text
"Line_12500_Amount"] Entry Centi
Amount,
   $sel:line_26:Page3 :: FieldConst Centi
line_26 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_26", Text
"Amount1"] Entry Centi
Amount,
   $sel:line_12000_TaxableDividends:Page3 :: FieldConst Centi
line_12000_TaxableDividends = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12000_TaxableDividends", Text
"Amount"] Entry Centi
Amount,
   $sel:line_14600_NetFedSupplements:Page3 :: FieldConst Centi
line_14600_NetFedSupplements = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_14600_NetFedSupplements", Text
"Line_14600_Amount"] Entry Centi
Amount,
   $sel:line_10130_sf:Page3 :: FieldConst Centi
line_10130_sf = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_10130_sf", Text
"Line_10130_Amount"] Entry Centi
Amount,
   $sel:line_12010_OtherTaxableDividends:Page3 :: FieldConst Centi
line_12010_OtherTaxableDividends = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12010_OtherTaxableDividends", Text
"Line_12010_Amount"] Entry Centi
Amount,
   $sel:line_11701_UCCBDesignated:Page3 :: FieldConst Centi
line_11701_UCCBDesignated = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_11701_UCCBDesignated", Text
"Line_11701_Amount"] Entry Centi
Amount,
   $sel:line_13499_Amount:Page3 :: FieldConst Centi
line_13499_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Line_13499_Amount"] Entry Centi
Amount,
   $sel:line_13500_Amount:Page3 :: FieldConst Centi
line_13500_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Line_13500_Amount"] Entry Centi
Amount,
   $sel:line_12800_Amount:Page3 :: FieldConst Centi
line_12800_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12799_12800_SupportPayReceived", Text
"Line_12800_Amount"] Entry Centi
Amount,
   $sel:line_12799_Amount:Page3 :: FieldConst Centi
line_12799_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_12799_12800_SupportPayReceived", Text
"Line_12799_Amount"] Entry Centi
Amount,
   $sel:line_14299_Amount:Page3 :: FieldConst Centi
line_14299_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Line_14299_Amount"] Entry Centi
Amount,
   $sel:line_14300_Amount:Page3 :: FieldConst Centi
line_14300_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Line_14300_Amount"] Entry Centi
Amount,
   $sel:line_13900_Amount:Page3 :: FieldConst Centi
line_13900_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"Line_13900_Amount"] Entry Centi
Amount,
   $sel:line_13899_Amount:Page3 :: FieldConst Centi
line_13899_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"Line_13899_Amount"] Entry Centi
Amount}
                                                                                           
page4Fields :: Page4 FieldConst
page4Fields = Page4 {
   $sel:line_21000_SplitPensionDeduction:Page4 :: FieldConst Centi
line_21000_SplitPensionDeduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_21000_SplitPensionDeduction", Text
"Line_21000_Amount"] Entry Centi
Amount,
   $sel:line_23500_SocialBenefits:Page4 :: FieldConst Centi
line_23500_SocialBenefits = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_23500_SocialBenefits", Text
"Line_23500_Amount"] Entry Centi
Amount,
   $sel:line_23400_NetBeforeAdjust:Page4 :: FieldConst Centi
line_23400_NetBeforeAdjust = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_23400_NetBeforeAdjust", Text
"Line_23400_Amount"] Entry Centi
Amount,
   $sel:line_22100_CarryingChargesInterest:Page4 :: FieldConst Centi
line_22100_CarryingChargesInterest = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_22100_CarryingChargesInterest", Text
"Line_22100_Amount"] Entry Centi
Amount,
   $sel:line_21500_DisabilityDeduction:Page4 :: FieldConst Centi
line_21500_DisabilityDeduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_21500_DisabilityDeduction", Text
"Line_21500_Amount"] Entry Centi
Amount,
   $sel:line_15000_TotalIncome_2:Page4 :: FieldConst Centi
line_15000_TotalIncome_2 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_15000_TotalIncome_2", Text
"Line_15000_Amount"] Entry Centi
Amount,
   $sel:line_22900_OtherEmployExpenses:Page4 :: FieldConst Centi
line_22900_OtherEmployExpenses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_22900_OtherEmployExpenses", Text
"Line_22900_Amount"] Entry Centi
Amount,
   $sel:line_20800_RRSPDeduction:Page4 :: FieldConst Centi
line_20800_RRSPDeduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_20800_RRSPDeduction", Text
"Line_20800_Amount"] Entry Centi
Amount,
   $sel:line_22000_Amount:Page4 :: FieldConst Centi
line_22000_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42", Text
"Line_22000_Amount"] Entry Centi
Amount,
   $sel:line_21999_Amount:Page4 :: FieldConst Centi
line_21999_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42", Text
"Line_21999_Amount"] Entry Centi
Amount,
   $sel:line_21699_Amount:Page4 :: FieldConst Centi
line_21699_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40", Text
"Line_21699_Amount"] Entry Centi
Amount,
   $sel:line_21700_Amount:Page4 :: FieldConst Centi
line_21700_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40", Text
"Line_21700_Amount"] Entry Centi
Amount,
   $sel:line_23210:Page4 :: FieldConst Centi
line_23210 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23210", Text
"Amount"] Entry Centi
Amount,
   $sel:line_20810_PRPP:Page4 :: FieldConst Centi
line_20810_PRPP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_20810_PRPP", Text
"Line_20810_Amount"] Entry Centi
Amount,
   $sel:line_20700_RPPDeduction:Page4 :: FieldConst Centi
line_20700_RPPDeduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_20700_RPPDeduction", Text
"Line_20700_Amount"] Entry Centi
Amount,
   $sel:line_22215_DeductionCPP_QPP:Page4 :: FieldConst Centi
line_22215_DeductionCPP_QPP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_22215_DeductionCPP_QPP", Text
"Line_22215_Amount"] Entry Centi
Amount,
   $sel:line_23300_sum:Page4 :: FieldConst Centi
line_23300_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_23300_AddLines", Text
"Line_23300_Amount1"] Entry Centi
Amount,
   $sel:line_23300_cont:Page4 :: FieldConst Centi
line_23300_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_23300_AddLines", Text
"Line_23300_Amount2"] Entry Centi
Amount,
   $sel:line_23600_NetIncome:Page4 :: FieldConst Centi
line_23600_NetIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_23600_NetIncome", Text
"Line_23600_Amount"] Entry Centi
Amount,
   $sel:line_21200_Dues:Page4 :: FieldConst Centi
line_21200_Dues = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_21200_Dues", Text
"Line_21200_Amount"] Entry Centi
Amount,
   $sel:line_20600_PensionAdjustment:Page4 :: FieldConst Centi
line_20600_PensionAdjustment = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_20600_PensionAdjustment", Text
"Line_20600_Amount"] Entry Centi
Amount,
   $sel:line_22400_XplorationDevExpenses:Page4 :: FieldConst Centi
line_22400_XplorationDevExpenses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_22400_XplorationDevExpenses", Text
"Line_22400_Amount"] Entry Centi
Amount,
   $sel:line_23200_OtherDeductions:Page4 :: FieldConst Centi
line_23200_OtherDeductions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_23200_OtherDeductions", Text
"Line_23200_Amount"] Entry Centi
Amount,
   $sel:line_23200_Specify:Page4 :: FieldConst Text
line_23200_Specify = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_23200_OtherDeductions", Text
"Line_23200_Specify"] Entry Text
Textual,
   $sel:line_21900_MovingExpenses:Page4 :: FieldConst Centi
line_21900_MovingExpenses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_21900_MovingExpenses", Text
"Line_21900_Amount"] Entry Centi
Amount,
   $sel:line_21400_ChildCareExpenses:Page4 :: FieldConst Centi
line_21400_ChildCareExpenses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_21400_ChildCareExpenses", Text
"Line_21400_Amount"] Entry Centi
Amount,
   $sel:line_22200_CPP_QPP_Contributions:Page4 :: FieldConst Centi
line_22200_CPP_QPP_Contributions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_22200_CPP_QPP_Contributions", Text
"Line_22200_Amount"] Entry Centi
Amount,
   $sel:line_21300_UCCBRepayment:Page4 :: FieldConst Centi
line_21300_UCCBRepayment = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_21300_UCCBRepayment", Text
"Line_21300_Amount"] Entry Centi
Amount,
   $sel:line_23100_ClergyResDeduction:Page4 :: FieldConst Centi
line_23100_ClergyResDeduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_23100_ClergyResDeduction", Text
"Line_23100_Amount"] Entry Centi
Amount}
                                                                                           
page5Fields :: Page5 FieldConst
page5Fields = Page5 {
   $sel:step4_TaxableIncome:Page5 :: Step4 FieldConst
step4_TaxableIncome = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Step4_TaxableIncome" (forall {a}. FieldConst a -> FieldConst a)
-> Step4 FieldConst -> Step4 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) -> Step4 p -> Step4 q
Rank2.<$> Step4 FieldConst
step4Fields,
   $sel:partA_FederalTax:Page5 :: Page5PartA FieldConst
partA_FederalTax = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartA" (forall {a}. FieldConst a -> FieldConst a)
-> Page5PartA FieldConst -> Page5PartA 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) -> Page5PartA p -> Page5PartA q
Rank2.<$> Page5PartA FieldConst
partAFields,
   $sel:partB_FederalTaxCredits:Page5 :: Page5PartB FieldConst
partB_FederalTaxCredits = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartB" (forall {a}. FieldConst a -> FieldConst a)
-> Page5PartB FieldConst -> Page5PartB 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) -> Page5PartB p -> Page5PartB q
Rank2.<$> Page5PartB FieldConst
partBFields}

step4Fields :: Step4 FieldConst
step4Fields = Step4 {
   $sel:line_23600_NetIncome_2:Step4 :: FieldConst Centi
line_23600_NetIncome_2 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_23600_NetIncome_2", Text
"Line_15000_Amount"] Entry Centi
Amount,
   $sel:line_24400_MilitaryPoliceDeduction:Step4 :: FieldConst Centi
line_24400_MilitaryPoliceDeduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_24400_MilitaryPoliceDeduction", Text
"Line_24400_Amount"] Entry Centi
Amount,
   $sel:line_24900_SecurityDeductions:Step4 :: FieldConst Centi
line_24900_SecurityDeductions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_24900_SecurityDeductions", Text
"Line_24900_Amount"] Entry Centi
Amount,
   $sel:line_25000_OtherPayDeductions:Step4 :: FieldConst Centi
line_25000_OtherPayDeductions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25000_OtherPayDeductions", Text
"Line_25000_Amount"] Entry Centi
Amount,
   $sel:line_25100_PartnershipLosses:Step4 :: FieldConst Centi
line_25100_PartnershipLosses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25100_PartnershipLosses", Text
"Line_25100_Amount"] Entry Centi
Amount,
   $sel:line_25200_NoncapitalLosses:Step4 :: FieldConst Centi
line_25200_NoncapitalLosses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25200_NoncapitalLosses", Text
"Line_25200_Amount"] Entry Centi
Amount,
   $sel:line_25300_NetCapitalLosses:Step4 :: FieldConst Centi
line_25300_NetCapitalLosses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25300_NetCapitalLosses", Text
"Line_25300_Amount"] Entry Centi
Amount,
   $sel:line_25400_CapitalGainsDeduction:Step4 :: FieldConst Centi
line_25400_CapitalGainsDeduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25400_CapitalGainsDeduction", Text
"Line_25400_Amount"] Entry Centi
Amount,
   $sel:line_25500_NorthernDeductions:Step4 :: FieldConst Centi
line_25500_NorthernDeductions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25500_NorthernDeductions", Text
"Line_25500_Amount"] Entry Centi
Amount,
   $sel:line_25600_AdditionalDeductions_Amount:Step4 :: FieldConst Centi
line_25600_AdditionalDeductions_Amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25600_AdditionalDeductions", Text
"Line_25600_Amount"] Entry Centi
Amount,
   $sel:line_25600_AdditionalDeductions_Specify:Step4 :: FieldConst Text
line_25600_AdditionalDeductions_Specify = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25600_AdditionalDeductions", Text
"Line_25600_Specify"] Entry Text
Textual,
   $sel:line_25700_AddLines_cont:Step4 :: FieldConst Centi
line_25700_AddLines_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25700_AddLines", Text
"Line_25700_Amount2"] Entry Centi
Amount,
   $sel:line_25700_AddLines_sum:Step4 :: FieldConst Centi
line_25700_AddLines_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_25700_AddLines", Text
"Line_25700_Amount1"] Entry Centi
Amount,
   $sel:line_26000_TaxableIncome:Step4 :: FieldConst Centi
line_26000_TaxableIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_26000_TaxableIncome", Text
"Line_26000_Amount"] Entry Centi
Amount}

partAFields :: Page5PartA FieldConst
partAFields = Page5PartA {
   $sel:column1:Page5PartA :: 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 {
       $sel:line67_income:TaxIncomeBracket :: FieldConst Centi
line67_income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36Amount1"] Entry Centi
Amount,
       $sel:line69_overThreshold:TaxIncomeBracket :: FieldConst Centi
line69_overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38Amount1"] Entry Centi
Amount,
       $sel:line71_timesRate:TaxIncomeBracket :: FieldConst Centi
line71_timesRate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40Amount1"] Entry Centi
Amount,
       $sel:line73_equalsTax:TaxIncomeBracket :: FieldConst Centi
line73_equalsTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42Amount1"] Entry Centi
Amount},
   $sel:column2:Page5PartA :: 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 {
       $sel:line67_income:TaxIncomeBracket :: FieldConst Centi
line67_income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36Amount2"] Entry Centi
Amount,
       $sel:line69_overThreshold:TaxIncomeBracket :: FieldConst Centi
line69_overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38Amount2"] Entry Centi
Amount,
       $sel:line71_timesRate:TaxIncomeBracket :: FieldConst Centi
line71_timesRate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40Amount2"] Entry Centi
Amount,
       $sel:line73_equalsTax:TaxIncomeBracket :: FieldConst Centi
line73_equalsTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42Amount2"] Entry Centi
Amount},
   $sel:column3:Page5PartA :: 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 {
       $sel:line67_income:TaxIncomeBracket :: FieldConst Centi
line67_income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36Amount3"] Entry Centi
Amount,
       $sel:line69_overThreshold:TaxIncomeBracket :: FieldConst Centi
line69_overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38Amount3"] Entry Centi
Amount,
       $sel:line71_timesRate:TaxIncomeBracket :: FieldConst Centi
line71_timesRate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40Amount3"] Entry Centi
Amount,
       $sel:line73_equalsTax:TaxIncomeBracket :: FieldConst Centi
line73_equalsTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42Amount3"] Entry Centi
Amount},
   $sel:column4:Page5PartA :: 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 {
       $sel:line67_income:TaxIncomeBracket :: FieldConst Centi
line67_income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36Amount4"] Entry Centi
Amount,
       $sel:line69_overThreshold:TaxIncomeBracket :: FieldConst Centi
line69_overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38Amount4"] Entry Centi
Amount,
       $sel:line71_timesRate:TaxIncomeBracket :: FieldConst Centi
line71_timesRate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40Amount4"] Entry Centi
Amount,
       $sel:line73_equalsTax:TaxIncomeBracket :: FieldConst Centi
line73_equalsTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42Amount4"] Entry Centi
Amount},
   $sel:column5:Page5PartA :: 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 {
       $sel:line67_income:TaxIncomeBracket :: FieldConst Centi
line67_income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36Amount5"] Entry Centi
Amount,
       $sel:line69_overThreshold:TaxIncomeBracket :: FieldConst Centi
line69_overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38Amount5"] Entry Centi
Amount,
       $sel:line71_timesRate:TaxIncomeBracket :: FieldConst Centi
line71_timesRate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40Amount5"] Entry Centi
Amount,
       $sel:line73_equalsTax:TaxIncomeBracket :: FieldConst Centi
line73_equalsTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42Amount5"] Entry Centi
Amount}}

partBFields :: Page5PartB FieldConst
partBFields = Page5PartB {
   $sel:line30000:Page5PartB :: FieldConst Centi
line30000 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30000_Sub", Text
"Line1_Amount"] Entry Centi
Amount,
   $sel:line30100:Page5PartB :: FieldConst Centi
line30100 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30100_Sub", Text
"Line2_Amount"] Entry Centi
Amount,
   $sel:line30300:Page5PartB :: FieldConst Centi
line30300 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30300_Sub", Text
"Line3_Amount"] Entry Centi
Amount,
   $sel:line30400:Page5PartB :: FieldConst Centi
line30400 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30400_Sub", Text
"Line4_Amount"] Entry Centi
Amount,
   $sel:line30425:Page5PartB :: FieldConst Centi
line30425 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30425_sub", Text
"Line4_Amount"] Entry Centi
Amount,
   $sel:line30450:Page5PartB :: FieldConst Centi
line30450 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30450_Sub", Text
"Line6_Amount"] Entry Centi
Amount,
   $sel:line30499_ChildrenNum:Page5PartB :: FieldConst Word
line30499_ChildrenNum = [Text] -> Entry Word -> FieldConst Word
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30500", Text
"Line7_ChildrenNum"] Entry Word
Count,
   $sel:line30500:Page5PartB :: FieldConst Centi
line30500 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30500", Text
"Line7_Amount"] Entry Centi
Amount,
   $sel:line_81:Page5PartB :: FieldConst Centi
line_81 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_81", Text
"Line30_Amount"] Entry Centi
Amount}
                                                                                           
page6Fields :: Page6 FieldConst
page6Fields = Page6 {
   $sel:line82:Page6 :: FieldConst Centi
line82 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_79", Text
"Line43Amount"] Entry Centi
Amount,
   $sel:line30800:Page6 :: FieldConst Centi
line30800 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"CPP_QPP_Sub", Text
"Line30800_Sub", Text
"Line8_Amount"] Entry Centi
Amount,
   $sel:line31000:Page6 :: FieldConst Centi
line31000 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"CPP_QPP_Sub", Text
"Line31000_Sub", Text
"Line9_Amount"] Entry Centi
Amount,
   $sel:line31200:Page6 :: FieldConst Centi
line31200 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"EIPremiums_Sub", Text
"Line31200_Sub", Text
"Line10_Amount"] Entry Centi
Amount,
   $sel:line31217:Page6 :: FieldConst Centi
line31217 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31217_Sub", Text
"Line11_Amount"] Entry Centi
Amount,
   $sel:line31220:Page6 :: FieldConst Centi
line31220 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31220_Sub", Text
"Line12_Amount"] Entry Centi
Amount,
   $sel:line31240:Page6 :: FieldConst Centi
line31240 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31240_Sub", Text
"Line13_Amount"] Entry Centi
Amount,
   $sel:line31260:Page6 :: FieldConst Centi
line31260 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31260_Sub", Text
"Line14_Amount"] Entry Centi
Amount,
   $sel:line31270:Page6 :: FieldConst Centi
line31270 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31270_Sub", Text
"Line15_Amount"] Entry Centi
Amount,
   $sel:line31285:Page6 :: FieldConst Centi
line31285 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31285_sub", Text
"Line16_Amount"] Entry Centi
Amount,
   $sel:line31300:Page6 :: FieldConst Centi
line31300 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31300_Sub", Text
"Line17_Amount"] Entry Centi
Amount,
   $sel:line31350:Page6 :: FieldConst Centi
line31350 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31350_Sub", Text
"Amount"] Entry Centi
Amount,
   $sel:line94_sum:Page6 :: FieldConst Centi
line94_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line93", Text
"Amount1"] Entry Centi
Amount,
   $sel:line94_cont:Page6 :: FieldConst Centi
line94_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line93", Text
"Amount2"] Entry Centi
Amount,
   $sel:line31400:Page6 :: FieldConst Centi
line31400 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31400_Sub", Text
"Line18_Amount"] Entry Centi
Amount,
   $sel:line96:Page6 :: FieldConst Centi
line96 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line95", Text
"Amount1"] Entry Centi
Amount,
   $sel:line31600:Page6 :: FieldConst Centi
line31600 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31600_Sub", Text
"Line19_Amount"] Entry Centi
Amount,
   $sel:line31800:Page6 :: FieldConst Centi
line31800 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31800_Sub", Text
"Line20_Amount"] Entry Centi
Amount,
   $sel:line99:Page6 :: FieldConst Centi
line99 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line98", Text
"Amount1"] Entry Centi
Amount,
   $sel:line31900:Page6 :: FieldConst Centi
line31900 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31900_Sub", Text
"Line21_Amount"] Entry Centi
Amount,
   $sel:line32300:Page6 :: FieldConst Centi
line32300 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32300_Sub", Text
"Line22_Amount"] Entry Centi
Amount,
   $sel:line32400:Page6 :: FieldConst Centi
line32400 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32400_Sub", Text
"Line23_Amount"] Entry Centi
Amount,
   $sel:line32600:Page6 :: FieldConst Centi
line32600 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32600_Sub", Text
"Line24_Amount"] Entry Centi
Amount,
   $sel:line104:Page6 :: FieldConst Centi
line104 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line103", Text
"Amount1"] Entry Centi
Amount,
   $sel:medical_expenses:Page6 :: MedicalExpenses FieldConst
medical_expenses = 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
page6MedicalExpensesFields,
   $sel:line33200_sum:Page6 :: FieldConst Centi
line33200_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33200_Sub", Text
"Line29_Amount1"] Entry Centi
Amount,
   $sel:line33200_cont:Page6 :: FieldConst Centi
line33200_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33200_Sub", Text
"Line29_Amount2"] Entry Centi
Amount,
   $sel:line33500:Page6 :: FieldConst Centi
line33500 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33500_Sub", Text
"Line30_Amount"] Entry Centi
Amount,
   $sel:line33800:Page6 :: FieldConst Centi
line33800 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33800_Sub", Text
"Line32_Amount"] Entry Centi
Amount,
   $sel:line34900:Page6 :: FieldConst Centi
line34900 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line34900_Sub", Text
"Line33_Amount"] Entry Centi
Amount,
   $sel:line35000:Page6 :: FieldConst Centi
line35000 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line35000_Sub", Text
"Line34_Amount"] Entry Centi
Amount}

page6MedicalExpensesFields :: MedicalExpenses FieldConst
page6MedicalExpensesFields = MedicalExpenses {
   $sel:familyExpenses:MedicalExpenses :: FieldConst Centi
familyExpenses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line104", Text
"Amount"] Entry Centi
Amount,
   $sel:taxableIncome:MedicalExpenses :: FieldConst Centi
taxableIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line105", Text
"Amount1"] Entry Centi
Amount,
   $sel:taxableIncomeFraction:MedicalExpenses :: FieldConst Centi
taxableIncomeFraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line105", Text
"Amount2"] Entry Centi
Amount,
   $sel:threshold:MedicalExpenses :: FieldConst Centi
threshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line26_Sub", Text
"Line26_Amount"] Entry Centi
Amount,
   $sel:difference:MedicalExpenses :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line27_Sub", Text
"Line27_Amount"] Entry Centi
Amount,
   $sel:otherDependants:MedicalExpenses :: FieldConst Centi
otherDependants = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33199_Sub", Text
"Line28_Amount"] Entry Centi
Amount}

page7Fields :: Page7 FieldConst
page7Fields = Page7 {
   $sel:partC_NetFederalTax:Page7 :: Page7PartC FieldConst
partC_NetFederalTax = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartC" (forall {a}. FieldConst a -> FieldConst a)
-> Page7PartC FieldConst -> Page7PartC 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) -> Page7PartC p -> Page7PartC q
Rank2.<$> Page7PartC FieldConst
partCFields,
   $sel:step6_RefundOrBalanceOwing:Page7 :: Page7Step6 FieldConst
step6_RefundOrBalanceOwing = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Step6" (forall {a}. FieldConst a -> FieldConst a)
-> Page7Step6 FieldConst -> Page7Step6 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) -> Page7Step6 p -> Page7Step6 q
Rank2.<$> Page7Step6 FieldConst
page7step6Fields}

partCFields :: Page7PartC FieldConst
partCFields = Page7PartC {
   $sel:line116:Page7PartC :: FieldConst Centi
line116 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line108_sub", Text
"Line43Amount"] Entry Centi
Amount,
   $sel:line40424:Page7PartC :: FieldConst Centi
line40424 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40424_Sub", Text
"Line44Amount"] Entry Centi
Amount,
   $sel:line40400:Page7PartC :: FieldConst Centi
line40400 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40400_Sub", Text
"Line45Amount1"] Entry Centi
Amount,
   $sel:line119:Page7PartC :: FieldConst Centi
line119 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line35000_sub", Text
"Line46Amount"] Entry Centi
Amount,
   $sel:line40425:Page7PartC :: FieldConst Centi
line40425 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40425_Sub", Text
"Line47Amount"] Entry Centi
Amount,
   $sel:line40427:Page7PartC :: FieldConst Centi
line40427 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40427_Sub", Text
"Line48Amount"] Entry Centi
Amount,
   $sel:line122_sum:Page7PartC :: FieldConst Centi
line122_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line114_sub", Text
"Line49Amount1"] Entry Centi
Amount,
   $sel:line122_cont:Page7PartC :: FieldConst Centi
line122_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line114_sub", Text
"Line49Amount2"] Entry Centi
Amount,
   $sel:line123:Page7PartC :: FieldConst Centi
line123 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line122", Text
"Amount"] Entry Centi
Amount,
   $sel:line124:Page7PartC :: FieldConst Centi
line124 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line123", Text
"Amount"] Entry Centi
Amount,
   $sel:line125:Page7PartC :: FieldConst Centi
line125 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line124", Text
"Amount"] Entry Centi
Amount,
   $sel:line40500:Page7PartC :: FieldConst Centi
line40500 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40500_sub", Text
"Line51Amount"] Entry Centi
Amount,
   $sel:line127:Page7PartC :: FieldConst Centi
line127 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40600_sub", Text
"Line52Amount"] Entry Centi
Amount,
   $sel:line128:Page7PartC :: FieldConst Centi
line128 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line127", Text
"Amount"] Entry Centi
Amount,
   $sel:line129:Page7PartC :: FieldConst Centi
line129 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line128", Text
"Amount"] Entry Centi
Amount,
   $sel:line130:Page7PartC :: FieldConst Centi
line130 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line129", Text
"Amount"] Entry Centi
Amount,
   $sel:line131:Page7PartC :: FieldConst Centi
line131 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line130", Text
"Amount"] Entry Centi
Amount,
   $sel:line40900:Page7PartC :: FieldConst Centi
line40900 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line131", Text
"F40900", Text
"Amount"] Entry Centi
Amount,
   $sel:line41000:Page7PartC :: FieldConst Centi
line41000 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line131", Text
"Amount"] Entry Centi
Amount,
   $sel:line41200:Page7PartC :: FieldConst Centi
line41200 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41200_sub", Text
"Line55Amount"] Entry Centi
Amount,
   $sel:line41300:Page7PartC :: FieldConst Centi
line41300 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41400_sub", Text
"Line56Amount1"] Entry Centi
Amount,
   $sel:line41400:Page7PartC :: FieldConst Centi
line41400 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41400_sub", Text
"Line56Amount2"] Entry Centi
Amount,
   $sel:line41600_sum:Page7PartC :: FieldConst Centi
line41600_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41600_sub", Text
"Line57Amount1"] Entry Centi
Amount,
   $sel:line41600_cont:Page7PartC :: FieldConst Centi
line41600_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41600_sub", Text
"Line57Amount2"] Entry Centi
Amount,
   $sel:line41700:Page7PartC :: FieldConst Centi
line41700 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41700_sub", Text
"Line58Amount"] Entry Centi
Amount,
   $sel:line41500:Page7PartC :: FieldConst Centi
line41500 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41500_sub", Text
"Line59Amount"] Entry Centi
Amount,
   $sel:line41800:Page7PartC :: FieldConst Centi
line41800 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41800_sub", Text
"Line61Amount"] Entry Centi
Amount,
   $sel:line42000:Page7PartC :: FieldConst Centi
line42000 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42000_sub", Text
"Line60Amount"] Entry Centi
Amount}

page7step6Fields :: Page7Step6 FieldConst
page7step6Fields = Page7Step6 {
   $sel:line140:Page7Step6 :: FieldConst Centi
line140 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_Y", Text
"Line_42120_Amount"] Entry Centi
Amount,
   $sel:line_42100_CPPContributions:Page7Step6 :: FieldConst Centi
line_42100_CPPContributions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_42100_CPPContributions", Text
"Line_42100_Amount"] Entry Centi
Amount,
   $sel:line_42120_EIPremiums:Page7Step6 :: FieldConst Centi
line_42120_EIPremiums = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_42120_EIPremiums", Text
"Line_42120_Amount"] Entry Centi
Amount,
   $sel:line_42200_SocialBenefits:Page7Step6 :: FieldConst Centi
line_42200_SocialBenefits = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_42200_SocialBenefits", Text
"Line_42200_Amount"] Entry Centi
Amount,
   $sel:line_42800_ProvTerrTax:Page7Step6 :: FieldConst Centi
line_42800_ProvTerrTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_42800_ProvTerrTax", Text
"Line_42800_Amount"] Entry Centi
Amount,
   $sel:line_43500_TotalPayable:Page7Step6 :: FieldConst Centi
line_43500_TotalPayable = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_43500_TotalPayable", Text
"Line_43500_Amount"] Entry Centi
Amount}
                                                                                           
page8Fields :: Page8 FieldConst
page8Fields = Page8 {
   $sel:step6_RefundOrBalanceOwing:Page8 :: Page8Step6 FieldConst
step6_RefundOrBalanceOwing = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Step6" (forall {a}. FieldConst a -> FieldConst a)
-> Page8Step6 FieldConst -> Page8Step6 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) -> Page8Step6 p -> Page8Step6 q
Rank2.<$> Page8Step6 FieldConst
page8step6Fields,
   $sel:line48400_Refund:Page8 :: FieldConst Centi
line48400_Refund = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line48400_48500", Text
"Line48400", Text
"Line_48400_Amount"] Entry Centi
Amount,
   $sel:line48500_BalanceOwing:Page8 :: FieldConst Centi
line48500_BalanceOwing = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line48400_48500", Text
"Line48500", Text
"Line_48500_Amount"] Entry Centi
Amount,
   $sel:telephone:Page8 :: FieldConst Centi
telephone = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Certification", Text
"Telephone"] Entry Centi
Amount,
   $sel:date:Page8 :: FieldConst Centi
date = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Certification", Text
"Date"] Entry Centi
Amount,
   $sel:taxPreparer:Page8 :: TaxPreparer FieldConst
taxPreparer = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Line_49000_IfFeeWasCharged" (forall {a}. FieldConst a -> FieldConst a)
-> TaxPreparer FieldConst -> TaxPreparer 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) -> TaxPreparer p -> TaxPreparer q
Rank2.<$> TaxPreparer FieldConst
taxPreparerFields,
   $sel:line_1_ONOpportunitiesFund:Page8 :: FieldConst Centi
line_1_ONOpportunitiesFund = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ONOpportunitiesFund2", Text
"Line_1", Text
"Amount"] Entry Centi
Amount,
   $sel:line_46500:Page8 :: FieldConst Centi
line_46500 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ONOpportunitiesFund2", Text
"Line_2", Text
"Amount"] Entry Centi
Amount,
   $sel:line_46600:Page8 :: FieldConst Centi
line_46600 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ONOpportunitiesFund2", Text
"Line_3", Text
"Amount"] Entry Centi
Amount}

page8step6Fields :: Page8Step6 FieldConst
page8step6Fields = Page8Step6 {
   $sel:line_43500_totalpayable:Page8Step6 :: FieldConst Centi
line_43500_totalpayable = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_43500_totalpayable", Text
"Line_42000_Amount"] Entry Centi
Amount,
   $sel:line_43700_Total_income_tax_ded:Page8Step6 :: FieldConst Centi
line_43700_Total_income_tax_ded = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"LIne_43700_Total_income_tax_ded", Text
"Line_43700_Amount"] Entry Centi
Amount,
   $sel:line_44000:Page8Step6 :: FieldConst Centi
line_44000 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_44000Sub", Text
"Line_44000_Amount"] Entry Centi
Amount,
   $sel:line_44800_CPPOverpayment:Page8Step6 :: FieldConst Centi
line_44800_CPPOverpayment = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_44800_CPPOverpayment", Text
"Line_44800_Amount"] Entry Centi
Amount,
   $sel:line_45000_EIOverpayment:Page8Step6 :: FieldConst Centi
line_45000_EIOverpayment = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_45000_EIOverpayment", Text
"Line_45000_Amount"] Entry Centi
Amount,
   $sel:line_45200_MedicalExpense:Page8Step6 :: FieldConst Centi
line_45200_MedicalExpense = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_45200_MedicalExpense", Text
"Line_45200_Amount"] Entry Centi
Amount,
   $sel:line_45300_CWB:Page8Step6 :: FieldConst Centi
line_45300_CWB = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_45300_CWB", Text
"Line_45300_Amount"] Entry Centi
Amount,
   $sel:line_45350_CTC:Page8Step6 :: FieldConst Centi
line_45350_CTC = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_45350_CTC", Text
"Line_45300_Amount"] Entry Centi
Amount,
   $sel:line_45400_InvestmentTaxCredit:Page8Step6 :: FieldConst Centi
line_45400_InvestmentTaxCredit = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_45400_InvestmentTaxCredit", Text
"Line_45400_Amount"] Entry Centi
Amount,
   $sel:line_45600_TrustTaxCredit:Page8Step6 :: FieldConst Centi
line_45600_TrustTaxCredit = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_45600_TrustTaxCredit", Text
"Line_45600_Amount"] Entry Centi
Amount,
   $sel:line_45700_GST_HST_Rebate:Page8Step6 :: FieldConst Centi
line_45700_GST_HST_Rebate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_45700_GST_HST_Rebate", Text
"Line_45700_Amount"] Entry Centi
Amount,
   $sel:line_46800:Page8Step6 :: FieldConst Centi
line_46800 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"EligibleEducatorSchoolSypplyTaxCredit", Text
"F46800", Text
"Amount"] Entry Centi
Amount,
   $sel:line_46900:Page8Step6 :: FieldConst Centi
line_46900 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"EligibleEducatorSchoolSypplyTaxCredit", Text
"Amount"] Entry Centi
Amount,
   $sel:line_47555_TaxPaid:Page8Step6 :: FieldConst Centi
line_47555_TaxPaid = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_47555_TaxPaid", Text
"Line_47600_Amount"] Entry Centi
Amount,
   $sel:line_47556:Page8Step6 :: FieldConst Centi
line_47556 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line159", Text
"Amount"] Entry Centi
Amount,
   $sel:line_47557:Page8Step6 :: FieldConst Centi
line_47557 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line160", Text
"Amount"] Entry Centi
Amount,
   $sel:line_47600_TaxPaid:Page8Step6 :: FieldConst Centi
line_47600_TaxPaid = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_47600_TaxPaid", Text
"Line_47600_Amount"] Entry Centi
Amount,
   $sel:line_47900_ProvTerrCredits:Page8Step6 :: FieldConst Centi
line_47900_ProvTerrCredits = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_47900_ProvTerrCredits", Text
"Line_47900_Amount"] Entry Centi
Amount,
   $sel:line_48200_sum:Page8Step6 :: FieldConst Centi
line_48200_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_48200_AddLines", Text
"Line_48200_Amount1"] Entry Centi
Amount,
   $sel:line_48200_cont:Page8Step6 :: FieldConst Centi
line_48200_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_48200_AddLines", Text
"Line_48200_Amount2"] Entry Centi
Amount,
   $sel:line164_Refund_or_BalanceOwing:Page8Step6 :: FieldConst Centi
line164_Refund_or_BalanceOwing = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line_162", Text
"Refund_or_BalanceOwing_Amount"] Entry Centi
Amount}

taxPreparerFields :: TaxPreparer FieldConst
taxPreparerFields = TaxPreparer {
   $sel:eFileNumber:TaxPreparer :: FieldConst Text
eFileNumber = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"EFileNumber_Comb", Text
"EFile"] Entry Text
Textual,
   $sel:nameOfPreparer:TaxPreparer :: FieldConst Text
nameOfPreparer = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"NameOfPreparer"] Entry Text
Textual,
   $sel:telephoneOfPreparer:TaxPreparer :: FieldConst Text
telephoneOfPreparer = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"TelephoneOfPreparer"] Entry Text
Textual,
   $sel:line49000_WasAFeeCharged:TaxPreparer :: FieldConst Bool
line49000_WasAFeeCharged = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line49000_CheckBoxGroup"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Entry Bool
Switch' Text
"Line49000_CheckBox_EN"}