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

module Tax.Canada.Province.MB.MB428.FieldNames (mb428Fields) where

import Data.Fixed (Centi)
import Rank2 qualified

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

mb428Fields :: MB428 FieldConst
mb428Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (forall {a}. FieldConst a -> FieldConst a)
-> MB428 FieldConst -> MB428 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) -> MB428 p -> MB428 q
Rank2.<$> MB428 {
   $sel:page1:MB428 :: Page1 FieldConst
page1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page1" (forall {a}. FieldConst a -> FieldConst a)
-> Page1 FieldConst -> Page1 FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page1 p -> Page1 q
Rank2.<$> Page1 FieldConst
page1Fields,
   $sel:page2:MB428 :: 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:MB428 :: Page3 FieldConst
page3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page3" (forall {a}. FieldConst a -> FieldConst a)
-> Page3 FieldConst -> Page3 FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page3 p -> Page3 q
Rank2.<$> Page3 FieldConst
page3Fields}


page1Fields :: Page1 FieldConst
page1Fields = Page1 {
   $sel:income:Page1 :: FieldConst Centi
income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
   $sel:partA:Page1 :: Page1PartA FieldConst
partA = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Table" (forall {a}. FieldConst a -> FieldConst a)
-> Page1PartA FieldConst -> Page1PartA FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page1PartA p -> Page1PartA q
Rank2.<$> Page1PartA FieldConst
page1PartAFields,
   $sel:partB:Page1 :: Page1PartB FieldConst
partB = Page1PartB FieldConst
page1PartBFields}

page1PartAFields :: Page1PartA FieldConst
page1PartAFields = Page1PartA {
   $sel:column1:Page1PartA :: TaxIncomeBracket FieldConst
column1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column1" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$> Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields      Centi
0  Rational
0.108      Centi
0,
   $sel:column2:Page1PartA :: TaxIncomeBracket FieldConst
column2 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column2" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$> Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields  Centi
36_842 Rational
0.1275 Centi
3_978.94,
   $sel:column3:Page1PartA :: TaxIncomeBracket FieldConst
column3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column3" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$> (Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields Centi
79_625 Rational
0.174  Centi
9_433.77)}

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

page1PartBFields :: Page1PartB FieldConst
page1PartBFields = Page1PartB {
   $sel:line9_basic:Page1PartB :: FieldConst Centi
line9_basic = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount"] Entry Centi
Amount,
   $sel:line10_age:Page1PartB :: FieldConst Centi
line10_age = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", Text
"Amount"] Entry Centi
Amount,
   $sel:spouseAmount:Page1PartB :: BaseCredit FieldConst
spouseAmount = BaseCredit{
       $sel:baseAmount:BaseCredit :: FieldConst Centi
baseAmount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line11", Text
"Amount"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
9_134 Entry Centi
Amount,
       $sel:reduction:BaseCredit :: FieldConst Centi
reduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line12", Text
"Amount"] Entry Centi
Amount,
       $sel:difference:BaseCredit :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"line13", Text
"Amount1"] Entry Centi
Amount,
       $sel:cont:BaseCredit :: FieldConst Centi
cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"line13", Text
"Amount2"] Entry Centi
Amount},
   $sel:dependantAmount:Page1PartB :: BaseCredit FieldConst
dependantAmount = BaseCredit{
       $sel:baseAmount:BaseCredit :: FieldConst Centi
baseAmount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line14", Text
"Amount"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
9_134 Entry Centi
Amount,
       $sel:reduction:BaseCredit :: FieldConst Centi
reduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line15", Text
"Amount"] Entry Centi
Amount,
       $sel:difference:BaseCredit :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount1"] Entry Centi
Amount,
       $sel:cont:BaseCredit :: FieldConst Centi
cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount2"] Entry Centi
Amount},
   $sel:line17_infirm:Page1PartB :: FieldConst Centi
line17_infirm = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", Text
"Amount"] Entry Centi
Amount,
   $sel:line18:Page1PartB :: FieldConst Centi
line18 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount"] Entry Centi
Amount,
   $sel:line19_cppQpp:Page1PartB :: FieldConst Centi
line19_cppQpp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line19", Text
"Amount"] Entry Centi
Amount,
   $sel:line20_cppQpp:Page1PartB :: FieldConst Centi
line20_cppQpp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Amount"] Entry Centi
Amount,
   $sel:line21_employmentInsurance:Page1PartB :: FieldConst Centi
line21_employmentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line21", Text
"Amount"] Entry Centi
Amount,
   $sel:line22_employmentInsurance:Page1PartB :: FieldConst Centi
line22_employmentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"Amount"] Entry Centi
Amount,
   $sel:line23_firefighters:Page1PartB :: FieldConst Centi
line23_firefighters = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount"] Entry Centi
Amount,
   $sel:line24_rescue:Page1PartB :: FieldConst Centi
line24_rescue = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Amount"] Entry Centi
Amount,
   $sel:line25_fitness:Page1PartB :: FieldConst Centi
line25_fitness = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line25", Text
"Amount"] Entry Centi
Amount,
   $sel:line26_arts:Page1PartB :: FieldConst Centi
line26_arts = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line26", Text
"Amount"] Entry Centi
Amount,
   $sel:line27_adoption:Page1PartB :: FieldConst Centi
line27_adoption = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line27", Text
"Amount"] Entry Centi
Amount,
   $sel:line28_sum:Page1PartB :: SubCalculation FieldConst
line28_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line28" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line29:Page1PartB :: FieldConst Centi
line29 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line29", Text
"Amount"] Entry Centi
Amount}

page2Fields :: Page2 FieldConst
page2Fields = Page2 {
  $sel:partB:Page2 :: Page2PartB FieldConst
partB = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartB" (forall {a}. FieldConst a -> FieldConst a)
-> Page2PartB FieldConst -> Page2PartB 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) -> Page2PartB p -> Page2PartB q
Rank2.<$> Page2PartB FieldConst
page2PartBFields}

page2PartBFields :: Page2PartB FieldConst
page2PartBFields = Page2PartB {
   $sel:line30:Page2PartB :: FieldConst Centi
line30 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30", Text
"Amount"] Entry Centi
Amount,
   $sel:line31_pension:Page2PartB :: FieldConst Centi
line31_pension = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31", Text
"Amount"] Entry Centi
Amount,
   $sel:line32_caregiver:Page2PartB :: FieldConst Centi
line32_caregiver = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32", Text
"Amount"] Entry Centi
Amount,
   $sel:line33:Page2PartB :: FieldConst Centi
line33 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33", Text
"Amount"] Entry Centi
Amount,
   $sel:line34_disability:Page2PartB :: FieldConst Centi
line34_disability = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line34", Text
"Amount"] Entry Centi
Amount,
   $sel:line35:Page2PartB :: FieldConst Centi
line35 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line35", Text
"Amount"] Entry Centi
Amount,
   $sel:line36:Page2PartB :: FieldConst Centi
line36 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36", Text
"Amount"] Entry Centi
Amount,
   $sel:line37_interest:Page2PartB :: FieldConst Centi
line37_interest = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line37", Text
"Amount"] Entry Centi
Amount,
   $sel:line38_education:Page2PartB :: FieldConst Centi
line38_education = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38", Text
"Amount"] Entry Centi
Amount,
   $sel:line39_transferredChild:Page2PartB :: FieldConst Centi
line39_transferredChild = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line39", Text
"Amount"] Entry Centi
Amount,
   $sel:line40_transferredSpouse:Page2PartB :: FieldConst Centi
line40_transferredSpouse = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40", Text
"Amount"] Entry Centi
Amount,
   $sel:line41_family:Page2PartB :: FieldConst Centi
line41_family = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41", Text
"Amount"] Entry Centi
Amount,
   $sel:line42_sum:Page2PartB :: FieldConst Centi
line42_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42", Text
"Amount"] Entry Centi
Amount,
   $sel:medicalExpenses:Page2PartB :: MedicalExpenses FieldConst
medicalExpenses = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"MedicalExpenses" (forall {a}. FieldConst a -> FieldConst a)
-> MedicalExpenses FieldConst -> MedicalExpenses FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> MedicalExpenses p -> MedicalExpenses q
Rank2.<$> MedicalExpenses FieldConst
medicalExpensesFields,
   $sel:line49:Page2PartB :: FieldConst Centi
line49 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line49", Text
"Amount"] Entry Centi
Amount,
   $sel:line50_sum:Page2PartB :: SubCalculation FieldConst
line50_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line50" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line51:Page2PartB :: FieldConst Centi
line51 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line51", Text
"Amount"] Entry Centi
Amount,
   $sel:line52_rate:Page2PartB :: FieldConst Rational
line52_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line52", Text
"Percent_ReadOnly"] (Entry Rational -> FieldConst Rational)
-> Entry Rational -> FieldConst Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Entry Rational -> Entry Rational
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Rational
0.108 Entry Rational
Percent,
   $sel:line53_fraction:Page2PartB :: FieldConst Centi
line53_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line53", Text
"Amount"] Entry Centi
Amount,
   $sel:donations:Page2PartB :: Donations FieldConst
donations = Donations FieldConst
donationFields,
   $sel:line56_sum:Page2PartB :: SubCalculation FieldConst
line56_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line56" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line57:Page2PartB :: FieldConst Centi
line57 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line57", Text
"Amount"] Entry Centi
Amount}

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

donationFields :: Donations FieldConst
donationFields = Donations {
   $sel:line54_base:Donations :: FieldConst Centi
line54_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line54", Text
"Amount1"] Entry Centi
Amount,
   $sel:line54_fraction:Donations :: FieldConst Centi
line54_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line54", Text
"Amount2"] Entry Centi
Amount,
   $sel:line55_base:Donations :: FieldConst Centi
line55_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line55", Text
"Amount1"] Entry Centi
Amount,
   $sel:line55_fraction:Donations :: FieldConst Centi
line55_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line55", Text
"Amount2"] Entry Centi
Amount}

page3Fields :: Page3 FieldConst
page3Fields = Page3 {
   $sel:partC:Page3 :: PartC FieldConst
partC = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartC" (forall {a}. FieldConst a -> FieldConst a)
-> PartC FieldConst -> PartC 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) -> PartC p -> PartC q
Rank2.<$> PartC FieldConst
partCFields}

partCFields :: PartC FieldConst
partCFields = PartC {
   $sel:line58_tax:PartC :: FieldConst Centi
line58_tax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line58", Text
"Amount"] Entry Centi
Amount,
   $sel:line59_splitIncomeTax:PartC :: FieldConst Centi
line59_splitIncomeTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line59", Text
"Amount"] Entry Centi
Amount,
   $sel:line60:PartC :: FieldConst Centi
line60 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line60", Text
"Amount"] Entry Centi
Amount,
   $sel:line61_copy:PartC :: FieldConst Centi
line61_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line61", Text
"Amount"] Entry Centi
Amount,
   $sel:line62_dividendCredits:PartC :: FieldConst Centi
line62_dividendCredits = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line62", Text
"Amount"] Entry Centi
Amount,
   $sel:line63_copy:PartC :: FieldConst Centi
line63_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line63", Text
"Amount1"] Entry Centi
Amount,
   $sel:line63_fraction:PartC :: FieldConst Centi
line63_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line63", Text
"Amount2"] Entry Centi
Amount,
   $sel:line64_sum:PartC :: SubCalculation FieldConst
line64_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line64" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line65_difference:PartC :: FieldConst Centi
line65_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line65", Text
"Amount"] Entry Centi
Amount,
   $sel:line66_fromT691:PartC :: FieldConst Centi
line66_fromT691 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Amount1"] Entry Centi
Amount,
   $sel:line66_fraction:PartC :: FieldConst Centi
line66_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Amount2"] Entry Centi
Amount,
   $sel:line67:PartC :: FieldConst Centi
line67 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line67", Text
"Amount"] Entry Centi
Amount,
   $sel:line68_political:PartC :: FieldConst Centi
line68_political = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line68", Text
"Amount"] Entry Centi
Amount,
   $sel:line69_political:PartC :: FieldConst Centi
line69_political = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line69", Text
"Amount"] Entry Centi
Amount,
   $sel:line70_difference:PartC :: FieldConst Centi
line70_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line70", Text
"Amount"] Entry Centi
Amount,
   $sel:line71_labour:PartC :: FieldConst Centi
line71_labour = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line71", Text
"Amount"] Entry Centi
Amount,
   $sel:line72_difference:PartC :: FieldConst Centi
line72_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line72", Text
"Amount"] Entry Centi
Amount,
   $sel:line73_foreignCredit:PartC :: FieldConst Centi
line73_foreignCredit = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line73", Text
"Amount"] Entry Centi
Amount,
   $sel:line74_difference:PartC :: FieldConst Centi
line74_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line74", Text
"Amount"] Entry Centi
Amount,
   $sel:line75_community:PartC :: FieldConst Centi
line75_community = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line75", Text
"Amount"] Entry Centi
Amount,
   $sel:line76_difference:PartC :: FieldConst Centi
line76_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line76", Text
"Amount"] Entry Centi
Amount,
   $sel:line77_venture:PartC :: FieldConst Centi
line77_venture = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line77", Text
"Amount"] Entry Centi
Amount,
   $sel:line78_difference:PartC :: FieldConst Centi
line78_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line78", Text
"Amount"] Entry Centi
Amount,
   $sel:line79_sharePurchase:PartC :: FieldConst Centi
line79_sharePurchase = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line79", Text
"Amount"] Entry Centi
Amount,
   $sel:line80_difference:PartC :: FieldConst Centi
line80_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line80", Text
"Amount"] Entry Centi
Amount,
   $sel:line81_mineral:PartC :: FieldConst Centi
line81_mineral = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line81", Text
"Amount"] Entry Centi
Amount,
   $sel:line82_tax:PartC :: FieldConst Centi
line82_tax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line82", Text
"Amount"] Entry Centi
Amount}