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

-- | The T1 form type, shared by all provinces and territories
module Tax.Canada.T1.Types where

import Data.Fixed (Centi)
import Data.Monoid (Ap(Ap, getAp))
import Data.Text (Text)
import Data.Time (Day)
import Data.CAProvinceCodes qualified as Province
import Language.Haskell.TH qualified as TH
import Rank2.TH qualified
import Transformation.Shallow.TH qualified

import Tax.Canada.Shared (SubCalculation)
import Tax.Canada.Shared (TaxIncomeBracket)

data T1 line = T1 {
   forall (line :: * -> *). T1 line -> Page1 line
page1 :: Page1 line,
   forall (line :: * -> *). T1 line -> Page2 line
page2 :: Page2 line,
   forall (line :: * -> *). T1 line -> Page3 line
page3 :: Page3 line,
   forall (line :: * -> *). T1 line -> Page4 line
page4 :: Page4 line,
   forall (line :: * -> *). T1 line -> Page5 line
page5 :: Page5 line,
   forall (line :: * -> *). T1 line -> Page6 line
page6 :: Page6 line,
   forall (line :: * -> *). T1 line -> Page7 line
page7 :: Page7 line,
   forall (line :: * -> *). T1 line -> Page8 line
page8 :: Page8 line}

data Page1 line = Page1 {
   forall (line :: * -> *). Page1 line -> Identification line
identification :: Identification line,
   forall (line :: * -> *). Page1 line -> Residence line
residence :: Residence line,
   forall (line :: * -> *). Page1 line -> Spouse line
spouse :: Spouse line}

data Identification line = Identification {
   forall (line :: * -> *). Identification line -> line Text
emailAddress :: line Text,
   forall (line :: * -> *). Identification line -> line Day
dateDeath :: line Day,
   forall (line :: * -> *). Identification line -> line Text
postalCode :: line Text,
   forall (line :: * -> *).
Identification line -> line LanguageOfCorrespondence
your_Language :: line LanguageOfCorrespondence,
   forall (line :: * -> *). Identification line -> line Text
id_City :: line Text,
   forall (line :: * -> *). Identification line -> line Text
sin :: line Text,
   forall (line :: * -> *). Identification line -> line Text
id_LastName :: line Text,
   forall (line :: * -> *). Identification line -> line Day
dateBirth :: line Day,
   forall (line :: * -> *). Identification line -> line Text
id_FirstNameInitial :: line Text,
   forall (line :: * -> *). Identification line -> line Text
id_MailingAddress :: line Text,
   forall (line :: * -> *). Identification line -> line MaritalStatus
maritalStatus :: line MaritalStatus,
   forall (line :: * -> *). Identification line -> line Text
id_RuralRoute :: line Text,
   forall (line :: * -> *). Identification line -> line Text
id_POBox :: line Text,
   forall (line :: * -> *). Identification line -> line Code
prov_DropDown :: line Province.Code}

data LanguageOfCorrespondence = English | French deriving (LanguageOfCorrespondence
LanguageOfCorrespondence
-> LanguageOfCorrespondence -> Bounded LanguageOfCorrespondence
forall a. a -> a -> Bounded a
$cminBound :: LanguageOfCorrespondence
minBound :: LanguageOfCorrespondence
$cmaxBound :: LanguageOfCorrespondence
maxBound :: LanguageOfCorrespondence
Bounded, LanguageOfCorrespondence -> LanguageOfCorrespondence -> Bool
(LanguageOfCorrespondence -> LanguageOfCorrespondence -> Bool)
-> (LanguageOfCorrespondence -> LanguageOfCorrespondence -> Bool)
-> Eq LanguageOfCorrespondence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LanguageOfCorrespondence -> LanguageOfCorrespondence -> Bool
== :: LanguageOfCorrespondence -> LanguageOfCorrespondence -> Bool
$c/= :: LanguageOfCorrespondence -> LanguageOfCorrespondence -> Bool
/= :: LanguageOfCorrespondence -> LanguageOfCorrespondence -> Bool
Eq, Int -> LanguageOfCorrespondence
LanguageOfCorrespondence -> Int
LanguageOfCorrespondence -> [LanguageOfCorrespondence]
LanguageOfCorrespondence -> LanguageOfCorrespondence
LanguageOfCorrespondence
-> LanguageOfCorrespondence -> [LanguageOfCorrespondence]
LanguageOfCorrespondence
-> LanguageOfCorrespondence
-> LanguageOfCorrespondence
-> [LanguageOfCorrespondence]
(LanguageOfCorrespondence -> LanguageOfCorrespondence)
-> (LanguageOfCorrespondence -> LanguageOfCorrespondence)
-> (Int -> LanguageOfCorrespondence)
-> (LanguageOfCorrespondence -> Int)
-> (LanguageOfCorrespondence -> [LanguageOfCorrespondence])
-> (LanguageOfCorrespondence
    -> LanguageOfCorrespondence -> [LanguageOfCorrespondence])
-> (LanguageOfCorrespondence
    -> LanguageOfCorrespondence -> [LanguageOfCorrespondence])
-> (LanguageOfCorrespondence
    -> LanguageOfCorrespondence
    -> LanguageOfCorrespondence
    -> [LanguageOfCorrespondence])
-> Enum LanguageOfCorrespondence
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LanguageOfCorrespondence -> LanguageOfCorrespondence
succ :: LanguageOfCorrespondence -> LanguageOfCorrespondence
$cpred :: LanguageOfCorrespondence -> LanguageOfCorrespondence
pred :: LanguageOfCorrespondence -> LanguageOfCorrespondence
$ctoEnum :: Int -> LanguageOfCorrespondence
toEnum :: Int -> LanguageOfCorrespondence
$cfromEnum :: LanguageOfCorrespondence -> Int
fromEnum :: LanguageOfCorrespondence -> Int
$cenumFrom :: LanguageOfCorrespondence -> [LanguageOfCorrespondence]
enumFrom :: LanguageOfCorrespondence -> [LanguageOfCorrespondence]
$cenumFromThen :: LanguageOfCorrespondence
-> LanguageOfCorrespondence -> [LanguageOfCorrespondence]
enumFromThen :: LanguageOfCorrespondence
-> LanguageOfCorrespondence -> [LanguageOfCorrespondence]
$cenumFromTo :: LanguageOfCorrespondence
-> LanguageOfCorrespondence -> [LanguageOfCorrespondence]
enumFromTo :: LanguageOfCorrespondence
-> LanguageOfCorrespondence -> [LanguageOfCorrespondence]
$cenumFromThenTo :: LanguageOfCorrespondence
-> LanguageOfCorrespondence
-> LanguageOfCorrespondence
-> [LanguageOfCorrespondence]
enumFromThenTo :: LanguageOfCorrespondence
-> LanguageOfCorrespondence
-> LanguageOfCorrespondence
-> [LanguageOfCorrespondence]
Enum, Int -> LanguageOfCorrespondence -> ShowS
[LanguageOfCorrespondence] -> ShowS
LanguageOfCorrespondence -> String
(Int -> LanguageOfCorrespondence -> ShowS)
-> (LanguageOfCorrespondence -> String)
-> ([LanguageOfCorrespondence] -> ShowS)
-> Show LanguageOfCorrespondence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LanguageOfCorrespondence -> ShowS
showsPrec :: Int -> LanguageOfCorrespondence -> ShowS
$cshow :: LanguageOfCorrespondence -> String
show :: LanguageOfCorrespondence -> String
$cshowList :: [LanguageOfCorrespondence] -> ShowS
showList :: [LanguageOfCorrespondence] -> ShowS
Show)

data MaritalStatus = Married | LivingCommonLaw | Widowed | Divorced | Separated | Single
   deriving (MaritalStatus
MaritalStatus -> MaritalStatus -> Bounded MaritalStatus
forall a. a -> a -> Bounded a
$cminBound :: MaritalStatus
minBound :: MaritalStatus
$cmaxBound :: MaritalStatus
maxBound :: MaritalStatus
Bounded, MaritalStatus -> MaritalStatus -> Bool
(MaritalStatus -> MaritalStatus -> Bool)
-> (MaritalStatus -> MaritalStatus -> Bool) -> Eq MaritalStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaritalStatus -> MaritalStatus -> Bool
== :: MaritalStatus -> MaritalStatus -> Bool
$c/= :: MaritalStatus -> MaritalStatus -> Bool
/= :: MaritalStatus -> MaritalStatus -> Bool
Eq, Int -> MaritalStatus
MaritalStatus -> Int
MaritalStatus -> [MaritalStatus]
MaritalStatus -> MaritalStatus
MaritalStatus -> MaritalStatus -> [MaritalStatus]
MaritalStatus -> MaritalStatus -> MaritalStatus -> [MaritalStatus]
(MaritalStatus -> MaritalStatus)
-> (MaritalStatus -> MaritalStatus)
-> (Int -> MaritalStatus)
-> (MaritalStatus -> Int)
-> (MaritalStatus -> [MaritalStatus])
-> (MaritalStatus -> MaritalStatus -> [MaritalStatus])
-> (MaritalStatus -> MaritalStatus -> [MaritalStatus])
-> (MaritalStatus
    -> MaritalStatus -> MaritalStatus -> [MaritalStatus])
-> Enum MaritalStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MaritalStatus -> MaritalStatus
succ :: MaritalStatus -> MaritalStatus
$cpred :: MaritalStatus -> MaritalStatus
pred :: MaritalStatus -> MaritalStatus
$ctoEnum :: Int -> MaritalStatus
toEnum :: Int -> MaritalStatus
$cfromEnum :: MaritalStatus -> Int
fromEnum :: MaritalStatus -> Int
$cenumFrom :: MaritalStatus -> [MaritalStatus]
enumFrom :: MaritalStatus -> [MaritalStatus]
$cenumFromThen :: MaritalStatus -> MaritalStatus -> [MaritalStatus]
enumFromThen :: MaritalStatus -> MaritalStatus -> [MaritalStatus]
$cenumFromTo :: MaritalStatus -> MaritalStatus -> [MaritalStatus]
enumFromTo :: MaritalStatus -> MaritalStatus -> [MaritalStatus]
$cenumFromThenTo :: MaritalStatus -> MaritalStatus -> MaritalStatus -> [MaritalStatus]
enumFromThenTo :: MaritalStatus -> MaritalStatus -> MaritalStatus -> [MaritalStatus]
Enum, Int -> MaritalStatus -> ShowS
[MaritalStatus] -> ShowS
MaritalStatus -> String
(Int -> MaritalStatus -> ShowS)
-> (MaritalStatus -> String)
-> ([MaritalStatus] -> ShowS)
-> Show MaritalStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaritalStatus -> ShowS
showsPrec :: Int -> MaritalStatus -> ShowS
$cshow :: MaritalStatus -> String
show :: MaritalStatus -> String
$cshowList :: [MaritalStatus] -> ShowS
showList :: [MaritalStatus] -> ShowS
Show)

data Residence line = Residence {
   forall (line :: * -> *). Residence line -> line Text
prov_DropDown :: line Text,
   forall (line :: * -> *). Residence line -> line Code
prov_DropDown_Business :: line Province.Code,
   forall (line :: * -> *). Residence line -> line Code
prov_DropDown_Residence :: line Province.Code,
   forall (line :: * -> *). Residence line -> line Day
date_Departure :: line Day,
   forall (line :: * -> *). Residence line -> line Day
date_Entry :: line Day}

data Spouse line = Spouse {
   forall (line :: * -> *). Spouse line -> line Centi
line23600 :: line Centi,
   forall (line :: * -> *). Spouse line -> line Bool
self_employment :: line Bool,
   forall (line :: * -> *). Spouse line -> line Text
spouse_First_Name :: line Text,
   forall (line :: * -> *). Spouse line -> line Centi
line11700 :: line Centi,
   forall (line :: * -> *). Spouse line -> line Centi
line21300 :: line Centi,
   forall (line :: * -> *). Spouse line -> line Text
sin :: line Text}

data Page2 line = Page2 {
   forall (line :: * -> *). Page2 line -> line Bool
foreign_property :: line Bool,
   forall (line :: * -> *). Page2 line -> line Bool
tax_exempt :: line Bool,
   forall (line :: * -> *). Page2 line -> ElectionsCanada line
electionsCanada :: ElectionsCanada line,
   forall (line :: * -> *). Page2 line -> line Bool
cai :: line Bool,
   forall (line :: * -> *). Page2 line -> line Bool
organ_donor :: line Bool}

data ElectionsCanada line = ElectionsCanada {
   forall (line :: * -> *). ElectionsCanada line -> line Bool
citizenship :: line Bool,
   forall (line :: * -> *). ElectionsCanada line -> line Bool
authorization :: line Bool
   }

data Page3 line = Page3 {
   forall (line :: * -> *). Page3 line -> line Centi
line_10100_EmploymentIncome :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_10105_Taxexemptamount :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_10120_Commissions :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_10130_sf :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_10400_OtherEmploymentIncome :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_11300_OldAgeSecurityPension :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_11400_CPP_QPP :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_11410_DisabilityBenefits :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_11500_OtherPensions :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_11600_ElectedSplitPension :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_11700_UCCB :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_11701_UCCBDesignated :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_11900_EmploymentInsurance :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_11905_Employmentmaternity :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12000_TaxableDividends :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12010_OtherTaxableDividends :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12100_InvestmentIncome :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12200_PartnershipIncome :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12500_RDSP :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12599_12600_RentalIncome :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12600_Amount :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12700_TaxableCapitalGains :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12799_Amount :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12800_Amount :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12900_RRSPIncome :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12905_FHSAIncome :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_12906_OtherFHSAIncome :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_13000_OtherIncome :: line Centi,
   forall (line :: * -> *). Page3 line -> line Text
line_13000_OtherIncomeSource :: line Text,
   forall (line :: * -> *). Page3 line -> line Centi
line_13010_TaxableScholarship :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_19 :: line Centi,
   forall (line :: * -> *). Page3 line -> SelfEmploymentIncome line
selfEmployment :: SelfEmploymentIncome line,
   forall (line :: * -> *). Page3 line -> SubCalculation line
line_25_sum :: SubCalculation line,
   forall (line :: * -> *). Page3 line -> line Centi
line_26 :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_14400_WorkersCompBen :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_14500_SocialAssistPay :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_14600_NetFedSupplements :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_14700_EqualsAmount :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_14700_PlusAmount :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line_15000_TotalIncome :: line Centi}

data SelfEmploymentIncome line = SelfEmploymentIncome {
   forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
line_13499_Amount :: line Centi,
   forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
line_13500_Amount :: line Centi,
   forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
line_13699_Amount :: line Centi,
   forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
line_13700_Amount :: line Centi,
   forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
line_13899_Amount :: line Centi,
   forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
line_13900_Amount :: line Centi,
   forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
line_14099_Amount :: line Centi,
   forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
line_14100_Amount :: line Centi,
   forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
line_14299_Amount :: line Centi,
   forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
line_14300_Amount :: line Centi}

data Page4 line = Page4 {
   forall (line :: * -> *). Page4 line -> line Centi
line_15000_TotalIncome_2 :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_20600_PensionAdjustment :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_20700_RPPDeduction :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_20800_RRSPDeduction :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_20805_FHSADeduction :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_20810_PRPP :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_21000_SplitPensionDeduction :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_21200_Dues :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_21300_UCCBRepayment :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_21400_ChildCareExpenses :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_21500_DisabilityDeduction :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_21699_Amount :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_21700_Amount :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_21900_MovingExpenses :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_21999_Amount :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_22000_Amount :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_22100_CarryingChargesInterest :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_22200_CPP_QPP_Contributions :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_22215_DeductionCPP_QPP :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_22300_DeductionPPIP :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_22400_XplorationDevExpenses :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_22900_OtherEmployExpenses :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_23100_ClergyResDeduction :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_23200_OtherDeductions :: line Centi,
   forall (line :: * -> *). Page4 line -> line Text
line_23200_Specify :: line Text,
   forall (line :: * -> *). Page4 line -> SubCalculation line
line_23300_sum :: SubCalculation line,
   forall (line :: * -> *). Page4 line -> line Centi
line_23400_NetBeforeAdjust :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_23500_SocialBenefits :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_23600_NetIncome :: line Centi}

data Page5 line = Page5 {
   forall (line :: * -> *). Page5 line -> Step4 line
step4_TaxableIncome :: Step4 line,
   forall (line :: * -> *). Page5 line -> Page5PartA line
partA_FederalTax :: Page5PartA line,
   forall (line :: * -> *). Page5 line -> Page5PartB line
partB_FederalTaxCredits :: Page5PartB line}

data Step4 line = Step4 {
   forall (line :: * -> *). Step4 line -> line Centi
line_23600_NetIncome_2 :: line Centi,
   forall (line :: * -> *). Step4 line -> line Centi
line_24400_MilitaryPoliceDeduction :: line Centi,
   forall (line :: * -> *). Step4 line -> line Centi
line_24900_SecurityDeductions :: line Centi,
   forall (line :: * -> *). Step4 line -> line Centi
line_25000_OtherPayDeductions :: line Centi,
   forall (line :: * -> *). Step4 line -> line Centi
line_25100_PartnershipLosses :: line Centi,
   forall (line :: * -> *). Step4 line -> line Centi
line_25200_NoncapitalLosses :: line Centi,
   forall (line :: * -> *). Step4 line -> line Centi
line_25300_NetCapitalLosses :: line Centi,
   forall (line :: * -> *). Step4 line -> line Centi
line_25400_CapitalGainsDeduction :: line Centi,
   forall (line :: * -> *). Step4 line -> line Centi
line_25500_NorthernDeductions :: line Centi,
   forall (line :: * -> *). Step4 line -> line Centi
line_25600_AdditionalDeductions_Amount :: line Centi,
   forall (line :: * -> *). Step4 line -> line Text
line_25600_AdditionalDeductions_Specify :: line Text,
   forall (line :: * -> *). Step4 line -> SubCalculation line
line_25700_AddLines_sum :: SubCalculation line,
   forall (line :: * -> *). Step4 line -> line Centi
line_26000_TaxableIncome :: line Centi}

data Page5PartA line = Page5PartA {
   forall (line :: * -> *). Page5PartA line -> TaxIncomeBracket line
column1 :: TaxIncomeBracket line,
   forall (line :: * -> *). Page5PartA line -> TaxIncomeBracket line
column2 :: TaxIncomeBracket line,
   forall (line :: * -> *). Page5PartA line -> TaxIncomeBracket line
column3 :: TaxIncomeBracket line,
   forall (line :: * -> *). Page5PartA line -> TaxIncomeBracket line
column4 :: TaxIncomeBracket line,
   forall (line :: * -> *). Page5PartA line -> TaxIncomeBracket line
column5 :: TaxIncomeBracket line}

data Page5PartB line = Page5PartB {
   forall (line :: * -> *). Page5PartB line -> line Centi
line30000 :: line Centi,
   forall (line :: * -> *). Page5PartB line -> line Centi
line30100 :: line Centi,
   forall (line :: * -> *). Page5PartB line -> line Centi
line30300 :: line Centi,
   forall (line :: * -> *). Page5PartB line -> line Centi
line30400 :: line Centi,
   forall (line :: * -> *). Page5PartB line -> line Centi
line30425 :: line Centi,
   forall (line :: * -> *). Page5PartB line -> line Centi
line30450 :: line Centi,
   forall (line :: * -> *). Page5PartB line -> line Word
line30499_ChildrenNum :: line Word,
   forall (line :: * -> *). Page5PartB line -> line Centi
line30500 :: line Centi,
   forall (line :: * -> *). Page5PartB line -> line Centi
line_81 :: line Centi}

data Page6 line = Page6 {
   forall (line :: * -> *). Page6 line -> line Centi
line82 :: line Centi,
   -- CPP_QPP
   forall (line :: * -> *). Page6 line -> line Centi
line30800 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31000 :: line Centi,
   -- EI
   forall (line :: * -> *). Page6 line -> line Centi
line31200 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31205 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31210 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31215 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31217 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31220 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31240 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31260 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31270 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31285 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31300 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31350 :: line Centi,
   forall (line :: * -> *). Page6 line -> SubCalculation line
line94_sum :: SubCalculation line,
   forall (line :: * -> *). Page6 line -> line Centi
line31400 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line96 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31600 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31800 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line99 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line31900 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line32300 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line32400 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line32600 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line104 :: line Centi,
   forall (line :: * -> *). Page6 line -> MedicalExpenses line
medical_expenses :: MedicalExpenses line,
   forall (line :: * -> *). Page6 line -> SubCalculation line
line33200_sum :: SubCalculation line,
   forall (line :: * -> *). Page6 line -> line Centi
line33500 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Rational
line112 :: line Rational,
   forall (line :: * -> *). Page6 line -> line Centi
line33800 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line34900 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line35000 :: line Centi}

data MedicalExpenses line = MedicalExpenses {
   forall (line :: * -> *). MedicalExpenses line -> line Centi
familyExpenses :: line Centi,
   forall (line :: * -> *). MedicalExpenses line -> line Centi
taxableIncome :: line Centi,
   forall (line :: * -> *). MedicalExpenses line -> line Centi
taxableIncomeFraction :: line Centi,
   forall (line :: * -> *). MedicalExpenses line -> line Centi
threshold :: line Centi,
   forall (line :: * -> *). MedicalExpenses line -> line Centi
difference :: line Centi,
   forall (line :: * -> *). MedicalExpenses line -> line Centi
otherDependants :: line Centi}

data Page7 line = Page7 {
   forall (line :: * -> *). Page7 line -> Page7PartC line
partC_NetFederalTax :: Page7PartC line,
   forall (line :: * -> *). Page7 line -> Page7Step6 line
step6_RefundOrBalanceOwing :: Page7Step6 line}

data Page7PartC line = Page7PartC {
   forall (line :: * -> *). Page7PartC line -> line Centi
line116 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line40424 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line40400 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line119 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line40425 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line40427 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> SubCalculation line
line122_sum :: SubCalculation line,
   forall (line :: * -> *). Page7PartC line -> line Centi
line42900 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line124 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line125 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line40500 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line127 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line128 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line129 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line130 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line40600 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line40900 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line41000 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line41200 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line41300 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line41400 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> SubCalculation line
line41600_sum :: SubCalculation line,
   forall (line :: * -> *). Page7PartC line -> line Centi
line41700 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line41500 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line41800 :: line Centi,
   forall (line :: * -> *). Page7PartC line -> line Centi
line42000 :: line Centi}

data Page7Step6 line = Page7Step6 {
   forall (line :: * -> *). Page7Step6 line -> line Centi
line140 :: line Centi,
   forall (line :: * -> *). Page7Step6 line -> line Centi
line_42100_CPPContributions :: line Centi,
   forall (line :: * -> *). Page7Step6 line -> line Centi
line_42120_EIPremiums :: line Centi,
   forall (line :: * -> *). Page7Step6 line -> line Centi
line_42200_SocialBenefits :: line Centi,
   forall (line :: * -> *). Page7Step6 line -> line Centi
line_42800_ProvTerrTax :: line Centi,
   forall (line :: * -> *). Page7Step6 line -> line Centi
line_43200_FirstNationsTax :: line Centi,
   forall (line :: * -> *). Page7Step6 line -> line Centi
line_43500_TotalPayable :: line Centi}

data Page8 line = Page8 {
   forall (line :: * -> *). Page8 line -> Page8Step6 line
step6_RefundOrBalanceOwing :: Page8Step6 line,
   forall (line :: * -> *). Page8 line -> line Centi
line48400_Refund :: line Centi,
   forall (line :: * -> *). Page8 line -> line Centi
line48500_BalanceOwing :: line Centi,
   forall (line :: * -> *). Page8 line -> line Centi
telephone :: line Centi,
   forall (line :: * -> *). Page8 line -> line Centi
date :: line Centi,
   forall (line :: * -> *). Page8 line -> TaxPreparer line
taxPreparer :: TaxPreparer line,
   forall (line :: * -> *). Page8 line -> line Centi
line_1_ONOpportunitiesFund :: line Centi,
   forall (line :: * -> *). Page8 line -> line Centi
line_46500 :: line Centi,
   forall (line :: * -> *). Page8 line -> line Centi
line_46600 :: line Centi}

data Page8Step6 line = Page8Step6 {
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_43500_totalpayable :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_43700_Total_income_tax_ded :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_43800_TaxTransferQC :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> SubCalculation line
line_43850_diff :: SubCalculation line,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_42900_copy :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_44000 :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_44100 :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_44800_CPPOverpayment :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_45000_EIOverpayment :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_31210_copy :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> SubCalculation line
line_45100_diff :: SubCalculation line,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_45200_MedicalExpense :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_45300_CWB :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_45350_CTC :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_45355_MHRTC :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_45400_InvestmentTaxCredit :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_45600_TrustTaxCredit :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_45700_GST_HST_Rebate :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_46800 :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_46900 :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_47555_TaxPaid :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_47556 :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_47557 :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_47600_TaxPaid :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line_47900_ProvTerrCredits :: line Centi,
   forall (line :: * -> *). Page8Step6 line -> SubCalculation line
line_48200_sum :: SubCalculation line,
   forall (line :: * -> *). Page8Step6 line -> line Centi
line164_Refund_or_BalanceOwing :: line Centi}

data TaxPreparer line = TaxPreparer {
   forall (line :: * -> *). TaxPreparer line -> line Text
eFileNumber :: line Text,
   forall (line :: * -> *). TaxPreparer line -> line Text
nameOfPreparer :: line Text,
   forall (line :: * -> *). TaxPreparer line -> line Text
telephoneOfPreparer :: line Text,
   forall (line :: * -> *). TaxPreparer line -> line Bool
line49000_WasAFeeCharged :: line Bool}

$(foldMap
   (\t-> concat <$> sequenceA [
       [d|
           deriving instance (Show (line Bool), Show (line Centi), Show (line Word), Show (line Text),
                              Show (line Rational), Show (line Province.Code), Show (line Day),
                              Show (line LanguageOfCorrespondence), Show (line MaritalStatus))
                          => Show ($(TH.conT t) line)
           deriving instance (Eq (line Bool), Eq (line Centi), Eq (line Word), Eq (line Text),
                              Eq (line Rational), Eq (line Province.Code), Eq (line Day),
                              Eq (line LanguageOfCorrespondence), Eq (line MaritalStatus))
                          => Eq ($(TH.conT t) line)
       |],
       Rank2.TH.deriveAll t,
       Transformation.Shallow.TH.deriveAll t])
   [''T1, ''ElectionsCanada, ''Identification, ''MedicalExpenses,
    ''Page1, ''Page2, ''Page3, ''Page4, ''Page5, ''Page6, ''Page7, ''Page8,
    ''Step4, ''Page5PartA, ''Page5PartB, ''Page7PartC, ''Page7Step6, ''Page8Step6,
    ''Residence, ''Spouse, ''SelfEmploymentIncome, ''TaxPreparer])