{-# 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.Schedule6 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, calculation, result), fixSubCalculation, subCalculationFields)
import Tax.Canada.T1.Types (T1)
import Tax.Canada.T1.Types qualified as T1
import Tax.FDF (Entry (Amount, Constant, Percent, Switch'), FieldConst (Field), within)
import Tax.Util (fixEq, fractionOf, difference, nonNegativeDifference, totalOf)

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

data Page2 line = Page2{
   forall (line :: * -> *). Page2 line -> Questions line
questions :: Questions line,
   forall (line :: * -> *). Page2 line -> PartAColumn line
partA_self :: PartAColumn line,
   forall (line :: * -> *). Page2 line -> PartAColumn line
partA_spouse :: PartAColumn line,
   forall (line :: * -> *). Page2 line -> line Centi
line6_sum :: line Centi}

data Questions line = Questions{
   forall (line :: * -> *). Questions line -> line Bool
line_38100 :: line Bool,
   forall (line :: * -> *). Questions line -> line Bool
line_38101 :: line Bool,
   forall (line :: * -> *). Questions line -> line Bool
line_38102 :: line Bool,
   forall (line :: * -> *). Questions line -> line Bool
line_38103 :: line Bool,
   forall (line :: * -> *). Questions line -> line Bool
line_38104 :: line Bool,
   forall (line :: * -> *). Questions line -> line Bool
line_38105 :: line Bool}

data PartAColumn line = PartAColumn{
   forall (line :: * -> *). PartAColumn line -> line Centi
line1_employmentIncome_copy :: line Centi,
   forall (line :: * -> *). PartAColumn line -> line Centi
line_38106_grants_copy :: line Centi,
   forall (line :: * -> *). PartAColumn line -> line Centi
line3_selfEmploymentIncome_sum :: line Centi,
   forall (line :: * -> *). PartAColumn line -> line Centi
line_38107_exemptIncome :: line Centi,
   forall (line :: * -> *). PartAColumn line -> line Centi
line_38108_sum :: line Centi}

data Page3 line = Page3{
   forall (line :: * -> *). Page3 line -> PartBColumn line
partB_self :: PartBColumn line,
   forall (line :: * -> *). Page3 line -> PartBColumn line
partB_spouse :: PartBColumn line,
   forall (line :: * -> *). Page3 line -> line Centi
line13_sum :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line14_least :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
line15_difference :: line Centi}

data PartBColumn line = PartBColumn{
   forall (line :: * -> *). PartBColumn line -> line Centi
line7_netIncome_copy :: line Centi,
   forall (line :: * -> *). PartBColumn line -> line Centi
line_38109_exempt :: line Centi,
   forall (line :: * -> *). PartBColumn line -> line Centi
line9_uccbRdspRepayments :: line Centi,
   forall (line :: * -> *). PartBColumn line -> line Centi
line10_sum :: line Centi,
   forall (line :: * -> *). PartBColumn line -> line Centi
line11_uccbRdspIncome :: line Centi,
   forall (line :: * -> *). PartBColumn line -> line Centi
line_38110_difference :: line Centi}

data Page4 line = Page4{
   forall (line :: * -> *). Page4 line -> Step2 line
step2 :: Step2 line,
   forall (line :: * -> *). Page4 line -> Step3 line
step3 :: Step3 line}

data Step2 line = Step2{
   forall (line :: * -> *). Step2 line -> line Centi
line16_copy :: line Centi,
   forall (line :: * -> *). Step2 line -> line Centi
line17_threshold :: line Centi,
   forall (line :: * -> *). Step2 line -> line Centi
line18_difference :: line Centi,
   forall (line :: * -> *). Step2 line -> line Rational
line19_rate :: line Rational,
   forall (line :: * -> *). Step2 line -> line Centi
line20_fraction :: line Centi,
   forall (line :: * -> *). Step2 line -> line Centi
line21_ceiling :: line Centi,
   forall (line :: * -> *). Step2 line -> line Centi
line22_least :: line Centi,
   forall (line :: * -> *). Step2 line -> line Centi
line23_copy :: line Centi,
   forall (line :: * -> *). Step2 line -> line Centi
line24_threshold :: line Centi,
   forall (line :: * -> *). Step2 line -> line Centi
line25_difference :: line Centi,
   forall (line :: * -> *). Step2 line -> line Rational
line26_rate :: line Rational,
   forall (line :: * -> *). Step2 line -> SubCalculation line
line27_fraction :: SubCalculation line,
   forall (line :: * -> *). Step2 line -> line Centi
line28_difference :: line Centi}

data Step3 line = Step3{
   forall (line :: * -> *). Step3 line -> line Centi
line29_copy :: line Centi,
   forall (line :: * -> *). Step3 line -> line Centi
line30_threshold :: line Centi,
   forall (line :: * -> *). Step3 line -> line Centi
line31_difference :: line Centi,
   forall (line :: * -> *). Step3 line -> line Rational
line32_rate :: line Rational,
   forall (line :: * -> *). Step3 line -> line Centi
line33_fraction :: line Centi,
   forall (line :: * -> *). Step3 line -> line Centi
line34_capped :: line Centi,
   forall (line :: * -> *). Step3 line -> line Centi
line35_copy :: line Centi,
   forall (line :: * -> *). Step3 line -> line Centi
line36_threshold :: line Centi,
   forall (line :: * -> *). Step3 line -> line Centi
line37_difference :: line Centi,
   forall (line :: * -> *). Step3 line -> line Rational
line38_rate :: line Rational,
   forall (line :: * -> *). Step3 line -> SubCalculation line
line39_fraction :: SubCalculation line,
   forall (line :: * -> *). Step3 line -> line Centi
line40_difference :: line Centi,
   forall (line :: * -> *). Step3 line -> line Centi
line41_copy :: line Centi,
   forall (line :: * -> *). Step3 line -> line Centi
line42_sum :: line Centi}

$(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])
   [''Schedule6, ''Page2, ''Page3, ''Page4, ''Questions, ''PartAColumn, ''PartBColumn, ''Step2, ''Step3])

fixSchedule6 :: Maybe (T1 Maybe) -> T1 Maybe -> Schedule6 Maybe -> Schedule6 Maybe
fixSchedule6 :: Maybe (T1 Maybe) -> T1 Maybe -> Schedule6 Maybe -> Schedule6 Maybe
fixSchedule6 Maybe (T1 Maybe)
t1spouse T1 Maybe
t1  =
   (Schedule6 Maybe -> Schedule6 Maybe)
-> Schedule6 Maybe -> Schedule6 Maybe
forall a. Eq a => (a -> a) -> a -> a
fixEq ((Schedule6 Maybe -> Schedule6 Maybe)
 -> Schedule6 Maybe -> Schedule6 Maybe)
-> (Schedule6 Maybe -> Schedule6 Maybe)
-> Schedule6 Maybe
-> Schedule6 Maybe
forall a b. (a -> b) -> a -> b
$ \Schedule6{Page2 Maybe
$sel:page2:Schedule6 :: forall (line :: * -> *). Schedule6 line -> Page2 line
page2 :: Page2 Maybe
page2, Page3 Maybe
$sel:page3:Schedule6 :: forall (line :: * -> *). Schedule6 line -> Page3 line
page3 :: Page3 Maybe
page3, $sel:page4:Schedule6 :: forall (line :: * -> *). Schedule6 line -> Page4 line
page4=Page4{Step2 Maybe
$sel:step2:Page4 :: forall (line :: * -> *). Page4 line -> Step2 line
step2 :: Step2 Maybe
step2, Step3 Maybe
$sel:step3:Page4 :: forall (line :: * -> *). Page4 line -> Step3 line
step3 :: Step3 Maybe
step3}} ->
            let eitherEligible :: Bool
eitherEligible = Maybe Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or Page2 Maybe
page2.questions.line_38100 Bool -> Bool -> Bool
|| Maybe Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or Page2 Maybe
page2.questions.line_38101 in Schedule6{
   $sel:page2:Schedule6 :: Page2 Maybe
page2 = Page2{
      $sel:questions:Page2 :: Questions Maybe
questions = Page2 Maybe
page2.questions,
      $sel:partA_self:Page2 :: PartAColumn Maybe
partA_self = T1 Maybe -> PartAColumn Maybe -> PartAColumn Maybe
fixPartAColumn T1 Maybe
t1 Page2 Maybe
page2.partA_self,
      $sel:partA_spouse:Page2 :: PartAColumn Maybe
partA_spouse = (PartAColumn Maybe -> PartAColumn Maybe)
-> (T1 Maybe -> PartAColumn Maybe -> PartAColumn Maybe)
-> Maybe (T1 Maybe)
-> PartAColumn Maybe
-> PartAColumn Maybe
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartAColumn Maybe -> PartAColumn Maybe
forall a. a -> a
id T1 Maybe -> PartAColumn Maybe -> PartAColumn Maybe
fixPartAColumn Maybe (T1 Maybe)
t1spouse Page2 Maybe
page2.partA_spouse,
      $sel:line6_sum:Page2 :: Maybe Centi
line6_sum = [Maybe Centi] -> Maybe Centi
forall a. Num a => [Maybe a] -> Maybe a
totalOf [Page2 Maybe
page2.partA_self.line_38108_sum, Page2 Maybe
page2.partA_spouse.line_38108_sum]},
   $sel:page3:Schedule6 :: Page3 Maybe
page3 = let Page3{Maybe Centi
PartBColumn Maybe
$sel:partB_self:Page3 :: forall (line :: * -> *). Page3 line -> PartBColumn line
$sel:partB_spouse:Page3 :: forall (line :: * -> *). Page3 line -> PartBColumn line
$sel:line13_sum:Page3 :: forall (line :: * -> *). Page3 line -> line Centi
$sel:line14_least:Page3 :: forall (line :: * -> *). Page3 line -> line Centi
$sel:line15_difference:Page3 :: forall (line :: * -> *). Page3 line -> line Centi
partB_self :: PartBColumn Maybe
partB_spouse :: PartBColumn Maybe
line13_sum :: Maybe Centi
line14_least :: Maybe Centi
line15_difference :: Maybe Centi
..} = Page3 Maybe
page3 in Page3{
      $sel:partB_self:Page3 :: PartBColumn Maybe
partB_self = T1 Maybe -> PartBColumn Maybe -> PartBColumn Maybe
fixPartBColumn T1 Maybe
t1 PartBColumn Maybe
partB_self,
      $sel:partB_spouse:Page3 :: PartBColumn Maybe
partB_spouse = (PartBColumn Maybe -> PartBColumn Maybe)
-> (T1 Maybe -> PartBColumn Maybe -> PartBColumn Maybe)
-> Maybe (T1 Maybe)
-> PartBColumn Maybe
-> PartBColumn Maybe
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartBColumn Maybe -> PartBColumn Maybe
forall a. a -> a
id T1 Maybe -> PartBColumn Maybe -> PartBColumn Maybe
fixPartBColumn Maybe (T1 Maybe)
t1spouse PartBColumn Maybe
partB_spouse,
      $sel:line13_sum:Page3 :: Maybe Centi
line13_sum = [Maybe Centi] -> Maybe Centi
forall a. Num a => [Maybe a] -> Maybe a
totalOf [PartBColumn Maybe
partB_self.line_38110_difference, PartBColumn Maybe
partB_spouse.line_38110_difference],
      $sel:line14_least:Page3 :: Maybe Centi
line14_least = Centi -> Centi -> Centi
forall a. Ord a => a -> a -> a
min Centi
15_239 (Centi -> Centi) -> Maybe Centi -> Maybe Centi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                     if Maybe Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (Centi -> Centi -> Bool
forall a. Ord a => a -> a -> Bool
(<) (Centi -> Centi -> Bool) -> Maybe Centi -> Maybe (Centi -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Page2 Maybe
page2.partA_self.line_38108_sum Maybe (Centi -> Bool) -> Maybe Centi -> Maybe Bool
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Page2 Maybe
page2.partA_spouse.line_38108_sum)
                     then Maybe Centi -> Maybe Centi -> Maybe Centi
forall a. Ord a => a -> a -> a
min Page2 Maybe
page2.partA_self.line_38108_sum PartBColumn Maybe
partB_self.line_38110_difference
                     else Maybe Centi -> Maybe Centi -> Maybe Centi
forall a. Ord a => a -> a -> a
min Page2 Maybe
page2.partA_spouse.line_38108_sum PartBColumn Maybe
partB_spouse.line_38110_difference,
      $sel:line15_difference:Page3 :: Maybe Centi
line15_difference = Maybe Centi -> Maybe Centi -> Maybe Centi
difference Maybe Centi
line13_sum Maybe Centi
line14_least},
   $sel:page4:Schedule6 :: Page4 Maybe
page4 = Page4{
      $sel:step2:Page4 :: Step2 Maybe
step2 = if (Bool -> Bool) -> Maybe Bool -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
not Page2 Maybe
page2.questions.line_38102 then (forall a. Maybe a) -> Step2 Maybe
forall {k} (g :: (k -> *) -> *) (f :: k -> *).
Applicative g =>
(forall (a :: k). f a) -> g f
forall (f :: * -> *). (forall a. f a) -> Step2 f
Rank2.pure Maybe a
forall a. Maybe a
Nothing else let Step2{Maybe Rational
Maybe Centi
SubCalculation Maybe
$sel:line16_copy:Step2 :: forall (line :: * -> *). Step2 line -> line Centi
$sel:line17_threshold:Step2 :: forall (line :: * -> *). Step2 line -> line Centi
$sel:line18_difference:Step2 :: forall (line :: * -> *). Step2 line -> line Centi
$sel:line19_rate:Step2 :: forall (line :: * -> *). Step2 line -> line Rational
$sel:line20_fraction:Step2 :: forall (line :: * -> *). Step2 line -> line Centi
$sel:line21_ceiling:Step2 :: forall (line :: * -> *). Step2 line -> line Centi
$sel:line22_least:Step2 :: forall (line :: * -> *). Step2 line -> line Centi
$sel:line23_copy:Step2 :: forall (line :: * -> *). Step2 line -> line Centi
$sel:line24_threshold:Step2 :: forall (line :: * -> *). Step2 line -> line Centi
$sel:line25_difference:Step2 :: forall (line :: * -> *). Step2 line -> line Centi
$sel:line26_rate:Step2 :: forall (line :: * -> *). Step2 line -> line Rational
$sel:line27_fraction:Step2 :: forall (line :: * -> *). Step2 line -> SubCalculation line
$sel:line28_difference:Step2 :: forall (line :: * -> *). Step2 line -> line Centi
line16_copy :: Maybe Centi
line17_threshold :: Maybe Centi
line18_difference :: Maybe Centi
line19_rate :: Maybe Rational
line20_fraction :: Maybe Centi
line21_ceiling :: Maybe Centi
line22_least :: Maybe Centi
line23_copy :: Maybe Centi
line24_threshold :: Maybe Centi
line25_difference :: Maybe Centi
line26_rate :: Maybe Rational
line27_fraction :: SubCalculation Maybe
line28_difference :: Maybe Centi
..} = Step2 Maybe
step2 in Step2 Maybe
step2{
         line16_copy = page2.line6_sum,
         line18_difference = nonNegativeDifference line16_copy line17_threshold,
         line20_fraction = line19_rate `fractionOf` line18_difference,
         line21_ceiling = if eitherEligible then Just 2_616 else Just 1_518,
         line22_least = min line20_fraction line21_ceiling,
         line23_copy = page3.line15_difference,
         line24_threshold = if eitherEligible then Just 28_494 else Just 24_975,
         line25_difference = nonNegativeDifference line23_copy line24_threshold,
         line27_fraction = fixSubCalculation $ line26_rate `fractionOf` line25_difference,
         line28_difference = nonNegativeDifference line22_least line27_fraction.result},
      $sel:step3:Page4 :: Step3 Maybe
step3 = if (Bool -> Bool) -> Maybe Bool -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
not Page2 Maybe
page2.questions.line_38103 then (forall a. Maybe a) -> Step3 Maybe
forall {k} (g :: (k -> *) -> *) (f :: k -> *).
Applicative g =>
(forall (a :: k). f a) -> g f
forall (f :: * -> *). (forall a. f a) -> Step3 f
Rank2.pure Maybe a
forall a. Maybe a
Nothing else let Step3{Maybe Rational
Maybe Centi
SubCalculation Maybe
$sel:line29_copy:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
$sel:line30_threshold:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
$sel:line31_difference:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
$sel:line32_rate:Step3 :: forall (line :: * -> *). Step3 line -> line Rational
$sel:line33_fraction:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
$sel:line34_capped:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
$sel:line35_copy:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
$sel:line36_threshold:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
$sel:line37_difference:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
$sel:line38_rate:Step3 :: forall (line :: * -> *). Step3 line -> line Rational
$sel:line39_fraction:Step3 :: forall (line :: * -> *). Step3 line -> SubCalculation line
$sel:line40_difference:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
$sel:line41_copy:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
$sel:line42_sum:Step3 :: forall (line :: * -> *). Step3 line -> line Centi
line29_copy :: Maybe Centi
line30_threshold :: Maybe Centi
line31_difference :: Maybe Centi
line32_rate :: Maybe Rational
line33_fraction :: Maybe Centi
line34_capped :: Maybe Centi
line35_copy :: Maybe Centi
line36_threshold :: Maybe Centi
line37_difference :: Maybe Centi
line38_rate :: Maybe Rational
line39_fraction :: SubCalculation Maybe
line40_difference :: Maybe Centi
line41_copy :: Maybe Centi
line42_sum :: Maybe Centi
..} = Step3 Maybe
step3 in Step3 Maybe
step3{
         line29_copy = page2.partA_self.line_38108_sum,
         line31_difference = nonNegativeDifference line29_copy line30_threshold,
         line33_fraction = line32_rate `fractionOf` line31_difference,
         line34_capped = min 784 <$> line33_fraction,
         line35_copy = page3.line15_difference,
         line36_threshold = if eitherEligible then Just 45_932 else Just 35_098,
         line37_difference = nonNegativeDifference line35_copy line36_threshold,
         line38_rate = if or page2.questions.line_38104 then Just 0.075 else Just 0.15,
         line39_fraction = fixSubCalculation $ line38_rate `fractionOf` line37_difference,
         line40_difference = nonNegativeDifference line34_capped line39_fraction.result,
         line41_copy = if or page2.questions.line_38102 then step2.line28_difference else Just 0,
         line42_sum = totalOf [line40_difference, line41_copy]}}}

fixPartAColumn :: T1 Maybe -> PartAColumn Maybe -> PartAColumn Maybe
fixPartAColumn :: T1 Maybe -> PartAColumn Maybe -> PartAColumn Maybe
fixPartAColumn T1 Maybe
t1 PartAColumn{Maybe Centi
$sel:line1_employmentIncome_copy:PartAColumn :: forall (line :: * -> *). PartAColumn line -> line Centi
$sel:line_38106_grants_copy:PartAColumn :: forall (line :: * -> *). PartAColumn line -> line Centi
$sel:line3_selfEmploymentIncome_sum:PartAColumn :: forall (line :: * -> *). PartAColumn line -> line Centi
$sel:line_38107_exemptIncome:PartAColumn :: forall (line :: * -> *). PartAColumn line -> line Centi
$sel:line_38108_sum:PartAColumn :: forall (line :: * -> *). PartAColumn line -> line Centi
line1_employmentIncome_copy :: Maybe Centi
line_38106_grants_copy :: Maybe Centi
line3_selfEmploymentIncome_sum :: Maybe Centi
line_38107_exemptIncome :: Maybe Centi
line_38108_sum :: Maybe Centi
..} = PartAColumn{
   $sel:line1_employmentIncome_copy:PartAColumn :: Maybe Centi
line1_employmentIncome_copy =
      [Maybe Centi] -> Maybe Centi
forall a. Num a => [Maybe a] -> Maybe a
totalOf [T1 Maybe
t1.page3.line_10100_EmploymentIncome, T1 Maybe
t1.page3.line_10400_OtherEmploymentIncome],
   $sel:line_38106_grants_copy:PartAColumn :: Maybe Centi
line_38106_grants_copy = T1 Maybe
t1.page3.line_13010_TaxableScholarship,
   $sel:line3_selfEmploymentIncome_sum:PartAColumn :: Maybe Centi
line3_selfEmploymentIncome_sum =
      let T1.SelfEmploymentIncome{Maybe Centi
line_13499_Amount :: Maybe Centi
line_13500_Amount :: Maybe Centi
line_13699_Amount :: Maybe Centi
line_13700_Amount :: Maybe Centi
line_13899_Amount :: Maybe Centi
line_13900_Amount :: Maybe Centi
line_14099_Amount :: Maybe Centi
line_14100_Amount :: Maybe Centi
line_14299_Amount :: Maybe Centi
line_14300_Amount :: Maybe Centi
$sel:line_13499_Amount:SelfEmploymentIncome :: forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
$sel:line_13500_Amount:SelfEmploymentIncome :: forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
$sel:line_13699_Amount:SelfEmploymentIncome :: forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
$sel:line_13700_Amount:SelfEmploymentIncome :: forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
$sel:line_13899_Amount:SelfEmploymentIncome :: forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
$sel:line_13900_Amount:SelfEmploymentIncome :: forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
$sel:line_14099_Amount:SelfEmploymentIncome :: forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
$sel:line_14100_Amount:SelfEmploymentIncome :: forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
$sel:line_14299_Amount:SelfEmploymentIncome :: forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
$sel:line_14300_Amount:SelfEmploymentIncome :: forall (line :: * -> *). SelfEmploymentIncome line -> line Centi
..} = T1 Maybe
t1.page3.selfEmployment
      in [Maybe Centi] -> Maybe Centi
forall a. Num a => [Maybe a] -> Maybe a
totalOf [Maybe Centi
line_13500_Amount, Maybe Centi
line_13700_Amount, Maybe Centi
line_13900_Amount, Maybe Centi
line_14100_Amount, Maybe Centi
line_14300_Amount],
   $sel:line_38107_exemptIncome:PartAColumn :: Maybe Centi
line_38107_exemptIncome = Maybe Centi
line_38107_exemptIncome,
   $sel:line_38108_sum:PartAColumn :: Maybe Centi
line_38108_sum = [Maybe Centi] -> Maybe Centi
forall a. Num a => [Maybe a] -> Maybe a
totalOf [Maybe Centi
line1_employmentIncome_copy, Maybe Centi
line_38106_grants_copy,
                              Maybe Centi
line3_selfEmploymentIncome_sum, Maybe Centi
line_38107_exemptIncome]}

fixPartBColumn :: T1 Maybe -> PartBColumn Maybe -> PartBColumn Maybe
fixPartBColumn :: T1 Maybe -> PartBColumn Maybe -> PartBColumn Maybe
fixPartBColumn T1 Maybe
t1 column :: PartBColumn Maybe
column@PartBColumn{Maybe Centi
$sel:line7_netIncome_copy:PartBColumn :: forall (line :: * -> *). PartBColumn line -> line Centi
$sel:line_38109_exempt:PartBColumn :: forall (line :: * -> *). PartBColumn line -> line Centi
$sel:line9_uccbRdspRepayments:PartBColumn :: forall (line :: * -> *). PartBColumn line -> line Centi
$sel:line10_sum:PartBColumn :: forall (line :: * -> *). PartBColumn line -> line Centi
$sel:line11_uccbRdspIncome:PartBColumn :: forall (line :: * -> *). PartBColumn line -> line Centi
$sel:line_38110_difference:PartBColumn :: forall (line :: * -> *). PartBColumn line -> line Centi
line7_netIncome_copy :: Maybe Centi
line_38109_exempt :: Maybe Centi
line9_uccbRdspRepayments :: Maybe Centi
line10_sum :: Maybe Centi
line11_uccbRdspIncome :: Maybe Centi
line_38110_difference :: Maybe Centi
..} = PartBColumn Maybe
column{
      line7_netIncome_copy = t1.page4.line_23600_NetIncome,
--      line9_uccbRdspRepayments = totalOf [t1.page4.line_21300_UCCBRepayment, t1.page4.line_23200],
      line10_sum = totalOf [line7_netIncome_copy, line_38109_exempt, line9_uccbRdspRepayments],
      line11_uccbRdspIncome = totalOf [t1.page3.line_11700_UCCB, t1.page3.line_12500_RDSP],
      line_38110_difference = nonNegativeDifference line10_sum line11_uccbRdspIncome}

schedule6Fields :: Schedule6 FieldConst
schedule6Fields :: Schedule6 FieldConst
schedule6Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (forall {a}. FieldConst a -> FieldConst a)
-> Schedule6 FieldConst -> Schedule6 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) -> Schedule6 p -> Schedule6 q
Rank2.<$> Schedule6{
   $sel:page2:Schedule6 :: 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{
      $sel:questions:Page2 :: Questions FieldConst
questions = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Step1_tickboxes" (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
"Questions" (forall {a}. FieldConst a -> FieldConst a)
-> Questions FieldConst -> Questions 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) -> Questions p -> Questions q
Rank2.<$> Questions{
         $sel:line_38100:Questions :: FieldConst Bool
line_38100 = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38100", Text
"Line38100_CheckBoxGroup"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Entry Bool
Switch' Text
"Line38100_CheckBox_EN",
         $sel:line_38101:Questions :: FieldConst Bool
line_38101 = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38101", Text
"Line38101_CheckBoxGroup"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Entry Bool
Switch' Text
"Line38101_CheckBox_EN",
         $sel:line_38102:Questions :: FieldConst Bool
line_38102 = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38102", Text
"Line38102_CheckBoxGroup"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Entry Bool
Switch' Text
"Line38102_CheckBox_EN",
         $sel:line_38103:Questions :: FieldConst Bool
line_38103 = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38103", Text
"Line38103_CheckBoxGroup"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Entry Bool
Switch' Text
"Line38103_CheckBox_EN",
         $sel:line_38104:Questions :: FieldConst Bool
line_38104 = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38104", Text
"Line38104_CheckBoxGroup"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Entry Bool
Switch' Text
"Line38104_CheckBox_EN",
         $sel:line_38105:Questions :: FieldConst Bool
line_38105 = [Text] -> Entry Bool -> FieldConst Bool
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38105", Text
"Line38105_CheckBoxGroup"] (Entry Bool -> FieldConst Bool) -> Entry Bool -> FieldConst Bool
forall a b. (a -> b) -> a -> b
$ Text -> Entry Bool
Switch' Text
"Line38105_CheckBox_EN"},
      $sel:partA_self:Page2 :: PartAColumn FieldConst
partA_self = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartA" (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
"Chart" (forall {a}. FieldConst a -> FieldConst a)
-> PartAColumn FieldConst -> PartAColumn 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) -> PartAColumn p -> PartAColumn q
Rank2.<$> PartAColumn{
         $sel:line1_employmentIncome_copy:PartAColumn :: FieldConst Centi
line1_employmentIncome_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount1", Text
"Amount"] Entry Centi
Amount,
         $sel:line_38106_grants_copy:PartAColumn :: FieldConst Centi
line_38106_grants_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount1", Text
"Amount"] Entry Centi
Amount,
         $sel:line3_selfEmploymentIncome_sum:PartAColumn :: FieldConst Centi
line3_selfEmploymentIncome_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", Text
"Amount1", Text
"Amount"] Entry Centi
Amount,
         $sel:line_38107_exemptIncome:PartAColumn :: FieldConst Centi
line_38107_exemptIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"line4", Text
"Amount1", Text
"Amount"] Entry Centi
Amount,
         $sel:line_38108_sum:PartAColumn :: FieldConst Centi
line_38108_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5_Sub", Text
"Amount1", Text
"Amount"] Entry Centi
Amount},
      $sel:partA_spouse:Page2 :: PartAColumn FieldConst
partA_spouse = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartA" (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
"Chart" (forall {a}. FieldConst a -> FieldConst a)
-> PartAColumn FieldConst -> PartAColumn 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) -> PartAColumn p -> PartAColumn q
Rank2.<$> PartAColumn{
         $sel:line1_employmentIncome_copy:PartAColumn :: FieldConst Centi
line1_employmentIncome_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount2", Text
"Amount"] Entry Centi
Amount,
         $sel:line_38106_grants_copy:PartAColumn :: FieldConst Centi
line_38106_grants_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount2", Text
"Amount"] Entry Centi
Amount,
         $sel:line3_selfEmploymentIncome_sum:PartAColumn :: FieldConst Centi
line3_selfEmploymentIncome_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", Text
"Amount2", Text
"Amount"] Entry Centi
Amount,
         $sel:line_38107_exemptIncome:PartAColumn :: FieldConst Centi
line_38107_exemptIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"line4", Text
"Amount2", Text
"Amount"] Entry Centi
Amount,
         $sel:line_38108_sum:PartAColumn :: FieldConst Centi
line_38108_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5_Sub", Text
"Amount2", Text
"Amount"] Entry Centi
Amount},
      $sel:line6_sum:Page2 :: FieldConst Centi
line6_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"PartA", Text
"Line6", Text
"Amount"] Entry Centi
Amount},
   $sel:page3:Schedule6 :: Page3 FieldConst
page3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page3" (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
"PartB" (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_self:Page3 :: PartBColumn FieldConst
partB_self = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Chart" (forall {a}. FieldConst a -> FieldConst a)
-> PartBColumn FieldConst -> PartBColumn 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) -> PartBColumn p -> PartBColumn q
Rank2.<$> PartBColumn{
         $sel:line7_netIncome_copy:PartBColumn :: FieldConst Centi
line7_netIncome_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount1", Text
"Amount"] Entry Centi
Amount,
         $sel:line_38109_exempt:PartBColumn :: FieldConst Centi
line_38109_exempt = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", Text
"Amount1", Text
"Amount"] Entry Centi
Amount,
         $sel:line9_uccbRdspRepayments:PartBColumn :: FieldConst Centi
line9_uccbRdspRepayments = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount1", Text
"Amount"] Entry Centi
Amount,
         $sel:line10_sum:PartBColumn :: FieldConst Centi
line10_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", Text
"Amount1", Text
"Amount"] Entry Centi
Amount,
         $sel:line11_uccbRdspIncome:PartBColumn :: FieldConst Centi
line11_uccbRdspIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line11", Text
"Amount1", Text
"Amount"] Entry Centi
Amount,
         $sel:line_38110_difference:PartBColumn :: FieldConst Centi
line_38110_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line12", Text
"Amount1", Text
"Amount"] Entry Centi
Amount},
      $sel:partB_spouse:Page3 :: PartBColumn FieldConst
partB_spouse = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Chart" (forall {a}. FieldConst a -> FieldConst a)
-> PartBColumn FieldConst -> PartBColumn 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) -> PartBColumn p -> PartBColumn q
Rank2.<$> PartBColumn{
         $sel:line7_netIncome_copy:PartBColumn :: FieldConst Centi
line7_netIncome_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount2", Text
"Amount"] Entry Centi
Amount,
         $sel:line_38109_exempt:PartBColumn :: FieldConst Centi
line_38109_exempt = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", Text
"Amount2", Text
"Amount"] Entry Centi
Amount,
         $sel:line9_uccbRdspRepayments:PartBColumn :: FieldConst Centi
line9_uccbRdspRepayments = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount2", Text
"Amount"] Entry Centi
Amount,
         $sel:line10_sum:PartBColumn :: FieldConst Centi
line10_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", Text
"Amount2", Text
"Amount"] Entry Centi
Amount,
         $sel:line11_uccbRdspIncome:PartBColumn :: FieldConst Centi
line11_uccbRdspIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line11", Text
"Amount2", Text
"Amount"] Entry Centi
Amount,
         $sel:line_38110_difference:PartBColumn :: FieldConst Centi
line_38110_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line12", Text
"Amount2", Text
"Amount"] Entry Centi
Amount},
      $sel:line13_sum:Page3 :: FieldConst Centi
line13_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line13", Text
"Amount"] Entry Centi
Amount,
      $sel:line14_least:Page3 :: FieldConst Centi
line14_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line14", Text
"Amount"] Entry Centi
Amount,
      $sel:line15_difference:Page3 :: FieldConst Centi
line15_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line15", Text
"Amount"] Entry Centi
Amount},
   $sel:page4:Schedule6 :: 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:step2:Page4 :: Step2 FieldConst
step2 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Step2" (forall {a}. FieldConst a -> FieldConst a)
-> Step2 FieldConst -> Step2 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) -> Step2 p -> Step2 q
Rank2.<$> Step2{
         $sel:line16_copy:Step2 :: FieldConst Centi
line16_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount"] Entry Centi
Amount,
         $sel:line17_threshold:Step2 :: FieldConst Centi
line17_threshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", 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
3_000 Entry Centi
Amount,
         $sel:line18_difference:Step2 :: FieldConst Centi
line18_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount"] Entry Centi
Amount,
         $sel:line19_rate:Step2 :: FieldConst Rational
line19_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line19", 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
0.27 Entry Rational
Percent,
         $sel:line20_fraction:Step2 :: FieldConst Centi
line20_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Amount"] Entry Centi
Amount,
         $sel:line21_ceiling:Step2 :: FieldConst Centi
line21_ceiling = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line21", Text
"Amount"] Entry Centi
Amount,
         $sel:line22_least:Step2 :: FieldConst Centi
line22_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"Amount"] Entry Centi
Amount,
         $sel:line23_copy:Step2 :: FieldConst Centi
line23_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount"] Entry Centi
Amount,
         $sel:line24_threshold:Step2 :: FieldConst Centi
line24_threshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Amount"] Entry Centi
Amount,
         $sel:line25_difference:Step2 :: FieldConst Centi
line25_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line25", Text
"Amount"] Entry Centi
Amount,
         $sel:line26_rate:Step2 :: FieldConst Rational
line26_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line26", 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
0.15 Entry Rational
Percent,
         $sel:line27_fraction:Step2 :: SubCalculation FieldConst
line27_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line27" [Text
"Amount1"] [Text
"Amount2"],
         $sel:line28_difference:Step2 :: FieldConst Centi
line28_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line28", Text
"Amount"] Entry Centi
Amount},
      $sel:step3:Page4 :: Step3 FieldConst
step3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Step3" (forall {a}. FieldConst a -> FieldConst a)
-> Step3 FieldConst -> Step3 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) -> Step3 p -> Step3 q
Rank2.<$> Step3{
         $sel:line29_copy:Step3 :: FieldConst Centi
line29_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line29", Text
"Amount"] Entry Centi
Amount,
         $sel:line30_threshold:Step3 :: FieldConst Centi
line30_threshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30", 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
1_150 Entry Centi
Amount,
         $sel:line31_difference:Step3 :: FieldConst Centi
line31_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31", Text
"Amount"] Entry Centi
Amount,
         $sel:line32_rate:Step3 :: FieldConst Rational
line32_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32", 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
0.27 Entry Rational
Percent,
         $sel:line33_fraction:Step3 :: FieldConst Centi
line33_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33", Text
"Amount"] Entry Centi
Amount,
         $sel:line34_capped:Step3 :: FieldConst Centi
line34_capped = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line34", Text
"Amount"] Entry Centi
Amount,
         $sel:line35_copy:Step3 :: FieldConst Centi
line35_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line35", Text
"Amount"] Entry Centi
Amount,
         $sel:line36_threshold:Step3 :: FieldConst Centi
line36_threshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36", Text
"Amount"] Entry Centi
Amount,
         $sel:line37_difference:Step3 :: FieldConst Centi
line37_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line37", Text
"Amount"] Entry Centi
Amount,
         $sel:line38_rate:Step3 :: FieldConst Rational
line38_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38", Text
"Percent"] Entry Rational
Percent,
         $sel:line39_fraction:Step3 :: SubCalculation FieldConst
line39_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line39" [Text
"Amount1"] [Text
"Amount2"],
         $sel:line40_difference:Step3 :: FieldConst Centi
line40_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40", Text
"Amount"] Entry Centi
Amount,
         $sel:line41_copy:Step3 :: FieldConst Centi
line41_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41", Text
"Amount"] Entry Centi
Amount,
         $sel:line42_sum:Step3 :: FieldConst Centi
line42_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42", Text
"Amount"] Entry Centi
Amount}}}