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

module Tax.Canada.Province.ON.ON479.FieldNames (on479Fields) where

import Data.Fixed (Centi)
import Rank2 qualified

import Tax.Canada.Province.ON.ON479.Types
import Tax.Canada.Shared (subCalculationFields)
import Tax.FDF (Entry (Count, Constant, Amount, Percent, RadioButton, Textual), FieldConst (Field), within)

on479Fields :: ON479 FieldConst
on479Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (forall {a}. FieldConst a -> FieldConst a)
-> ON479 FieldConst -> ON479 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) -> ON479 p -> ON479 q
Rank2.<$> ON479 {
   $sel:page1:ON479 :: 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:ON479 :: 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}


page1Fields :: Page1 FieldConst
page1Fields = Page1 {
   $sel:line_63050_childcare:Page1 :: FieldConst Centi
line_63050_childcare = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
   $sel:line4_homecare_copy:Page1 :: FieldConst Centi
line4_homecare_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount"] Entry Centi
Amount,
   $sel:line5_allowable:Page1 :: FieldConst Rational
line5_allowable = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", 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.25 Entry Rational
Percent,
   $sel:line6_fraction:Page1 :: FieldConst Centi
line6_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line4", Text
"Amount"] Entry Centi
Amount,
   $sel:line7_netIncome_copy:Page1 :: FieldConst Centi
line7_netIncome_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5", Text
"Amount"] Entry Centi
Amount,
   $sel:line8_spouse_copy:Page1 :: FieldConst Centi
line8_spouse_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"Amount"] Entry Centi
Amount,
   $sel:line9_sum:Page1 :: FieldConst Centi
line9_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount1"] Entry Centi
Amount,
   $sel:line10_base:Page1 :: FieldConst Centi
line10_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", 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
35_000 Entry Centi
Amount,
   $sel:line11_difference:Page1 :: FieldConst Centi
line11_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount"] Entry Centi
Amount,
   $sel:line12_rate:Page1 :: FieldConst Rational
line12_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", 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.05 Entry Rational
Percent,
   $sel:line13_fraction:Page1 :: SubCalculation FieldConst
line13_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line11" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line_63095_difference:Page1 :: SubCalculation FieldConst
line_63095_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line12" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line_63100_transit:Page1 :: FieldConst Centi
line_63100_transit = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line13", Text
"Line63100", Text
"Amount"] Entry Centi
Amount,
   $sel:line_63100_fraction:Page1 :: FieldConst Centi
line_63100_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line13", Text
"Amount"] Entry Centi
Amount,
   $sel:line16_sum:Page1 :: FieldConst Centi
line16_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line14", Text
"Amount"] Entry Centi
Amount}

page2Fields :: Page2 FieldConst
page2Fields = Page2 {
   $sel:line17_copy:Page2 :: FieldConst Centi
line17_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line15", Text
"Amount"] Entry Centi
Amount,
   $sel:line_63110_contributions:Page2 :: FieldConst Centi
line_63110_contributions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON_Political_Contribution", Text
"Line16", Text
"Amount"] Entry Centi
Amount,
   $sel:line_63110_credit:Page2 :: FieldConst Centi
line_63110_credit = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON_Political_Contribution", Text
"Line17", Text
"Amount"] Entry Centi
Amount,
   $sel:line_63220_fromT1221:Page2 :: FieldConst Centi
line_63220_fromT1221 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Line63220", Text
"Amount1"] Entry Centi
Amount,
   $sel:line_63220_fraction:Page2 :: FieldConst Centi
line_63220_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount2"] Entry Centi
Amount,
   $sel:line_63260_placements:Page2 :: FieldConst Word
line_63260_placements = [Text] -> Entry Word -> FieldConst Word
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON_coop_education", Text
"Line63260", Text
"NmbrApprentices"] Entry Word
Count,
   $sel:line_63265_partnership:Page2 :: FieldConst Bool
line_63265_partnership = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON_coop_education", Text
"Line63265", Text
"RadioButtonGroup"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Entry Bool
forall a. (Eq a, Show a) => [a] -> Entry a
RadioButton [Bool
True, Bool
False],
   $sel:line_63270_business:Page2 :: FieldConst Text
line_63270_business = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON_coop_education", Text
"Line63270", Text
"BusinessNumber_9_Comb_Bottom_Adv", Text
"BusinessNumber"] Entry Text
Textual,
   $sel:line_63300_total:Page2 :: FieldConst Centi
line_63300_total = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line19", Text
"Amount"] Entry Centi
Amount,
   $sel:line23_credits:Page2 :: FieldConst Centi
line23_credits = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Amount"] Entry Centi
Amount}