{-# 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 (Constant, Amount, Percent), FieldConst (Field), within)

mb428Fields :: MB428 FieldConst
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 {
   page1 :: 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,
   page2 :: 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,
   page3 :: 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 FieldConst
page1Fields = Page1 {
   income :: FieldConst Centi
income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
   partA :: 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,
   partB :: Page1PartB FieldConst
partB = Page1PartB FieldConst
page1PartBFields}

page1PartAFields :: Page1PartA FieldConst
page1PartAFields :: Page1PartA FieldConst
page1PartAFields = Page1PartA {
   column1 :: 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,
   column2 :: 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
47_000 Rational
0.1275   Centi
5076,
   column3 :: 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
100_000 Rational
0.174  Centi
11_833.5)}

taxIncomeBracketFields :: Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields :: Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields Centi
threshold Rational
rate Centi
baseTax = TaxIncomeBracket {
   income :: FieldConst Centi
income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount"] Entry Centi
Amount,
   threshold :: 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,
   overThreshold :: FieldConst Centi
overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line4", Text
"Amount"] Entry Centi
Amount,
   rate :: 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,
   timesRate :: FieldConst Centi
timesRate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"Amount"] Entry Centi
Amount,
   baseTax :: 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,
   equalsTax :: 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 FieldConst
page1PartBFields = Page1PartB {
   line9_basic :: FieldConst Centi
line9_basic = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount"] Entry Centi
Amount,
   line10_age :: FieldConst Centi
line10_age = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", Text
"Amount"] Entry Centi
Amount,
   spouseAmount :: BaseCredit FieldConst
spouseAmount = BaseCredit{
       baseAmount :: 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,
       reduction :: FieldConst Centi
reduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line12", Text
"Amount"] Entry Centi
Amount,
       difference :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"line13", Text
"Amount1"] Entry Centi
Amount,
       cont :: FieldConst Centi
cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"line13", Text
"Amount2"] Entry Centi
Amount},
   dependantAmount :: BaseCredit FieldConst
dependantAmount = BaseCredit{
       baseAmount :: 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,
       reduction :: FieldConst Centi
reduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line15", Text
"Amount"] Entry Centi
Amount,
       difference :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount1"] Entry Centi
Amount,
       cont :: FieldConst Centi
cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount2"] Entry Centi
Amount},
   line17_infirm :: FieldConst Centi
line17_infirm = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", Text
"Amount"] Entry Centi
Amount,
   line18 :: FieldConst Centi
line18 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount"] Entry Centi
Amount,
   line19_cppQpp :: FieldConst Centi
line19_cppQpp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line19", Text
"Amount"] Entry Centi
Amount,
   line20_cppQpp :: FieldConst Centi
line20_cppQpp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Amount"] Entry Centi
Amount,
   line21_employmentInsurance :: FieldConst Centi
line21_employmentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line21", Text
"Amount"] Entry Centi
Amount,
   line22_employmentInsurance :: FieldConst Centi
line22_employmentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"Amount"] Entry Centi
Amount,
   line23_firefighters :: FieldConst Centi
line23_firefighters = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount"] Entry Centi
Amount,
   line24_rescue :: FieldConst Centi
line24_rescue = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Amount"] Entry Centi
Amount,
   line25_fitness :: FieldConst Centi
line25_fitness = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line25", Text
"Amount"] Entry Centi
Amount,
   line26_arts :: FieldConst Centi
line26_arts = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line26", Text
"Amount"] Entry Centi
Amount,
   line27_adoption :: FieldConst Centi
line27_adoption = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line27", Text
"Amount"] Entry Centi
Amount,
   line28_sum :: SubCalculation FieldConst
line28_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line28" [Text
"Amount1"] [Text
"Amount2"],
   line29 :: 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 FieldConst
page2Fields = Page2 {
  partB :: 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 FieldConst
page2PartBFields = Page2PartB {
   line30 :: FieldConst Centi
line30 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30", Text
"Amount"] Entry Centi
Amount,
   line31_pension :: FieldConst Centi
line31_pension = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31", Text
"Amount"] Entry Centi
Amount,
   line32_caregiver :: FieldConst Centi
line32_caregiver = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32", Text
"Amount"] Entry Centi
Amount,
   line33 :: FieldConst Centi
line33 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33", Text
"Amount"] Entry Centi
Amount,
   line34_disability :: FieldConst Centi
line34_disability = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line34", Text
"Amount"] Entry Centi
Amount,
   line35 :: FieldConst Centi
line35 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line35", Text
"Amount"] Entry Centi
Amount,
   line36 :: FieldConst Centi
line36 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36", Text
"Amount"] Entry Centi
Amount,
   line37_interest :: FieldConst Centi
line37_interest = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line37", Text
"Amount"] Entry Centi
Amount,
   line38_education :: FieldConst Centi
line38_education = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38", Text
"Amount"] Entry Centi
Amount,
   line39_transferredChild :: FieldConst Centi
line39_transferredChild = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line39", Text
"Amount"] Entry Centi
Amount,
   line40_transferredSpouse :: FieldConst Centi
line40_transferredSpouse = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40", Text
"Amount"] Entry Centi
Amount,
   line41_family :: FieldConst Centi
line41_family = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41", Text
"Amount"] Entry Centi
Amount,
   line42_sum :: FieldConst Centi
line42_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42", Text
"Amount"] Entry Centi
Amount,
   medicalExpenses :: 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,
   line49 :: FieldConst Centi
line49 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line49", Text
"Amount"] Entry Centi
Amount,
   line50_sum :: SubCalculation FieldConst
line50_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line50" [Text
"Amount1"] [Text
"Amount2"],
   line51 :: FieldConst Centi
line51 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line51", Text
"Amount"] Entry Centi
Amount,
   line52_rate :: 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,
   line53_fraction :: FieldConst Centi
line53_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line53", Text
"Amount"] Entry Centi
Amount,
   donations :: Donations FieldConst
donations = Donations FieldConst
donationFields,
   line56_sum :: SubCalculation FieldConst
line56_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line56" [Text
"Amount1"] [Text
"Amount2"],
   line57 :: 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 FieldConst
medicalExpensesFields = MedicalExpenses {
   expenses :: FieldConst Centi
expenses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line43", Text
"Amount"] Entry Centi
Amount,
   netIncome :: FieldConst Centi
netIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line44", Text
"Amount"] Entry Centi
Amount,
   incomeRate :: 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,
   fraction :: FieldConst Centi
fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line46", Text
"Amount"] Entry Centi
Amount,
   lesser :: FieldConst Centi
lesser = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line47", Text
"Amount"] Entry Centi
Amount,
   difference :: 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 FieldConst
donationFields = Donations {
   line54_base :: FieldConst Centi
line54_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line54", Text
"Amount1"] Entry Centi
Amount,
   line54_fraction :: FieldConst Centi
line54_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line54", Text
"Amount2"] Entry Centi
Amount,
   line55_base :: FieldConst Centi
line55_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line55", Text
"Amount1"] Entry Centi
Amount,
   line55_fraction :: 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 FieldConst
page3Fields = Page3 {
   partC :: 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 FieldConst
partCFields = PartC {
   line58_tax :: FieldConst Centi
line58_tax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line58", Text
"Amount"] Entry Centi
Amount,
   line59_splitIncomeTax :: FieldConst Centi
line59_splitIncomeTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line59", Text
"Amount"] Entry Centi
Amount,
   line60 :: FieldConst Centi
line60 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line60", Text
"Amount"] Entry Centi
Amount,
   line61_copy :: FieldConst Centi
line61_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line61", Text
"Amount"] Entry Centi
Amount,
   line62_dividendCredits :: FieldConst Centi
line62_dividendCredits = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line62", Text
"Amount"] Entry Centi
Amount,
   line63_copy :: FieldConst Centi
line63_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line63", Text
"Amount1"] Entry Centi
Amount,
   line63_fraction :: FieldConst Centi
line63_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line63", Text
"Amount2"] Entry Centi
Amount,
   line64_sum :: SubCalculation FieldConst
line64_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line64" [Text
"Amount1"] [Text
"Amount2"],
   line65_difference :: FieldConst Centi
line65_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line65", Text
"Amount"] Entry Centi
Amount,
   line66_fromT691 :: FieldConst Centi
line66_fromT691 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Amount1"] Entry Centi
Amount,
   line66_fraction :: FieldConst Centi
line66_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Amount2"] Entry Centi
Amount,
   line67 :: FieldConst Centi
line67 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line67", Text
"Amount"] Entry Centi
Amount,
   line68_political :: FieldConst Centi
line68_political = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line68", Text
"Amount"] Entry Centi
Amount,
   line69_political :: FieldConst Centi
line69_political = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line69", Text
"Amount"] Entry Centi
Amount,
   line70_difference :: FieldConst Centi
line70_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line70", Text
"Amount"] Entry Centi
Amount,
   line71_labour :: FieldConst Centi
line71_labour = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line71", Text
"Amount"] Entry Centi
Amount,
   line72_difference :: FieldConst Centi
line72_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line72", Text
"Amount"] Entry Centi
Amount,
   line73_foreignCredit :: FieldConst Centi
line73_foreignCredit = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line73", Text
"Amount"] Entry Centi
Amount,
   line74_difference :: FieldConst Centi
line74_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line74", Text
"Amount"] Entry Centi
Amount,
   line75_community :: FieldConst Centi
line75_community = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line75", Text
"Amount"] Entry Centi
Amount,
   line76_difference :: FieldConst Centi
line76_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line76", Text
"Amount"] Entry Centi
Amount,
   line77_venture :: FieldConst Centi
line77_venture = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line77", Text
"Amount"] Entry Centi
Amount,
   line78_difference :: FieldConst Centi
line78_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line78", Text
"Amount"] Entry Centi
Amount,
   line79_sharePurchase :: FieldConst Centi
line79_sharePurchase = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line79", Text
"Amount"] Entry Centi
Amount,
   line80_difference :: FieldConst Centi
line80_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line80", Text
"Amount"] Entry Centi
Amount,
   line81_mineral :: FieldConst Centi
line81_mineral = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line81", Text
"Amount"] Entry Centi
Amount,
   line82_tax :: FieldConst Centi
line82_tax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line82", Text
"Amount"] Entry Centi
Amount}