{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Tax.Canada.Federal.Schedule7 where

import Data.Fixed (Centi)
import Data.Text (Text)
import Language.Haskell.TH qualified as TH
import Rank2 qualified
import Rank2.TH qualified
import Transformation.Shallow.TH qualified

import Tax.Canada.Shared (SubCalculation(SubCalculation, result), fixSubCalculation, subCalculationFields)
import Tax.Canada.T1.Types (T1)
import Tax.Canada.T1.Types qualified as T1
import Tax.FDF (Entry (Amount, Checkbox), FieldConst (Field), within)
import Tax.Util (fixEq, fractionOf, difference, nonNegativeDifference, totalOf)

data Schedule7 line = Schedule7{
   forall (line :: * -> *). Schedule7 line -> Page2 line
page2 :: Page2 line,
   forall (line :: * -> *). Schedule7 line -> Page3 line
page3 :: Page3 line,
   forall (line :: * -> *). Schedule7 line -> Page4 line
page4 :: Page4 line}

data Page2 line = Page2{
   forall (line :: * -> *). Page2 line -> line Centi
line1_pastUnused :: line Centi,
   forall (line :: * -> *). Page2 line -> line Centi
line2_pastYearContributions :: line Centi,
   forall (line :: * -> *). Page2 line -> line Centi
line3_thisYearContributions :: line Centi,
   forall (line :: * -> *). Page2 line -> SubCalculation line
line_24500_contributions_sum :: SubCalculation line,
   forall (line :: * -> *). Page2 line -> line Centi
line5_sum :: line Centi}

data Page3 line = Page3{
   forall (line :: * -> *). Page3 line -> PartB line
partB :: PartB line,
   forall (line :: * -> *). Page3 line -> PartC line
partC :: PartC line}

data PartB line = PartB{
   forall (line :: * -> *). PartB line -> line Centi
line6_contributions_copy :: line Centi,
   forall (line :: * -> *). PartB line -> line Centi
line_24600_hbp :: line Centi,
   forall (line :: * -> *). PartB line -> line Centi
line_24620_llp :: line Centi,
   forall (line :: * -> *). PartB line -> SubCalculation line
line9_repayments_sum :: SubCalculation line,
   forall (line :: * -> *). PartB line -> line Centi
line10_difference :: line Centi}

data PartC line = PartC{
   forall (line :: * -> *). PartC line -> line Centi
line11_deductionLimit :: line Centi,
   forall (line :: * -> *). PartC line -> line Centi
line12_prpp_copy :: line Centi,
   forall (line :: * -> *). PartC line -> line Centi
line13_difference :: line Centi,
   forall (line :: * -> *). PartC line -> line Centi
line14_copy :: line Centi,
   forall (line :: * -> *). PartC line -> line Centi
line_24640_transfers :: line Centi,
   forall (line :: * -> *). PartC line -> line Centi
line15_cont :: line Centi,
   forall (line :: * -> *). PartC line -> line Centi
line16_difference :: line Centi,
   forall (line :: * -> *). PartC line -> line Centi
line17_lesser :: line Centi,
   forall (line :: * -> *). PartC line -> line Centi
line18_deducting :: line Centi,
   forall (line :: * -> *). PartC line -> line Centi
line19_sum :: line Centi,
   forall (line :: * -> *). PartC line -> line Centi
line20_deduction :: line Centi}

data Page4 line = Page4{
   forall (line :: * -> *). Page4 line -> PartD line
partD :: PartD line,
   forall (line :: * -> *). Page4 line -> PartE line
partE :: PartE line,
   forall (line :: * -> *). Page4 line -> line Centi
line_26700_athleteTrust :: line Centi}

data PartD line = PartD{
   forall (line :: * -> *). PartD line -> line Centi
line21_copy :: line Centi,
   forall (line :: * -> *). PartD line -> line Centi
line22_copy :: line Centi,
   forall (line :: * -> *). PartD line -> line Centi
line23_difference :: line Centi}

data PartE line = PartE{
   forall (line :: * -> *). PartE line -> line Centi
line_24700_hbp :: line Centi,
   forall (line :: * -> *). PartE line -> line Bool
line_25900_hbpSame :: line Bool,
   forall (line :: * -> *). PartE line -> line Centi
line_26300_llp :: line Centi,
   forall (line :: * -> *). PartE line -> line Bool
line_26400_llpSpouse :: line Bool}

$(foldMap
   (\t-> concat <$> sequenceA [
       [d|
           deriving instance (Show (line Bool), Show (line Centi), Show (line Rational)) => Show ($(TH.conT t) line)
           deriving instance (Eq (line Bool), Eq (line Centi), Eq (line Rational)) => Eq ($(TH.conT t) line)
       |],
       Rank2.TH.deriveAll t,
       Transformation.Shallow.TH.deriveAll t])
   [''Schedule7, ''Page2, ''Page3, ''Page4, ''PartB, ''PartC, ''PartD, ''PartE])

fixSchedule7 :: T1 Maybe -> Schedule7 Maybe -> Schedule7 Maybe
fixSchedule7 :: T1 Maybe -> Schedule7 Maybe -> Schedule7 Maybe
fixSchedule7 T1 Maybe
t1  = (Schedule7 Maybe -> Schedule7 Maybe)
-> Schedule7 Maybe -> Schedule7 Maybe
forall a. Eq a => (a -> a) -> a -> a
fixEq ((Schedule7 Maybe -> Schedule7 Maybe)
 -> Schedule7 Maybe -> Schedule7 Maybe)
-> (Schedule7 Maybe -> Schedule7 Maybe)
-> Schedule7 Maybe
-> Schedule7 Maybe
forall a b. (a -> b) -> a -> b
$ \Schedule7{Page2 Maybe
$sel:page2:Schedule7 :: forall (line :: * -> *). Schedule7 line -> Page2 line
page2 :: Page2 Maybe
page2, Page3 Maybe
$sel:page3:Schedule7 :: forall (line :: * -> *). Schedule7 line -> Page3 line
page3 :: Page3 Maybe
page3, Page4 Maybe
$sel:page4:Schedule7 :: forall (line :: * -> *). Schedule7 line -> Page4 line
page4 :: Page4 Maybe
page4} -> Schedule7{
   $sel:page2:Schedule7 :: Page2 Maybe
page2 = let Page2{Maybe Centi
SubCalculation Maybe
$sel:line1_pastUnused:Page2 :: forall (line :: * -> *). Page2 line -> line Centi
$sel:line2_pastYearContributions:Page2 :: forall (line :: * -> *). Page2 line -> line Centi
$sel:line3_thisYearContributions:Page2 :: forall (line :: * -> *). Page2 line -> line Centi
$sel:line_24500_contributions_sum:Page2 :: forall (line :: * -> *). Page2 line -> SubCalculation line
$sel:line5_sum:Page2 :: forall (line :: * -> *). Page2 line -> line Centi
line1_pastUnused :: Maybe Centi
line2_pastYearContributions :: Maybe Centi
line3_thisYearContributions :: Maybe Centi
line_24500_contributions_sum :: SubCalculation Maybe
line5_sum :: Maybe Centi
..} = Page2 Maybe
page2 in Page2 Maybe
page2{
      line_24500_contributions_sum = fixSubCalculation $ totalOf [line2_pastYearContributions, line3_thisYearContributions],
      line5_sum = totalOf [line1_pastUnused, line_24500_contributions_sum.result]},
   $sel:page3:Schedule7 :: Page3 Maybe
page3 = let Page3{$sel:partB:Page3 :: forall (line :: * -> *). Page3 line -> PartB line
partB = partB :: PartB Maybe
partB@PartB{Maybe Centi
SubCalculation Maybe
$sel:line6_contributions_copy:PartB :: forall (line :: * -> *). PartB line -> line Centi
$sel:line_24600_hbp:PartB :: forall (line :: * -> *). PartB line -> line Centi
$sel:line_24620_llp:PartB :: forall (line :: * -> *). PartB line -> line Centi
$sel:line9_repayments_sum:PartB :: forall (line :: * -> *). PartB line -> SubCalculation line
$sel:line10_difference:PartB :: forall (line :: * -> *). PartB line -> line Centi
line6_contributions_copy :: Maybe Centi
line_24600_hbp :: Maybe Centi
line_24620_llp :: Maybe Centi
line9_repayments_sum :: SubCalculation Maybe
line10_difference :: Maybe Centi
..}, $sel:partC:Page3 :: forall (line :: * -> *). Page3 line -> PartC line
partC = partC :: PartC Maybe
partC@PartC{Maybe Centi
$sel:line11_deductionLimit:PartC :: forall (line :: * -> *). PartC line -> line Centi
$sel:line12_prpp_copy:PartC :: forall (line :: * -> *). PartC line -> line Centi
$sel:line13_difference:PartC :: forall (line :: * -> *). PartC line -> line Centi
$sel:line14_copy:PartC :: forall (line :: * -> *). PartC line -> line Centi
$sel:line_24640_transfers:PartC :: forall (line :: * -> *). PartC line -> line Centi
$sel:line15_cont:PartC :: forall (line :: * -> *). PartC line -> line Centi
$sel:line16_difference:PartC :: forall (line :: * -> *). PartC line -> line Centi
$sel:line17_lesser:PartC :: forall (line :: * -> *). PartC line -> line Centi
$sel:line18_deducting:PartC :: forall (line :: * -> *). PartC line -> line Centi
$sel:line19_sum:PartC :: forall (line :: * -> *). PartC line -> line Centi
$sel:line20_deduction:PartC :: forall (line :: * -> *). PartC line -> line Centi
line11_deductionLimit :: Maybe Centi
line12_prpp_copy :: Maybe Centi
line13_difference :: Maybe Centi
line14_copy :: Maybe Centi
line_24640_transfers :: Maybe Centi
line15_cont :: Maybe Centi
line16_difference :: Maybe Centi
line17_lesser :: Maybe Centi
line18_deducting :: Maybe Centi
line19_sum :: Maybe Centi
line20_deduction :: Maybe Centi
..}} = Page3 Maybe
page3 in Page3{
      $sel:partB:Page3 :: PartB Maybe
partB = PartB Maybe
partB{
         line6_contributions_copy = page2.line5_sum,
         line9_repayments_sum = fixSubCalculation $ totalOf [line_24600_hbp, line_24620_llp],
         line10_difference = difference line6_contributions_copy line9_repayments_sum.result},
      $sel:partC:Page3 :: PartC Maybe
partC = PartC Maybe
partC{
         line12_prpp_copy = t1.page4.line_20810_PRPP,
         line13_difference = difference line11_deductionLimit line12_prpp_copy,
         line14_copy = partB.line10_difference,
         line15_cont = line_24640_transfers,
         line16_difference = difference line14_copy line15_cont,
         line17_lesser = min line13_difference line16_difference,
         line19_sum = totalOf [line15_cont, line18_deducting],
         line20_deduction = min line10_difference line19_sum}},
   $sel:page4:Schedule7 :: Page4 Maybe
page4 = Page4 Maybe
page4{
      partD = let PartD{line21_copy, line22_copy} = page4.partD in PartD{
         line21_copy = page3.partB.line10_difference,
         line22_copy = page3.partC.line20_deduction,
         line23_difference = difference line21_copy line22_copy}}}

schedule7Fields :: Schedule7 FieldConst
schedule7Fields :: Schedule7 FieldConst
schedule7Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (forall {a}. FieldConst a -> FieldConst a)
-> Schedule7 FieldConst -> Schedule7 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) -> Schedule7 p -> Schedule7 q
Rank2.<$> Schedule7{
   $sel:page2:Schedule7 :: Page2 FieldConst
page2 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page2" (FieldConst a -> FieldConst a)
-> (FieldConst a -> FieldConst a) -> FieldConst a -> FieldConst a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartA" (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{
      $sel:line1_pastUnused:Page2 :: FieldConst Centi
line1_pastUnused = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
      $sel:line2_pastYearContributions:Page2 :: FieldConst Centi
line2_pastYearContributions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount"] Entry Centi
Amount,
      $sel:line3_thisYearContributions:Page2 :: FieldConst Centi
line3_thisYearContributions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", Text
"Amount"] Entry Centi
Amount,
      $sel:line_24500_contributions_sum:Page2 :: SubCalculation FieldConst
line_24500_contributions_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line4" [Text
"Amount1"] [Text
"Amount2"],
      $sel:line5_sum:Page2 :: FieldConst Centi
line5_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5", Text
"Amount"] Entry Centi
Amount},
   $sel:page3:Schedule7 :: 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{
      $sel:partB:Page3 :: PartB FieldConst
partB = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartB" (forall {a}. FieldConst a -> FieldConst a)
-> PartB FieldConst -> PartB 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) -> PartB p -> PartB q
Rank2.<$> PartB{
         $sel:line6_contributions_copy:PartB :: FieldConst Centi
line6_contributions_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"Amount"] Entry Centi
Amount,
         $sel:line_24600_hbp:PartB :: FieldConst Centi
line_24600_hbp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount"] Entry Centi
Amount,
         $sel:line_24620_llp:PartB :: FieldConst Centi
line_24620_llp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", Text
"Amount"] Entry Centi
Amount,
         $sel:line9_repayments_sum:PartB :: SubCalculation FieldConst
line9_repayments_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line9" [Text
"Amount1"] [Text
"Amount2"],
         $sel:line10_difference:PartB :: FieldConst Centi
line10_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", Text
"Amount"] Entry Centi
Amount},
      $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{
         $sel:line11_deductionLimit:PartC :: FieldConst Centi
line11_deductionLimit = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line11", Text
"Amount"] Entry Centi
Amount,
         $sel:line12_prpp_copy:PartC :: FieldConst Centi
line12_prpp_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line12", Text
"Amount"] Entry Centi
Amount,
         $sel:line13_difference:PartC :: FieldConst Centi
line13_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line13", Text
"Amount"] Entry Centi
Amount,
         $sel:line14_copy:PartC :: FieldConst Centi
line14_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line14", Text
"Amount"] Entry Centi
Amount,
         $sel:line_24640_transfers:PartC :: FieldConst Centi
line_24640_transfers = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line15", Text
"Amount1"] Entry Centi
Amount,
         $sel:line15_cont:PartC :: FieldConst Centi
line15_cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line15", Text
"Amount2"] Entry Centi
Amount,
         $sel:line16_difference:PartC :: FieldConst Centi
line16_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount"] Entry Centi
Amount,
         $sel:line17_lesser:PartC :: FieldConst Centi
line17_lesser = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", Text
"Amount"] Entry Centi
Amount,
         $sel:line18_deducting:PartC :: FieldConst Centi
line18_deducting = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount"] Entry Centi
Amount,
         $sel:line19_sum:PartC :: FieldConst Centi
line19_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line19", Text
"Amount"] Entry Centi
Amount,
         $sel:line20_deduction:PartC :: FieldConst Centi
line20_deduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Amount"] Entry Centi
Amount}},
   $sel:page4:Schedule7 :: Page4 FieldConst
page4 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page4" (forall {a}. FieldConst a -> FieldConst a)
-> Page4 FieldConst -> Page4 FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page4 p -> Page4 q
Rank2.<$> Page4{
      $sel:partD:Page4 :: PartD FieldConst
partD = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartD" (forall {a}. FieldConst a -> FieldConst a)
-> PartD FieldConst -> PartD 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) -> PartD p -> PartD q
Rank2.<$> PartD{
         $sel:line21_copy:PartD :: FieldConst Centi
line21_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"Amount"] Entry Centi
Amount,
         $sel:line22_copy:PartD :: FieldConst Centi
line22_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount"] Entry Centi
Amount,
         $sel:line23_difference:PartD :: FieldConst Centi
line23_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Amount"] Entry Centi
Amount},
      $sel:partE:Page4 :: PartE FieldConst
partE = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartE" (forall {a}. FieldConst a -> FieldConst a)
-> PartE FieldConst -> PartE 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) -> PartE p -> PartE q
Rank2.<$> PartE{
         $sel:line_24700_hbp:PartE :: FieldConst Centi
line_24700_hbp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line25", Text
"Amount"] Entry Centi
Amount,
         $sel:line_25900_hbpSame:PartE :: FieldConst Bool
line_25900_hbpSame = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line26", Text
"Box_Line25"] Entry Bool
Checkbox,
         $sel:line_26300_llp:PartE :: FieldConst Centi
line_26300_llp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line27", Text
"Amount"] Entry Centi
Amount,
         $sel:line_26400_llpSpouse:PartE :: FieldConst Bool
line_26400_llpSpouse = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line28", Text
"Box_Line27"] Entry Bool
Checkbox},
      $sel:line_26700_athleteTrust:Page4 :: FieldConst Centi
line_26700_athleteTrust = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"PartF", Text
"Line29", Text
"Amount"] Entry Centi
Amount}}