{-# LANGUAGE DuplicateRecordFields #-}
{-# 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.Schedule8 where

import Control.Applicative ((<|>))
import Data.Fixed (Centi)
import Data.Text (Text)
import Data.Time.Calendar (MonthOfYear)
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, Count, Month, Percent), FieldConst (Field), within)
import Tax.Util (fixEq, fractionOf, difference, nonNegativeDifference, totalOf)

data Schedule8 line = Schedule8{
   forall (line :: * -> *). Schedule8 line -> Page2 line
page2 :: Page2 line,
   forall (line :: * -> *). Schedule8 line -> Page3 line
page3 :: Page3 line,
   forall (line :: * -> *). Schedule8 line -> Page4 line
page4 :: Page4 line,
   forall (line :: * -> *). Schedule8 line -> Page5 line
page5 :: Page5 line,
   forall (line :: * -> *). Schedule8 line -> Page6 line
page6 :: Page6 line,
   forall (line :: * -> *). Schedule8 line -> Page7 line
page7 :: Page7 line,
   forall (line :: * -> *). Schedule8 line -> Page8 line
page8 :: Page8 line,
   forall (line :: * -> *). Schedule8 line -> Page9 line
page9 :: Page9 line,
   forall (line :: * -> *). Schedule8 line -> Page10 line
page10 :: Page10 line}

data Page2 line = Page2{
   forall (line :: * -> *). Page2 line -> line MonthOfYear
line_50372_stopMonth :: line MonthOfYear,
   forall (line :: * -> *). Page2 line -> line MonthOfYear
line_50374_revokeMonth :: line MonthOfYear}

data Page3 line = Page3{
   forall (line :: * -> *). Page3 line -> line Word
lineA_months :: line Word,
   forall (line :: * -> *). Page3 line -> line Centi
lineB_additionalMaxPensionableEarnings :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
lineC_maxPensionableEarnings :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
lineD_maxBasicExemption :: line Centi,
   forall (line :: * -> *). Page3 line -> line Centi
lineE_maxSubjectToSecondAdditionalContributions :: line Centi}

data Page4 line = Page4{
   forall (line :: * -> *). Page4 line -> line Centi
line_50339_totalPensionableEarnings :: line Centi,
   forall (line :: * -> *). Page4 line -> SubCalculation line
line2_least :: SubCalculation line,
   forall (line :: * -> *). Page4 line -> line Centi
line3_copyC :: line Centi,
   forall (line :: * -> *). Page4 line -> SubCalculation line
line4_difference :: SubCalculation line,
   forall (line :: * -> *). Page4 line -> line Centi
line5_difference :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line6_copyD :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line7_difference :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_50340_totalContributions :: line Centi,
   forall (line :: * -> *). Page4 line -> SubCalculation line
line9_fraction :: SubCalculation line,
   forall (line :: * -> *). Page4 line -> line Centi
line10_difference :: line Centi,
   forall (line :: * -> *). Page4 line -> SubCalculation line
line11_fraction :: SubCalculation line,
   forall (line :: * -> *). Page4 line -> SubCalculation line
line12_fraction :: SubCalculation line,
   forall (line :: * -> *). Page4 line -> line Centi
line13_sum :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line_50341_totalSecondContributions :: line Centi,
   forall (line :: * -> *). Page4 line -> SubCalculation line
line15_fraction :: SubCalculation line,
   forall (line :: * -> *). Page4 line -> line Centi
line16_copy :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line17_copy :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line18_difference :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line19_copy :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line20_copy :: line Centi,
   forall (line :: * -> *). Page4 line -> SubCalculation line
line21_difference :: SubCalculation line,
   forall (line :: * -> *). Page4 line -> line Centi
line22_sum :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line23_copy :: line Centi,
   forall (line :: * -> *). Page4 line -> line Centi
line24_copy :: line Centi,
   forall (line :: * -> *). Page4 line -> SubCalculation line
line25_difference :: SubCalculation line,
   forall (line :: * -> *). Page4 line -> line Centi
line26_sum :: line Centi}

data Page5 line = Page5{
   forall (line :: * -> *). Page5 line -> Page5Part3a line
part3a :: Page5Part3a line,
   forall (line :: * -> *). Page5 line -> Page5Part3b line
part3b :: Page5Part3b line}

data Page5Part3a line = Page5Part3a{
   forall (line :: * -> *). Page5Part3a line -> line Centi
line27_copy :: line Centi,
   forall (line :: * -> *). Page5Part3a line -> line Centi
line28_copy :: line Centi,
   forall (line :: * -> *). Page5Part3a line -> line Centi
line29_copy :: line Centi,
   forall (line :: * -> *). Page5Part3a line -> line Centi
line30_sum :: line Centi,
   forall (line :: * -> *). Page5Part3a line -> line Centi
line31_copy :: line Centi}

data Page5Part3b line = Page5Part3b{
   forall (line :: * -> *). Page5Part3b line -> line Centi
line32_join :: line Centi,
   forall (line :: * -> *). Page5Part3b line -> line Centi
line33_conditionalCopy :: line Centi,
   forall (line :: * -> *). Page5Part3b line -> Page5Part3bCond1 line
line34to37 :: Page5Part3bCond1 line,
   forall (line :: * -> *). Page5Part3b line -> line Centi
line38_conditionalCopy :: line Centi,
   forall (line :: * -> *). Page5Part3b line -> Page5Part3bCond2 line
line39to42 :: Page5Part3bCond2 line,
   forall (line :: * -> *). Page5Part3b line -> line Centi
line43_sum :: line Centi}

data Page5Part3bCond1 line = Page5Part3bCond1{
   forall (line :: * -> *). Page5Part3bCond1 line -> line Centi
line34_abs :: line Centi,
   forall (line :: * -> *). Page5Part3bCond1 line -> line Centi
line35_copy :: line Centi,
   forall (line :: * -> *). Page5Part3bCond1 line -> line Centi
line36_least :: line Centi,
   forall (line :: * -> *).
Page5Part3bCond1 line -> SubCalculation line
line37_sum :: SubCalculation line}

data Page5Part3bCond2 line = Page5Part3bCond2{
   forall (line :: * -> *). Page5Part3bCond2 line -> line Centi
line39_abs :: line Centi,
   forall (line :: * -> *). Page5Part3bCond2 line -> line Centi
line40_copy :: line Centi,
   forall (line :: * -> *). Page5Part3bCond2 line -> line Centi
line41_least :: line Centi,
   forall (line :: * -> *).
Page5Part3bCond2 line -> SubCalculation line
line42_sum :: SubCalculation line}

data Page6 line = Page6{
   forall (line :: * -> *). Page6 line -> line Centi
line1_netSelfEmploymentEarnings :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line_50373_additionalEmploymentEarningsOffT4 :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line3_sum :: line Centi,
   forall (line :: * -> *). Page6 line -> SubCalculation line
line4_least :: SubCalculation line,
   forall (line :: * -> *). Page6 line -> line Centi
line5_copyC :: line Centi,
   forall (line :: * -> *). Page6 line -> SubCalculation line
line6_difference :: SubCalculation line,
   forall (line :: * -> *). Page6 line -> line Centi
line7_difference :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line8_copyD :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line9_difference :: line Centi,
   forall (line :: * -> *). Page6 line -> SubCalculation line
line10_fraction :: SubCalculation line,
   forall (line :: * -> *). Page6 line -> SubCalculation line
line11_fraction :: SubCalculation line,
   forall (line :: * -> *). Page6 line -> SubCalculation line
line12_fraction :: SubCalculation line,
   forall (line :: * -> *). Page6 line -> SubCalculation line
line13_sum :: SubCalculation line,
   forall (line :: * -> *). Page6 line -> line Centi
line14_sum :: line Centi,
   forall (line :: * -> *). Page6 line -> SubCalculation line
line15_half :: SubCalculation line,
   forall (line :: * -> *). Page6 line -> line Centi
line16_copy :: line Centi,
   forall (line :: * -> *). Page6 line -> line Centi
line17_sum :: line Centi}

data Page7 line = Page7{
   forall (line :: * -> *). Page7 line -> line Centi
line1_netSelfEmploymentEarnings :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line_50373_additionalEmploymentEarningsOffT4 :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line_50399_additionalEmploymentEarningsOnT4 :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line4_sum :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line5_copy :: line Centi,
   forall (line :: * -> *). Page7 line -> Page7Cond1 line
line6to8 :: Page7Cond1 line,
   forall (line :: * -> *). Page7 line -> line Centi
line9_difference :: line Centi,
   forall (line :: * -> *). Page7 line -> SubCalculation line
line10_fraction :: SubCalculation line,
   forall (line :: * -> *). Page7 line -> line Centi
line11_copy :: line Centi,
   forall (line :: * -> *). Page7 line -> Page7Cond2 line
line12to14 :: Page7Cond2 line,
   forall (line :: * -> *). Page7 line -> line Centi
line15_difference :: line Centi,
   forall (line :: * -> *). Page7 line -> SubCalculation line
line16_fraction :: SubCalculation line,
   forall (line :: * -> *). Page7 line -> line Centi
line17_sum :: line Centi,
   forall (line :: * -> *). Page7 line -> Page7Cond3 line
line18to20 :: Page7Cond3 line,
   forall (line :: * -> *). Page7 line -> line Centi
line21_copy :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line22_copy :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line23_sum :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line24_copyC :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line25_copyD :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line26_difference :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line27_copy :: line Centi,
   forall (line :: * -> *). Page7 line -> line Centi
line28_difference :: line Centi}

data Page7Cond1 line = Page7Cond1{
   forall (line :: * -> *). Page7Cond1 line -> line Centi
line6_copy :: line Centi,
   forall (line :: * -> *). Page7Cond1 line -> line Centi
line7_copy :: line Centi,
   forall (line :: * -> *). Page7Cond1 line -> SubCalculation line
line8_difference :: SubCalculation line}

data Page7Cond2 line = Page7Cond2{
   forall (line :: * -> *). Page7Cond2 line -> line Centi
line12_copy :: line Centi,
   forall (line :: * -> *). Page7Cond2 line -> line Centi
line13_copy :: line Centi,
   forall (line :: * -> *). Page7Cond2 line -> SubCalculation line
line14_difference :: SubCalculation line}

data Page7Cond3 line = Page7Cond3{
   forall (line :: * -> *). Page7Cond3 line -> line Centi
line18_abs :: line Centi,
   forall (line :: * -> *). Page7Cond3 line -> line Centi
line19_least :: line Centi,
   forall (line :: * -> *). Page7Cond3 line -> SubCalculation line
line20_fraction :: SubCalculation line}

data Page8 line = Page8{
   forall (line :: * -> *). Page8 line -> line Centi
line29_least :: line Centi,
   forall (line :: * -> *). Page8 line -> line Centi
line30_copy :: line Centi,
   forall (line :: * -> *). Page8 line -> line Centi
line31_copy :: line Centi,
   forall (line :: * -> *). Page8 line -> line Centi
line32_difference :: line Centi,
   forall (line :: * -> *). Page8 line -> line Centi
line33_copy :: line Centi,
   forall (line :: * -> *). Page8 line -> line Centi
line34_copy :: line Centi,
   forall (line :: * -> *). Page8 line -> SubCalculation line
line35_difference :: SubCalculation line,
   forall (line :: * -> *). Page8 line -> SubCalculation line
line36_difference :: SubCalculation line,
   forall (line :: * -> *). Page8 line -> line Centi
line37_difference :: line Centi,
   forall (line :: * -> *). Page8 line -> Page8Cond1 line
line38to48 :: Page8Cond1 line,
   forall (line :: * -> *). Page8 line -> SubCalculation line
line49_fraction :: SubCalculation line,
   forall (line :: * -> *). Page8 line -> SubCalculation line
line50_fraction :: SubCalculation line,
   forall (line :: * -> *). Page8 line -> SubCalculation line
line51_fraction :: SubCalculation line,
   forall (line :: * -> *). Page8 line -> SubCalculation line
line52_sum :: SubCalculation line,
   forall (line :: * -> *). Page8 line -> line Centi
line53_sum :: line Centi,
   forall (line :: * -> *). Page8 line -> SubCalculation line
line54_double :: SubCalculation line,
   forall (line :: * -> *). Page8 line -> line Centi
line55_difference :: line Centi}

data Page8Cond1 line = Page8Cond1{
   forall (line :: * -> *). Page8Cond1 line -> line Centi
line38_copyE :: line Centi,
   forall (line :: * -> *). Page8Cond1 line -> line Centi
line39_copy :: line Centi,
   forall (line :: * -> *). Page8Cond1 line -> line Centi
line40_copy :: line Centi,
   forall (line :: * -> *). Page8Cond1 line -> SubCalculation line
line41_sum :: SubCalculation line,
   forall (line :: * -> *). Page8Cond1 line -> line Centi
line42_difference :: line Centi,
   forall (line :: * -> *). Page8Cond1 line -> line Centi
line43_copy :: line Centi,
   forall (line :: * -> *). Page8Cond1 line -> line Centi
line44_copy :: line Centi,
   forall (line :: * -> *). Page8Cond1 line -> line Centi
line45_difference :: line Centi,
   forall (line :: * -> *). Page8Cond1 line -> line Centi
line46_copy :: line Centi,
   forall (line :: * -> *). Page8Cond1 line -> line Centi
line47_difference :: line Centi,
   forall (line :: * -> *). Page8Cond1 line -> line Centi
line48_least :: line Centi}

data Page9 line = Page9{
   forall (line :: * -> *). Page9 line -> SubCalculation line
line56_half :: SubCalculation line,
   forall (line :: * -> *). Page9 line -> line Centi
line57_copy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line58_copy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line59_difference :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line60_least :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line61_copy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line62_copy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line63_difference :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line64_conditionalCopy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line65_abs :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line66_copy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line67_least :: line Centi,
   forall (line :: * -> *). Page9 line -> SubCalculation line
line68_sum :: SubCalculation line,
   forall (line :: * -> *). Page9 line -> line Centi
line69_copy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line70_copy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line71_difference :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line72_conditionalCopy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line73_abs :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line74_copy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line75_least :: line Centi,
   forall (line :: * -> *). Page9 line -> SubCalculation line
line76_sum :: SubCalculation line,
   forall (line :: * -> *). Page9 line -> line Centi
line77_sum :: line Centi,
   forall (line :: * -> *). Page9 line -> SubCalculation line
line78_half :: SubCalculation line,
   forall (line :: * -> *). Page9 line -> SubCalculation line
line79_half :: SubCalculation line,
   forall (line :: * -> *). Page9 line -> line Centi
line80_sum :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line81_positiveCopy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line82_difference :: line Centi,
   forall (line :: * -> *). Page9 line -> SubCalculation line
line83_fraction :: SubCalculation line,
   forall (line :: * -> *). Page9 line -> line Centi
line84_copy :: line Centi,
   forall (line :: * -> *). Page9 line -> line Centi
line85_difference :: line Centi}

data Page10 line = Page10{
   forall (line :: * -> *). Page10 line -> line Centi
line86_copy :: line Centi,
   forall (line :: * -> *). Page10 line -> line Centi
line87_copy :: line Centi,
   forall (line :: * -> *). Page10 line -> line Centi
line88_copy :: line Centi,
   forall (line :: * -> *). Page10 line -> SubCalculation line
line89_difference :: SubCalculation line,
   forall (line :: * -> *). Page10 line -> line Centi
line90_copy :: line Centi,
   forall (line :: * -> *). Page10 line -> line Centi
line91_copy :: line Centi,
   forall (line :: * -> *). Page10 line -> SubCalculation line
line92_difference :: SubCalculation line,
   forall (line :: * -> *). Page10 line -> SubCalculation line
line93_half :: SubCalculation line,
   forall (line :: * -> *). Page10 line -> line Centi
line94_copy :: line Centi,
   forall (line :: * -> *). Page10 line -> line Centi
line95_join :: line Centi,
   forall (line :: * -> *). Page10 line -> SubCalculation line
line96_difference :: SubCalculation line,
   forall (line :: * -> *). Page10 line -> line Centi
line97_sum :: line Centi}


$(foldMap
   (\t-> concat <$> sequenceA [
       [d|
           deriving instance (Show (line Centi), Show (line MonthOfYear),
                              Show (line Rational), Show (line Word)) => Show ($(TH.conT t) line)
           deriving instance (Eq (line Centi), Eq (line MonthOfYear),
                              Eq (line Rational), Eq (line Word)) => Eq ($(TH.conT t) line)
       |],
       Rank2.TH.deriveAll t,
       Transformation.Shallow.TH.deriveAll t])
   [''Schedule8, ''Page2, ''Page3, ''Page4,
    ''Page5, ''Page5Part3a, ''Page5Part3b, ''Page5Part3bCond1, ''Page5Part3bCond2, ''Page6,
    ''Page7, ''Page7Cond1, ''Page7Cond2, ''Page7Cond3, ''Page8, ''Page8Cond1, ''Page9, ''Page10])

fixSchedule8 :: Schedule8 Maybe -> Schedule8 Maybe
fixSchedule8 :: Schedule8 Maybe -> Schedule8 Maybe
fixSchedule8 = (Schedule8 Maybe -> Schedule8 Maybe)
-> Schedule8 Maybe -> Schedule8 Maybe
forall a. Eq a => (a -> a) -> a -> a
fixEq ((Schedule8 Maybe -> Schedule8 Maybe)
 -> Schedule8 Maybe -> Schedule8 Maybe)
-> (Schedule8 Maybe -> Schedule8 Maybe)
-> Schedule8 Maybe
-> Schedule8 Maybe
forall a b. (a -> b) -> a -> b
$ \Schedule8{Page2 Maybe
page2 :: forall (line :: * -> *). Schedule8 line -> Page2 line
page2 :: Page2 Maybe
page2, Page3 Maybe
page3 :: forall (line :: * -> *). Schedule8 line -> Page3 line
page3 :: Page3 Maybe
page3, Page4 Maybe
page4 :: forall (line :: * -> *). Schedule8 line -> Page4 line
page4 :: Page4 Maybe
page4, Page5 Maybe
page5 :: forall (line :: * -> *). Schedule8 line -> Page5 line
page5 :: Page5 Maybe
page5, Page6 Maybe
page6 :: forall (line :: * -> *). Schedule8 line -> Page6 line
page6 :: Page6 Maybe
page6, Page7 Maybe
page7 :: forall (line :: * -> *). Schedule8 line -> Page7 line
page7 :: Page7 Maybe
page7, Page8 Maybe
page8 :: forall (line :: * -> *). Schedule8 line -> Page8 line
page8 :: Page8 Maybe
page8, Page9 Maybe
page9 :: forall (line :: * -> *). Schedule8 line -> Page9 line
page9 :: Page9 Maybe
page9, Page10 Maybe
page10 :: forall (line :: * -> *). Schedule8 line -> Page10 line
page10 :: Page10 Maybe
page10}-> Schedule8{
   page2 :: Page2 Maybe
page2 = Page2 Maybe
page2,
   page3 :: Page3 Maybe
page3 = Page3 Maybe
page3{
      lineA_months = page3.lineA_months <|> Just 12,
      lineB_additionalMaxPensionableEarnings = ((6100 *) . fromIntegral . max 12) <$> page3.lineA_months,
      lineC_maxPensionableEarnings = ((/ 12) . (68_500 *) . fromIntegral . max 12) <$> page3.lineA_months,
      lineD_maxBasicExemption = ((/ 12) . (3500 *) . fromIntegral . min 12) <$> page3.lineA_months,
      lineE_maxSubjectToSecondAdditionalContributions = ((/ 12) . (4700 *) . fromIntegral . min 12) <$> page3.lineA_months},
   page4 :: Page4 Maybe
page4 = let Page4{Maybe Centi
SubCalculation Maybe
line_50339_totalPensionableEarnings :: forall (line :: * -> *). Page4 line -> line Centi
line2_least :: forall (line :: * -> *). Page4 line -> SubCalculation line
line3_copyC :: forall (line :: * -> *). Page4 line -> line Centi
line4_difference :: forall (line :: * -> *). Page4 line -> SubCalculation line
line5_difference :: forall (line :: * -> *). Page4 line -> line Centi
line6_copyD :: forall (line :: * -> *). Page4 line -> line Centi
line7_difference :: forall (line :: * -> *). Page4 line -> line Centi
line_50340_totalContributions :: forall (line :: * -> *). Page4 line -> line Centi
line9_fraction :: forall (line :: * -> *). Page4 line -> SubCalculation line
line10_difference :: forall (line :: * -> *). Page4 line -> line Centi
line11_fraction :: forall (line :: * -> *). Page4 line -> SubCalculation line
line12_fraction :: forall (line :: * -> *). Page4 line -> SubCalculation line
line13_sum :: forall (line :: * -> *). Page4 line -> line Centi
line_50341_totalSecondContributions :: forall (line :: * -> *). Page4 line -> line Centi
line15_fraction :: forall (line :: * -> *). Page4 line -> SubCalculation line
line16_copy :: forall (line :: * -> *). Page4 line -> line Centi
line17_copy :: forall (line :: * -> *). Page4 line -> line Centi
line18_difference :: forall (line :: * -> *). Page4 line -> line Centi
line19_copy :: forall (line :: * -> *). Page4 line -> line Centi
line20_copy :: forall (line :: * -> *). Page4 line -> line Centi
line21_difference :: forall (line :: * -> *). Page4 line -> SubCalculation line
line22_sum :: forall (line :: * -> *). Page4 line -> line Centi
line23_copy :: forall (line :: * -> *). Page4 line -> line Centi
line24_copy :: forall (line :: * -> *). Page4 line -> line Centi
line25_difference :: forall (line :: * -> *). Page4 line -> SubCalculation line
line26_sum :: forall (line :: * -> *). Page4 line -> line Centi
line_50339_totalPensionableEarnings :: Maybe Centi
line2_least :: SubCalculation Maybe
line3_copyC :: Maybe Centi
line4_difference :: SubCalculation Maybe
line5_difference :: Maybe Centi
line6_copyD :: Maybe Centi
line7_difference :: Maybe Centi
line_50340_totalContributions :: Maybe Centi
line9_fraction :: SubCalculation Maybe
line10_difference :: Maybe Centi
line11_fraction :: SubCalculation Maybe
line12_fraction :: SubCalculation Maybe
line13_sum :: Maybe Centi
line_50341_totalSecondContributions :: Maybe Centi
line15_fraction :: SubCalculation Maybe
line16_copy :: Maybe Centi
line17_copy :: Maybe Centi
line18_difference :: Maybe Centi
line19_copy :: Maybe Centi
line20_copy :: Maybe Centi
line21_difference :: SubCalculation Maybe
line22_sum :: Maybe Centi
line23_copy :: Maybe Centi
line24_copy :: Maybe Centi
line25_difference :: SubCalculation Maybe
line26_sum :: Maybe Centi
..} = Page4 Maybe
page4 in case Maybe Centi
line_50339_totalPensionableEarnings of
         Maybe Centi
Nothing -> (forall a. Maybe a) -> Page4 Maybe
forall {k} (g :: (k -> *) -> *) (f :: k -> *).
Applicative g =>
(forall (a :: k). f a) -> g f
forall (f :: * -> *). (forall a. f a) -> Page4 f
Rank2.pure Maybe a
forall a. Maybe a
Nothing
         Just{} -> Page4 Maybe
page4{
      line2_least = fixSubCalculation id $ min page3.lineB_additionalMaxPensionableEarnings line_50339_totalPensionableEarnings,
      line3_copyC = page3.lineC_maxPensionableEarnings,
      line4_difference = fixSubCalculation id $ nonNegativeDifference line2_least.result line3_copyC,
      line5_difference = nonNegativeDifference line2_least.result line4_difference.result,
      line6_copyD = page3.lineD_maxBasicExemption,
      line7_difference = nonNegativeDifference line5_difference line6_copyD,
      line9_fraction = fixSubCalculation (0.831933 *) line_50340_totalContributions,
      line10_difference = difference line_50340_totalContributions line9_fraction.result,
      line11_fraction = fixSubCalculation (0.0495 *) line7_difference,
      line12_fraction = fixSubCalculation (0.01 *) line7_difference,
      line13_sum = totalOf [line11_fraction.result, line12_fraction.result],
      line15_fraction = fixSubCalculation (0.04 *) line4_difference.result,
      line16_copy = line9_fraction.result,
      line17_copy = line11_fraction.result,
      line18_difference = difference line16_copy line17_copy,
      line19_copy = line10_difference,
      line20_copy = line12_fraction.result,
      line21_difference = fixSubCalculation id $ difference line19_copy line20_copy,
      line22_sum = totalOf [line18_difference, line21_difference.result],
      line23_copy = line_50341_totalSecondContributions,
      line24_copy = line15_fraction.result,
      line25_difference = fixSubCalculation id $ difference line23_copy line24_copy,
      line26_sum = totalOf [line22_sum, line25_difference.result]},
   page5 :: Page5 Maybe
page5 = case Page4 Maybe
page4.line_50339_totalPensionableEarnings of
         Maybe Centi
Nothing -> (forall a. Maybe a) -> Page5 Maybe
forall {k} (g :: (k -> *) -> *) (f :: k -> *).
Applicative g =>
(forall (a :: k). f a) -> g f
forall (f :: * -> *). (forall a. f a) -> Page5 f
Rank2.pure Maybe a
forall a. Maybe a
Nothing
         Just{}
           | (Centi -> Bool) -> Maybe Centi -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Centi -> Centi -> Bool
forall a. Ord a => a -> a -> Bool
> Centi
0) Page4 Maybe
page4.line26_sum -> Page5 Maybe
page5{
               part3a = let Page5Part3a{..} = page5.part3a in page5.part3a{
                  line27_copy = page4.line17_copy,
                  line28_copy = page4.line20_copy,
                  line29_copy = page4.line24_copy,
                  line30_sum = totalOf [line28_copy, line29_copy],
                  line31_copy = page4.line26_sum},
               part3b = Rank2.pure Nothing}
           | Bool
otherwise -> Page5 Maybe
page5{
               part3a = Rank2.pure Nothing,
               part3b = let Page5Part3b{..} = page5.part3b in page5.part3b{
                  line32_join = if any (< 0) page4.line18_difference then page4.line16_copy else page4.line17_copy,
                  line33_conditionalCopy = if any (< 0) page4.line21_difference.result then Nothing else page4.line20_copy,
                  line34to37 = if all (>= 0) page4.line21_difference.result then Rank2.pure Nothing
                               else flip fixEq line34to37 $ \Page5Part3bCond1{Maybe Centi
SubCalculation Maybe
line34_abs :: forall (line :: * -> *). Page5Part3bCond1 line -> line Centi
line35_copy :: forall (line :: * -> *). Page5Part3bCond1 line -> line Centi
line36_least :: forall (line :: * -> *). Page5Part3bCond1 line -> line Centi
line37_sum :: forall (line :: * -> *).
Page5Part3bCond1 line -> SubCalculation line
line34_abs :: Maybe Centi
line35_copy :: Maybe Centi
line36_least :: Maybe Centi
line37_sum :: SubCalculation Maybe
..}-> Page5Part3bCond1{
                     line34_abs :: Maybe Centi
line34_abs = Centi -> Centi
forall a. Num a => a -> a
abs (Centi -> Centi) -> Maybe Centi -> Maybe Centi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Page4 Maybe
page4.line21_difference.result,
                     line35_copy :: Maybe Centi
line35_copy = Page4 Maybe
page4.line19_copy,
                     line36_least :: Maybe Centi
line36_least = [Maybe Centi] -> Maybe Centi
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Centi -> Maybe Centi
forall a. a -> Maybe a
Just Centi
0, [Maybe Centi] -> Maybe Centi
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Page4 Maybe
page4.line18_difference, Maybe Centi
line34_abs]],
                     line37_sum :: SubCalculation Maybe
line37_sum = (Rational -> Rational) -> Maybe Centi -> SubCalculation Maybe
fixSubCalculation Rational -> Rational
forall a. a -> a
id (Maybe Centi -> SubCalculation Maybe)
-> Maybe Centi -> SubCalculation Maybe
forall a b. (a -> b) -> a -> b
$ [Maybe Centi] -> Maybe Centi
forall (f :: * -> *) a.
(Foldable f, Num a) =>
f (Maybe a) -> Maybe a
totalOf [Maybe Centi
line35_copy, Maybe Centi
line36_least]},
                  line38_conditionalCopy = if all (== 0) page4.line25_difference.result then page4.line24_copy else Nothing,
                  line39to42 = if all (>= 0) page4.line25_difference.result then Rank2.pure Nothing
                               else flip fixEq line39to42 $ \Page5Part3bCond2{Maybe Centi
SubCalculation Maybe
line39_abs :: forall (line :: * -> *). Page5Part3bCond2 line -> line Centi
line40_copy :: forall (line :: * -> *). Page5Part3bCond2 line -> line Centi
line41_least :: forall (line :: * -> *). Page5Part3bCond2 line -> line Centi
line42_sum :: forall (line :: * -> *).
Page5Part3bCond2 line -> SubCalculation line
line39_abs :: Maybe Centi
line40_copy :: Maybe Centi
line41_least :: Maybe Centi
line42_sum :: SubCalculation Maybe
..}-> Page5Part3bCond2{
                     line39_abs :: Maybe Centi
line39_abs = Centi -> Centi
forall a. Num a => a -> a
abs (Centi -> Centi) -> Maybe Centi -> Maybe Centi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Page4 Maybe
page4.line25_difference.result,
                     line40_copy :: Maybe Centi
line40_copy = Page4 Maybe
page4.line23_copy,
                     line41_least :: Maybe Centi
line41_least = [Maybe Centi] -> Maybe Centi
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Centi -> Maybe Centi
forall a. a -> Maybe a
Just Centi
0, [Maybe Centi] -> Maybe Centi
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Page4 Maybe
page4.line22_sum, Maybe Centi
line39_abs]],
                     line42_sum :: SubCalculation Maybe
line42_sum = (Rational -> Rational) -> Maybe Centi -> SubCalculation Maybe
fixSubCalculation Rational -> Rational
forall a. a -> a
id (Maybe Centi -> SubCalculation Maybe)
-> Maybe Centi -> SubCalculation Maybe
forall a b. (a -> b) -> a -> b
$ [Maybe Centi] -> Maybe Centi
forall (f :: * -> *) a.
(Foldable f, Num a) =>
f (Maybe a) -> Maybe a
totalOf [Maybe Centi
line40_copy, Maybe Centi
line41_least]},
                  line43_sum = totalOf [line33_conditionalCopy, line34to37.line37_sum.result,
                                        line38_conditionalCopy, line39to42.line42_sum.result]}},
   page6 :: Page6 Maybe
page6 = case Page4 Maybe
page4.line_50339_totalPensionableEarnings of
             Just{} -> (forall a. Maybe a) -> Page6 Maybe
forall {k} (g :: (k -> *) -> *) (f :: k -> *).
Applicative g =>
(forall (a :: k). f a) -> g f
forall (f :: * -> *). (forall a. f a) -> Page6 f
Rank2.pure Maybe a
forall a. Maybe a
Nothing
             Maybe Centi
Nothing -> let Page6{Maybe Centi
SubCalculation Maybe
line1_netSelfEmploymentEarnings :: forall (line :: * -> *). Page6 line -> line Centi
line_50373_additionalEmploymentEarningsOffT4 :: forall (line :: * -> *). Page6 line -> line Centi
line3_sum :: forall (line :: * -> *). Page6 line -> line Centi
line4_least :: forall (line :: * -> *). Page6 line -> SubCalculation line
line5_copyC :: forall (line :: * -> *). Page6 line -> line Centi
line6_difference :: forall (line :: * -> *). Page6 line -> SubCalculation line
line7_difference :: forall (line :: * -> *). Page6 line -> line Centi
line8_copyD :: forall (line :: * -> *). Page6 line -> line Centi
line9_difference :: forall (line :: * -> *). Page6 line -> line Centi
line10_fraction :: forall (line :: * -> *). Page6 line -> SubCalculation line
line11_fraction :: forall (line :: * -> *). Page6 line -> SubCalculation line
line12_fraction :: forall (line :: * -> *). Page6 line -> SubCalculation line
line13_sum :: forall (line :: * -> *). Page6 line -> SubCalculation line
line14_sum :: forall (line :: * -> *). Page6 line -> line Centi
line15_half :: forall (line :: * -> *). Page6 line -> SubCalculation line
line16_copy :: forall (line :: * -> *). Page6 line -> line Centi
line17_sum :: forall (line :: * -> *). Page6 line -> line Centi
line1_netSelfEmploymentEarnings :: Maybe Centi
line_50373_additionalEmploymentEarningsOffT4 :: Maybe Centi
line3_sum :: Maybe Centi
line4_least :: SubCalculation Maybe
line5_copyC :: Maybe Centi
line6_difference :: SubCalculation Maybe
line7_difference :: Maybe Centi
line8_copyD :: Maybe Centi
line9_difference :: Maybe Centi
line10_fraction :: SubCalculation Maybe
line11_fraction :: SubCalculation Maybe
line12_fraction :: SubCalculation Maybe
line13_sum :: SubCalculation Maybe
line14_sum :: Maybe Centi
line15_half :: SubCalculation Maybe
line16_copy :: Maybe Centi
line17_sum :: Maybe Centi
..} = Page6 Maybe
page6 in Page6 Maybe
page6{
               line3_sum = max 0 <$> totalOf [line1_netSelfEmploymentEarnings,
                                              line_50373_additionalEmploymentEarningsOffT4],
               line4_least = fixSubCalculation id $ minimum [line3_sum, page3.lineB_additionalMaxPensionableEarnings],
               line5_copyC = page3.lineC_maxPensionableEarnings,
               line6_difference = fixSubCalculation id $ nonNegativeDifference line4_least.result line5_copyC,
               line7_difference = nonNegativeDifference line4_least.result line6_difference.result,
               line8_copyD = page3.lineD_maxBasicExemption,
               line9_difference = nonNegativeDifference line7_difference line8_copyD,
               line10_fraction = fixSubCalculation (0.099 *) line9_difference,
               line11_fraction = fixSubCalculation (0.02 *) line9_difference,
               line12_fraction = fixSubCalculation (0.08 *) line6_difference.result,
               line13_sum = fixSubCalculation id $ totalOf [line11_fraction.result, line12_fraction.result],
               line14_sum = totalOf [line10_fraction.result, line13_sum.result],
               line15_half = fixSubCalculation (/ 2) line10_fraction.result,
               line16_copy = line13_sum.result,
               line17_sum = totalOf [line15_half.result, line16_copy]},
   page7 :: Page7 Maybe
page7 = case Page4 Maybe
page4.line_50339_totalPensionableEarnings of
             Maybe Centi
Nothing -> (forall a. Maybe a) -> Page7 Maybe
forall {k} (g :: (k -> *) -> *) (f :: k -> *).
Applicative g =>
(forall (a :: k). f a) -> g f
forall (f :: * -> *). (forall a. f a) -> Page7 f
Rank2.pure Maybe a
forall a. Maybe a
Nothing
             Just{} -> let Page7{Maybe Centi
SubCalculation Maybe
Page7Cond3 Maybe
Page7Cond2 Maybe
Page7Cond1 Maybe
line1_netSelfEmploymentEarnings :: forall (line :: * -> *). Page7 line -> line Centi
line_50373_additionalEmploymentEarningsOffT4 :: forall (line :: * -> *). Page7 line -> line Centi
line_50399_additionalEmploymentEarningsOnT4 :: forall (line :: * -> *). Page7 line -> line Centi
line4_sum :: forall (line :: * -> *). Page7 line -> line Centi
line5_copy :: forall (line :: * -> *). Page7 line -> line Centi
line6to8 :: forall (line :: * -> *). Page7 line -> Page7Cond1 line
line9_difference :: forall (line :: * -> *). Page7 line -> line Centi
line10_fraction :: forall (line :: * -> *). Page7 line -> SubCalculation line
line11_copy :: forall (line :: * -> *). Page7 line -> line Centi
line12to14 :: forall (line :: * -> *). Page7 line -> Page7Cond2 line
line15_difference :: forall (line :: * -> *). Page7 line -> line Centi
line16_fraction :: forall (line :: * -> *). Page7 line -> SubCalculation line
line17_sum :: forall (line :: * -> *). Page7 line -> line Centi
line18to20 :: forall (line :: * -> *). Page7 line -> Page7Cond3 line
line21_copy :: forall (line :: * -> *). Page7 line -> line Centi
line22_copy :: forall (line :: * -> *). Page7 line -> line Centi
line23_sum :: forall (line :: * -> *). Page7 line -> line Centi
line24_copyC :: forall (line :: * -> *). Page7 line -> line Centi
line25_copyD :: forall (line :: * -> *). Page7 line -> line Centi
line26_difference :: forall (line :: * -> *). Page7 line -> line Centi
line27_copy :: forall (line :: * -> *). Page7 line -> line Centi
line28_difference :: forall (line :: * -> *). Page7 line -> line Centi
line1_netSelfEmploymentEarnings :: Maybe Centi
line_50373_additionalEmploymentEarningsOffT4 :: Maybe Centi
line_50399_additionalEmploymentEarningsOnT4 :: Maybe Centi
line4_sum :: Maybe Centi
line5_copy :: Maybe Centi
line6to8 :: Page7Cond1 Maybe
line9_difference :: Maybe Centi
line10_fraction :: SubCalculation Maybe
line11_copy :: Maybe Centi
line12to14 :: Page7Cond2 Maybe
line15_difference :: Maybe Centi
line16_fraction :: SubCalculation Maybe
line17_sum :: Maybe Centi
line18to20 :: Page7Cond3 Maybe
line21_copy :: Maybe Centi
line22_copy :: Maybe Centi
line23_sum :: Maybe Centi
line24_copyC :: Maybe Centi
line25_copyD :: Maybe Centi
line26_difference :: Maybe Centi
line27_copy :: Maybe Centi
line28_difference :: Maybe Centi
..} = Page7 Maybe
page7 in Page7 Maybe
page7{
               line4_sum = totalOf [line1_netSelfEmploymentEarnings,
                                    line_50373_additionalEmploymentEarningsOffT4,
                                    line_50399_additionalEmploymentEarningsOnT4],
               line5_copy = page4.line_50340_totalContributions,
               line6to8 = if any (<= 0) page4.line22_sum then Rank2.pure Nothing
                          else let Page7Cond1{..} = line6to8 in Page7Cond1{
                   line6_copy = line5_copy,
                   line7_copy = page4.line13_sum,
                   line8_difference = fixSubCalculation id $ nonNegativeDifference line6_copy line7_copy},
               line9_difference = nonNegativeDifference line5_copy line6to8.line8_difference.result,
               line10_fraction = fixSubCalculation (16.80672 *) line9_difference,
               line11_copy = page4.line_50341_totalSecondContributions,
               line12to14 = if any (<= 0) page4.line26_sum then Rank2.pure Nothing
                            else let Page7Cond2{..} = line12to14 in Page7Cond2{
                   line12_copy = line11_copy,
                   line13_copy = page4.line15_fraction.result,
                   line14_difference = fixSubCalculation id $ difference line12_copy line13_copy},
               line15_difference = if any (< 0) line12to14.line14_difference.result then line12to14.line13_copy
                                   else nonNegativeDifference line11_copy line12to14.line14_difference.result,
               line16_fraction = fixSubCalculation (25 *) line15_difference,
               line17_sum = totalOf [line10_fraction.result, line16_fraction.result],
               line18to20 = if any (> 0) page4.line26_sum then Rank2.pure Nothing
                            else let Page7Cond3{..} = line18to20 in Page7Cond3{
                   line18_abs = abs <$> page4.line25_difference.result,
                   line19_least = if any (> 0) page4.line22_sum then minimum [page4.line22_sum, line18_abs] else Just 0,
                   line20_fraction = fixSubCalculation (25 *) line19_least},
               line21_copy = line4_sum,
               line22_copy = page4.line2_least.result,
               line23_sum = totalOf [line21_copy, line22_copy],
               line24_copyC = page3.lineC_maxPensionableEarnings,
               line25_copyD = page3.lineD_maxBasicExemption,
               line26_difference = nonNegativeDifference line24_copyC line25_copyD,
               line27_copy = line10_fraction.result,
               line28_difference = nonNegativeDifference line26_difference line27_copy},
   page8 :: Page8 Maybe
page8 = case Page4 Maybe
page4.line_50339_totalPensionableEarnings of
             Maybe Centi
Nothing -> (forall a. Maybe a) -> Page8 Maybe
forall {k} (g :: (k -> *) -> *) (f :: k -> *).
Applicative g =>
(forall (a :: k). f a) -> g f
forall (f :: * -> *). (forall a. f a) -> Page8 f
Rank2.pure Maybe a
forall a. Maybe a
Nothing
             Just{} -> let Page8{Maybe Centi
SubCalculation Maybe
Page8Cond1 Maybe
line29_least :: forall (line :: * -> *). Page8 line -> line Centi
line30_copy :: forall (line :: * -> *). Page8 line -> line Centi
line31_copy :: forall (line :: * -> *). Page8 line -> line Centi
line32_difference :: forall (line :: * -> *). Page8 line -> line Centi
line33_copy :: forall (line :: * -> *). Page8 line -> line Centi
line34_copy :: forall (line :: * -> *). Page8 line -> line Centi
line35_difference :: forall (line :: * -> *). Page8 line -> SubCalculation line
line36_difference :: forall (line :: * -> *). Page8 line -> SubCalculation line
line37_difference :: forall (line :: * -> *). Page8 line -> line Centi
line38to48 :: forall (line :: * -> *). Page8 line -> Page8Cond1 line
line49_fraction :: forall (line :: * -> *). Page8 line -> SubCalculation line
line50_fraction :: forall (line :: * -> *). Page8 line -> SubCalculation line
line51_fraction :: forall (line :: * -> *). Page8 line -> SubCalculation line
line52_sum :: forall (line :: * -> *). Page8 line -> SubCalculation line
line53_sum :: forall (line :: * -> *). Page8 line -> line Centi
line54_double :: forall (line :: * -> *). Page8 line -> SubCalculation line
line55_difference :: forall (line :: * -> *). Page8 line -> line Centi
line29_least :: Maybe Centi
line30_copy :: Maybe Centi
line31_copy :: Maybe Centi
line32_difference :: Maybe Centi
line33_copy :: Maybe Centi
line34_copy :: Maybe Centi
line35_difference :: SubCalculation Maybe
line36_difference :: SubCalculation Maybe
line37_difference :: Maybe Centi
line38to48 :: Page8Cond1 Maybe
line49_fraction :: SubCalculation Maybe
line50_fraction :: SubCalculation Maybe
line51_fraction :: SubCalculation Maybe
line52_sum :: SubCalculation Maybe
line53_sum :: Maybe Centi
line54_double :: SubCalculation Maybe
line55_difference :: Maybe Centi
..} = Page8 Maybe
page8 in Page8 Maybe
page8{
               line29_least = minimum [page7.line4_sum, page7.line28_difference],
               line30_copy = page7.line25_copyD,
               line31_copy = page4.line_50339_totalPensionableEarnings,
               line32_difference = nonNegativeDifference line30_copy line31_copy,
               line33_copy = page7.line4_sum,
               line34_copy = page7.line26_difference,
               line35_difference = fixSubCalculation id $ nonNegativeDifference line33_copy line34_copy,
               line36_difference = fixSubCalculation id
                                   $ nonNegativeDifference line32_difference line35_difference.result,
               line37_difference = nonNegativeDifference line29_least line36_difference.result,
               line38to48 = if page7.line23_sum <= page7.line24_copyC then (Rank2.pure Nothing){line48_least = Just 0}
                            else let Page8Cond1{..} = line38to48 in Page8Cond1{
                   line38_copyE = page3.lineE_maxSubjectToSecondAdditionalContributions,
                   line39_copy = page7.line16_fraction.result,
                   line40_copy = page7.line18to20.line20_fraction.result,
                   line41_sum = fixSubCalculation id $ totalOf [line39_copy, line40_copy],
                   line42_difference = difference line38_copyE line41_sum.result,
                   line43_copy = page7.line4_sum,
                   line44_copy = line32_difference,
                   line45_difference = difference line43_copy line44_copy,
                   line46_copy = line37_difference,
                   line47_difference = difference line45_difference line46_copy,
                   line48_least = minimum [line42_difference, line47_difference]},
               line49_fraction = fixSubCalculation (0.099 *) line37_difference,
               line50_fraction = fixSubCalculation (0.02 *) line37_difference,
               line51_fraction = fixSubCalculation (0.08 *) line38to48.line48_least,
               line52_sum = fixSubCalculation id $ totalOf [line50_fraction.result, line51_fraction.result],
               line53_sum = totalOf [line49_fraction.result, line52_sum.result],
               line54_double = fixSubCalculation (2 *)
                               $ if any (> 0) page4.line26_sum then page4.line26_sum else Nothing,
               line55_difference = difference line53_sum line54_double.result},
   page9 :: Page9 Maybe
page9 = case Page4 Maybe
page4.line_50339_totalPensionableEarnings of
             Maybe Centi
Nothing -> (forall a. Maybe a) -> Page9 Maybe
forall {k} (g :: (k -> *) -> *) (f :: k -> *).
Applicative g =>
(forall (a :: k). f a) -> g f
forall (f :: * -> *). (forall a. f a) -> Page9 f
Rank2.pure Maybe a
forall a. Maybe a
Nothing
             Just{} -> let Page9{Maybe Centi
SubCalculation Maybe
line56_half :: forall (line :: * -> *). Page9 line -> SubCalculation line
line57_copy :: forall (line :: * -> *). Page9 line -> line Centi
line58_copy :: forall (line :: * -> *). Page9 line -> line Centi
line59_difference :: forall (line :: * -> *). Page9 line -> line Centi
line60_least :: forall (line :: * -> *). Page9 line -> line Centi
line61_copy :: forall (line :: * -> *). Page9 line -> line Centi
line62_copy :: forall (line :: * -> *). Page9 line -> line Centi
line63_difference :: forall (line :: * -> *). Page9 line -> line Centi
line64_conditionalCopy :: forall (line :: * -> *). Page9 line -> line Centi
line65_abs :: forall (line :: * -> *). Page9 line -> line Centi
line66_copy :: forall (line :: * -> *). Page9 line -> line Centi
line67_least :: forall (line :: * -> *). Page9 line -> line Centi
line68_sum :: forall (line :: * -> *). Page9 line -> SubCalculation line
line69_copy :: forall (line :: * -> *). Page9 line -> line Centi
line70_copy :: forall (line :: * -> *). Page9 line -> line Centi
line71_difference :: forall (line :: * -> *). Page9 line -> line Centi
line72_conditionalCopy :: forall (line :: * -> *). Page9 line -> line Centi
line73_abs :: forall (line :: * -> *). Page9 line -> line Centi
line74_copy :: forall (line :: * -> *). Page9 line -> line Centi
line75_least :: forall (line :: * -> *). Page9 line -> line Centi
line76_sum :: forall (line :: * -> *). Page9 line -> SubCalculation line
line77_sum :: forall (line :: * -> *). Page9 line -> line Centi
line78_half :: forall (line :: * -> *). Page9 line -> SubCalculation line
line79_half :: forall (line :: * -> *). Page9 line -> SubCalculation line
line80_sum :: forall (line :: * -> *). Page9 line -> line Centi
line81_positiveCopy :: forall (line :: * -> *). Page9 line -> line Centi
line82_difference :: forall (line :: * -> *). Page9 line -> line Centi
line83_fraction :: forall (line :: * -> *). Page9 line -> SubCalculation line
line84_copy :: forall (line :: * -> *). Page9 line -> line Centi
line85_difference :: forall (line :: * -> *). Page9 line -> line Centi
line56_half :: SubCalculation Maybe
line57_copy :: Maybe Centi
line58_copy :: Maybe Centi
line59_difference :: Maybe Centi
line60_least :: Maybe Centi
line61_copy :: Maybe Centi
line62_copy :: Maybe Centi
line63_difference :: Maybe Centi
line64_conditionalCopy :: Maybe Centi
line65_abs :: Maybe Centi
line66_copy :: Maybe Centi
line67_least :: Maybe Centi
line68_sum :: SubCalculation Maybe
line69_copy :: Maybe Centi
line70_copy :: Maybe Centi
line71_difference :: Maybe Centi
line72_conditionalCopy :: Maybe Centi
line73_abs :: Maybe Centi
line74_copy :: Maybe Centi
line75_least :: Maybe Centi
line76_sum :: SubCalculation Maybe
line77_sum :: Maybe Centi
line78_half :: SubCalculation Maybe
line79_half :: SubCalculation Maybe
line80_sum :: Maybe Centi
line81_positiveCopy :: Maybe Centi
line82_difference :: Maybe Centi
line83_fraction :: SubCalculation Maybe
line84_copy :: Maybe Centi
line85_difference :: Maybe Centi
..} = Page9 Maybe
page9 in Page9 Maybe
page9{
               line56_half = fixSubCalculation (/ 2)
                             $ if any (< 0) page8.line55_difference then abs <$> page8.line55_difference else Nothing,
               line57_copy = page4.line9_fraction.result,
               line58_copy = page4.line11_fraction.result,
               line59_difference = difference line57_copy line58_copy,
               line60_least = minimum [line57_copy, line58_copy],
               line61_copy = page4.line10_difference,
               line62_copy = page4.line12_fraction.result,
               line63_difference = difference line61_copy line62_copy,
               line64_conditionalCopy = if all (>= 0) line63_difference then line62_copy else Nothing,
               line65_abs = abs <$> line63_difference,
               line66_copy = line61_copy,
               line67_least = if any (> 0) line59_difference then minimum [line59_difference, line65_abs] else Just 0,
               line68_sum = fixSubCalculation id $ totalOf [line66_copy, line67_least],
               line69_copy = page4.line_50341_totalSecondContributions,
               line70_copy = page4.line15_fraction.result,
               line71_difference = difference line69_copy line70_copy,
               line72_conditionalCopy = if any (> 0) line71_difference then line70_copy else Nothing,
               line73_abs = abs <$> line71_difference,
               line74_copy = line69_copy,
               line75_least = if any (> 0) page4.line22_sum then minimum [page4.line22_sum, line73_abs] else Just 0,
               line76_sum = fixSubCalculation id $ totalOf [line74_copy, line75_least],
               line77_sum = totalOf [line64_conditionalCopy <|> line68_sum.result,
                                     line72_conditionalCopy <|> line76_sum.result],
               line78_half = fixSubCalculation (/ 2) page8.line49_fraction.result,
               line79_half = fixSubCalculation (/ 2) page8.line50_fraction.result,
               line80_sum = totalOf [line78_half.result, line79_half.result],
               line81_positiveCopy = maximum [page4.line26_sum, Just 0],
               line82_difference = difference line80_sum line81_positiveCopy,
               line83_fraction = fixSubCalculation (0.831933 *) $ minimum [line80_sum, line81_positiveCopy],
               line84_copy = line83_fraction.result,
               line85_difference = difference line83_fraction.result line84_copy},
   page10 :: Page10 Maybe
page10 = case Page4 Maybe
page4.line_50339_totalPensionableEarnings of
              Maybe Centi
Nothing -> (forall a. Maybe a) -> Page10 Maybe
forall {k} (g :: (k -> *) -> *) (f :: k -> *).
Applicative g =>
(forall (a :: k). f a) -> g f
forall (f :: * -> *). (forall a. f a) -> Page10 f
Rank2.pure Maybe a
forall a. Maybe a
Nothing
              Just{} -> let Page10{Maybe Centi
SubCalculation Maybe
line86_copy :: forall (line :: * -> *). Page10 line -> line Centi
line87_copy :: forall (line :: * -> *). Page10 line -> line Centi
line88_copy :: forall (line :: * -> *). Page10 line -> line Centi
line89_difference :: forall (line :: * -> *). Page10 line -> SubCalculation line
line90_copy :: forall (line :: * -> *). Page10 line -> line Centi
line91_copy :: forall (line :: * -> *). Page10 line -> line Centi
line92_difference :: forall (line :: * -> *). Page10 line -> SubCalculation line
line93_half :: forall (line :: * -> *). Page10 line -> SubCalculation line
line94_copy :: forall (line :: * -> *). Page10 line -> line Centi
line95_join :: forall (line :: * -> *). Page10 line -> line Centi
line96_difference :: forall (line :: * -> *). Page10 line -> SubCalculation line
line97_sum :: forall (line :: * -> *). Page10 line -> line Centi
line86_copy :: Maybe Centi
line87_copy :: Maybe Centi
line88_copy :: Maybe Centi
line89_difference :: SubCalculation Maybe
line90_copy :: Maybe Centi
line91_copy :: Maybe Centi
line92_difference :: SubCalculation Maybe
line93_half :: SubCalculation Maybe
line94_copy :: Maybe Centi
line95_join :: Maybe Centi
line96_difference :: SubCalculation Maybe
line97_sum :: Maybe Centi
..} = Page10 Maybe
page10 in Page10 Maybe
page10{
                line86_copy = page9.line79_half.result,
                line87_copy = page9.line78_half.result,
                line88_copy = page9.line83_fraction.result,
                line89_difference = fixSubCalculation id $ difference line87_copy line88_copy,
                line90_copy = page9.line79_half.result,
                line91_copy = page9.line85_difference,
                line92_difference = fixSubCalculation id $ difference line90_copy line91_copy,
                line93_half = fixSubCalculation (/ 2) page8.line51_fraction.result,
                line94_copy = line93_half.result,
                line95_join = if any (< 0) page9.line82_difference then abs <$> page9.line82_difference
                              else Just 0,
                line96_difference = fixSubCalculation id $ nonNegativeDifference line94_copy line95_join,
                line97_sum = totalOf [line86_copy, line89_difference.result,
                                      line92_difference.result, line96_difference.result]}}
schedule8Fields :: Schedule8 FieldConst
schedule8Fields :: Schedule8 FieldConst
schedule8Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (forall {a}. FieldConst a -> FieldConst a)
-> Schedule8 FieldConst -> Schedule8 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) -> Schedule8 p -> Schedule8 q
Rank2.<$> Schedule8{
   page2 :: 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
"Part1" (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
"Election-Evocation" (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{
      line_50372_stopMonth :: FieldConst MonthOfYear
line_50372_stopMonth = [Text] -> Entry MonthOfYear -> FieldConst MonthOfYear
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line50372", Text
"Month_grp", Text
"Stop-Month"] Entry MonthOfYear
Month,
      line_50374_revokeMonth :: FieldConst MonthOfYear
line_50374_revokeMonth = [Text] -> Entry MonthOfYear -> FieldConst MonthOfYear
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line50374", Text
"Month_grp", Text
"Revoke-Month"] Entry MonthOfYear
Month},
   page3 :: 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
"Part2" (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{
      lineA_months :: FieldConst Word
lineA_months = [Text] -> Entry Word -> FieldConst Word
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"LineA", Text
"Number"] Entry Word
Count,
      lineB_additionalMaxPensionableEarnings :: FieldConst Centi
lineB_additionalMaxPensionableEarnings = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"LineB", Text
"Amount"] Entry Centi
Amount,
      lineC_maxPensionableEarnings :: FieldConst Centi
lineC_maxPensionableEarnings = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"LineC", Text
"Amount"] Entry Centi
Amount,
      lineD_maxBasicExemption :: FieldConst Centi
lineD_maxBasicExemption = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"LineD", Text
"Amount"] Entry Centi
Amount,
      lineE_maxSubjectToSecondAdditionalContributions :: FieldConst Centi
lineE_maxSubjectToSecondAdditionalContributions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"LineE", Text
"Amount"] Entry Centi
Amount},
   page4 :: Page4 FieldConst
page4 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page4" (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
"Part3" (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{
      line_50339_totalPensionableEarnings :: FieldConst Centi
line_50339_totalPensionableEarnings = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
      line2_least :: SubCalculation FieldConst
line2_least = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line2" [Text
"Amount1"] [Text
"Amount"],
      line3_copyC :: FieldConst Centi
line3_copyC = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", Text
"Amount"] Entry Centi
Amount,
      line4_difference :: SubCalculation FieldConst
line4_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line4" [Text
"Amount1"] [Text
"Amount"],
      line5_difference :: FieldConst Centi
line5_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5", Text
"Amount"] Entry Centi
Amount,
      line6_copyD :: FieldConst Centi
line6_copyD = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"Amount"] Entry Centi
Amount,
      line7_difference :: FieldConst Centi
line7_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount"] Entry Centi
Amount,
      line_50340_totalContributions :: FieldConst Centi
line_50340_totalContributions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", Text
"Amount"] Entry Centi
Amount,
      line9_fraction :: SubCalculation FieldConst
line9_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line9" [Text
"Amount1"] [Text
"Amount2"],
      line10_difference :: FieldConst Centi
line10_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", Text
"Amount"] Entry Centi
Amount,
      line11_fraction :: SubCalculation FieldConst
line11_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line11" [Text
"Amount1"] [Text
"Amount2"],
      line12_fraction :: SubCalculation FieldConst
line12_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line12" [Text
"Amount1"] [Text
"Amount2"],
      line13_sum :: FieldConst Centi
line13_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line13", Text
"Amount"] Entry Centi
Amount,
      line_50341_totalSecondContributions :: FieldConst Centi
line_50341_totalSecondContributions = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line14", Text
"Amount"] Entry Centi
Amount,
      line15_fraction :: SubCalculation FieldConst
line15_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line15" [Text
"Amount1"] [Text
"Amount2"],
      line16_copy :: FieldConst Centi
line16_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount"] Entry Centi
Amount,
      line17_copy :: FieldConst Centi
line17_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", Text
"Amount"] Entry Centi
Amount,
      line18_difference :: FieldConst Centi
line18_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount"] Entry Centi
Amount,
      line19_copy :: FieldConst Centi
line19_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line19", Text
"Amount"] Entry Centi
Amount,
      line20_copy :: FieldConst Centi
line20_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Amount"] Entry Centi
Amount,
      line21_difference :: SubCalculation FieldConst
line21_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line21" [Text
"Amount1"] [Text
"Amount2"],
      line22_sum :: FieldConst Centi
line22_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"Amount"] Entry Centi
Amount,
      line23_copy :: FieldConst Centi
line23_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount"] Entry Centi
Amount,
      line24_copy :: FieldConst Centi
line24_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Amount"] Entry Centi
Amount,
      line25_difference :: SubCalculation FieldConst
line25_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line25" [Text
"Amount1"] [Text
"Amount2"],
      line26_sum :: FieldConst Centi
line26_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line26", Text
"Amount"] Entry Centi
Amount},
   page5 :: Page5 FieldConst
page5 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page5" (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
"Part3_Cont" (forall {a}. FieldConst a -> FieldConst a)
-> Page5 FieldConst -> Page5 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) -> Page5 p -> Page5 q
Rank2.<$> Page5{
      part3a :: Page5Part3a FieldConst
part3a = Page5Part3a{
         line27_copy :: FieldConst Centi
line27_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line27", Text
"Amount"] Entry Centi
Amount,
         line28_copy :: FieldConst Centi
line28_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line28", Text
"Amount"] Entry Centi
Amount,
         line29_copy :: FieldConst Centi
line29_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line29", Text
"Amount"] Entry Centi
Amount,
         line30_sum :: FieldConst Centi
line30_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30", Text
"Amount"] Entry Centi
Amount,
         line31_copy :: FieldConst Centi
line31_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31", Text
"Amount"] Entry Centi
Amount},
      part3b :: Page5Part3b FieldConst
part3b = Page5Part3b{
         line32_join :: FieldConst Centi
line32_join = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32", Text
"Amount"] Entry Centi
Amount,
         line33_conditionalCopy :: FieldConst Centi
line33_conditionalCopy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33", Text
"Amount"] Entry Centi
Amount,
         line34to37 :: Page5Part3bCond1 FieldConst
line34to37 = Page5Part3bCond1{
            line34_abs :: FieldConst Centi
line34_abs = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line34", Text
"Amount"] Entry Centi
Amount,
            line35_copy :: FieldConst Centi
line35_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line35", Text
"Amount"] Entry Centi
Amount,
            line36_least :: FieldConst Centi
line36_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36", Text
"Amount"] Entry Centi
Amount,
            line37_sum :: SubCalculation FieldConst
line37_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line37" [Text
"Amount1"] [Text
"Amount"]},
         line38_conditionalCopy :: FieldConst Centi
line38_conditionalCopy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38", Text
"Amount"] Entry Centi
Amount,
         line39to42 :: Page5Part3bCond2 FieldConst
line39to42 = Page5Part3bCond2{
            line39_abs :: FieldConst Centi
line39_abs = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line39", Text
"Amount"] Entry Centi
Amount,
            line40_copy :: FieldConst Centi
line40_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40", Text
"Amount"] Entry Centi
Amount,
            line41_least :: FieldConst Centi
line41_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41", Text
"Amount"] Entry Centi
Amount,
            line42_sum :: SubCalculation FieldConst
line42_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line42" [Text
"Amount1"] [Text
"Amount"]},
         line43_sum :: FieldConst Centi
line43_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line43", Text
"Amount"] Entry Centi
Amount}},
   page6 :: Page6 FieldConst
page6 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page6" (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
"Part4" (forall {a}. FieldConst a -> FieldConst a)
-> Page6 FieldConst -> Page6 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) -> Page6 p -> Page6 q
Rank2.<$> Page6{
      line1_netSelfEmploymentEarnings :: FieldConst Centi
line1_netSelfEmploymentEarnings = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
      line_50373_additionalEmploymentEarningsOffT4 :: FieldConst Centi
line_50373_additionalEmploymentEarningsOffT4 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount"] Entry Centi
Amount,
      line3_sum :: FieldConst Centi
line3_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", Text
"Amount"] Entry Centi
Amount,
      line4_least :: SubCalculation FieldConst
line4_least = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line4" [Text
"Amount1"] [Text
"Amount"],
      line5_copyC :: FieldConst Centi
line5_copyC = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5", Text
"Amount"] Entry Centi
Amount,
      line6_difference :: SubCalculation FieldConst
line6_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line6" [Text
"Amount1"] [Text
"Amount"],
      line7_difference :: FieldConst Centi
line7_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount"] Entry Centi
Amount,
      line8_copyD :: FieldConst Centi
line8_copyD = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", Text
"Amount"] Entry Centi
Amount,
      line9_difference :: FieldConst Centi
line9_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount"] Entry Centi
Amount,
      line10_fraction :: SubCalculation FieldConst
line10_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line10" [Text
"Amount1"] [Text
"Amount2"],
      line11_fraction :: SubCalculation FieldConst
line11_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line11" [Text
"Amount1"] [Text
"Amount2"],
      line12_fraction :: SubCalculation FieldConst
line12_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line12" [Text
"Amount1"] [Text
"Amount2"],
      line13_sum :: SubCalculation FieldConst
line13_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line13" [Text
"Amount1"] [Text
"Amount"],
      line14_sum :: FieldConst Centi
line14_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line14", Text
"Amount"] Entry Centi
Amount,
      line15_half :: SubCalculation FieldConst
line15_half = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line15" [Text
"Amount1"] [Text
"Amount2"],
      line16_copy :: FieldConst Centi
line16_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount"] Entry Centi
Amount,
      line17_sum :: FieldConst Centi
line17_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", Text
"amount"] Entry Centi
Amount},
   page7 :: Page7 FieldConst
page7 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page7" (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
"Part5" (forall {a}. FieldConst a -> FieldConst a)
-> Page7 FieldConst -> Page7 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) -> Page7 p -> Page7 q
Rank2.<$> Page7{
      line1_netSelfEmploymentEarnings :: FieldConst Centi
line1_netSelfEmploymentEarnings = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
      line_50373_additionalEmploymentEarningsOffT4 :: FieldConst Centi
line_50373_additionalEmploymentEarningsOffT4 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount"] Entry Centi
Amount,
      line_50399_additionalEmploymentEarningsOnT4 :: FieldConst Centi
line_50399_additionalEmploymentEarningsOnT4 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", Text
"Amount"] Entry Centi
Amount,
      line4_sum :: FieldConst Centi
line4_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line4", Text
"Amount"] Entry Centi
Amount,
      line5_copy :: FieldConst Centi
line5_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5", Text
"Amount"] Entry Centi
Amount,
      line6to8 :: Page7Cond1 FieldConst
line6to8 = Page7Cond1{
         line6_copy :: FieldConst Centi
line6_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"Amount"] Entry Centi
Amount,
         line7_copy :: FieldConst Centi
line7_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount"] Entry Centi
Amount,
         line8_difference :: SubCalculation FieldConst
line8_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line8" [Text
"Amount1"] [Text
"Amount"]},
      line9_difference :: FieldConst Centi
line9_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount"] Entry Centi
Amount,
      line10_fraction :: SubCalculation FieldConst
line10_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line10" [Text
"Amount1"] [Text
"Amount2"],
      line11_copy :: FieldConst Centi
line11_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line11", Text
"Amount"] Entry Centi
Amount,
      line12to14 :: Page7Cond2 FieldConst
line12to14 = Page7Cond2{
         line12_copy :: FieldConst Centi
line12_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line12", Text
"Amount"] Entry Centi
Amount,
         line13_copy :: FieldConst Centi
line13_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line13", Text
"Amount"] Entry Centi
Amount,
         line14_difference :: SubCalculation FieldConst
line14_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line14" [Text
"Amount1"] [Text
"Amount"]},
      line15_difference :: FieldConst Centi
line15_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line15", Text
"Amount"] Entry Centi
Amount,
      line16_fraction :: SubCalculation FieldConst
line16_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line16" [Text
"Amount1"] [Text
"Amount2"],
      line17_sum :: FieldConst Centi
line17_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", Text
"Amount"] Entry Centi
Amount,
      line18to20 :: Page7Cond3 FieldConst
line18to20 = Page7Cond3{
         line18_abs :: FieldConst Centi
line18_abs = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount"] Entry Centi
Amount,
         line19_least :: FieldConst Centi
line19_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line19", Text
"Amount"] Entry Centi
Amount,
         line20_fraction :: SubCalculation FieldConst
line20_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line20" [Text
"Amount1"] [Text
"Amount2"]},
      line21_copy :: FieldConst Centi
line21_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line21", Text
"Amount"] Entry Centi
Amount,
      line22_copy :: FieldConst Centi
line22_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"Amount"] Entry Centi
Amount,
      line23_sum :: FieldConst Centi
line23_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount"] Entry Centi
Amount,
      line24_copyC :: FieldConst Centi
line24_copyC = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line24", Text
"Amount"] Entry Centi
Amount,
      line25_copyD :: FieldConst Centi
line25_copyD = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line25", Text
"Amount"] Entry Centi
Amount,
      line26_difference :: FieldConst Centi
line26_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line26", Text
"Amount"] Entry Centi
Amount,
      line27_copy :: FieldConst Centi
line27_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line27", Text
"Amount"] Entry Centi
Amount,
      line28_difference :: FieldConst Centi
line28_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line28", Text
"Amount"] Entry Centi
Amount},
   page8 :: Page8 FieldConst
page8 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page8" (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
"Part5_Cont" (forall {a}. FieldConst a -> FieldConst a)
-> Page8 FieldConst -> Page8 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) -> Page8 p -> Page8 q
Rank2.<$> Page8{
      line29_least :: FieldConst Centi
line29_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line29", Text
"Amount"] Entry Centi
Amount,
      line30_copy :: FieldConst Centi
line30_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30", Text
"Amount"] Entry Centi
Amount,
      line31_copy :: FieldConst Centi
line31_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31", Text
"Amount"] Entry Centi
Amount,
      line32_difference :: FieldConst Centi
line32_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32", Text
"Amount"] Entry Centi
Amount,
      line33_copy :: FieldConst Centi
line33_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33", Text
"Amount"] Entry Centi
Amount,
      line34_copy :: FieldConst Centi
line34_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line34", Text
"Amount"] Entry Centi
Amount,
      line35_difference :: SubCalculation FieldConst
line35_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line35" [Text
"Amount1"] [Text
"Amount2"],
      line36_difference :: SubCalculation FieldConst
line36_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line36" [Text
"Amount1"] [Text
"Amount2"],
      line37_difference :: FieldConst Centi
line37_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line37", Text
"Amount"] Entry Centi
Amount,
      line38to48 :: Page8Cond1 FieldConst
line38to48 = Page8Cond1{
         line38_copyE :: FieldConst Centi
line38_copyE = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38", Text
"Amount"] Entry Centi
Amount,
         line39_copy :: FieldConst Centi
line39_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line39", Text
"Amount"] Entry Centi
Amount,
         line40_copy :: FieldConst Centi
line40_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40", Text
"Amount"] Entry Centi
Amount,
         line41_sum :: SubCalculation FieldConst
line41_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line41" [Text
"Amount"] [Text
"Amount2"],
         line42_difference :: FieldConst Centi
line42_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42", Text
"Amount"] Entry Centi
Amount,
         line43_copy :: FieldConst Centi
line43_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line43", Text
"Amount"] Entry Centi
Amount,
         line44_copy :: FieldConst Centi
line44_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line44", Text
"Amount"] Entry Centi
Amount,
         line45_difference :: FieldConst Centi
line45_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line45", Text
"Amount"] Entry Centi
Amount,
         line46_copy :: FieldConst Centi
line46_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line46", Text
"Amount"] Entry Centi
Amount,
         line47_difference :: FieldConst Centi
line47_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line47", Text
"Amount"] Entry Centi
Amount,
         line48_least :: FieldConst Centi
line48_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line48", Text
"Amount"] Entry Centi
Amount},
      line49_fraction :: SubCalculation FieldConst
line49_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line49" [Text
"Amount1"] [Text
"Amount2"],
      line50_fraction :: SubCalculation FieldConst
line50_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line50" [Text
"Amount1"] [Text
"Amount2"],
      line51_fraction :: SubCalculation FieldConst
line51_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line51" [Text
"Amount1"] [Text
"Amount2"],
      line52_sum :: SubCalculation FieldConst
line52_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line52" [Text
"Amount"] [Text
"Amount2"],
      line53_sum :: FieldConst Centi
line53_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line53", Text
"Amount"] Entry Centi
Amount,
      line54_double :: SubCalculation FieldConst
line54_double = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line54" [Text
"Amount1"] [Text
"Amount2"],
      line55_difference :: FieldConst Centi
line55_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line55", Text
"Amount"] Entry Centi
Amount},
   page9 :: Page9 FieldConst
page9 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page9" (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
"Part5_Cont" (forall {a}. FieldConst a -> FieldConst a)
-> Page9 FieldConst -> Page9 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) -> Page9 p -> Page9 q
Rank2.<$> Page9{
      line56_half :: SubCalculation FieldConst
line56_half = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line56" [Text
"Amount1"] [Text
"Amount"],
      line57_copy :: FieldConst Centi
line57_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line57", Text
"Amount"] Entry Centi
Amount,
      line58_copy :: FieldConst Centi
line58_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line58", Text
"Amount"] Entry Centi
Amount,
      line59_difference :: FieldConst Centi
line59_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line59", Text
"Amount"] Entry Centi
Amount,
      line60_least :: FieldConst Centi
line60_least = [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_copy :: FieldConst Centi
line62_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line62", Text
"Amount"] Entry Centi
Amount,
      line63_difference :: FieldConst Centi
line63_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line63", Text
"Amount"] Entry Centi
Amount,
      line64_conditionalCopy :: FieldConst Centi
line64_conditionalCopy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line64", Text
"Amount"] Entry Centi
Amount,
      line65_abs :: FieldConst Centi
line65_abs = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line65", Text
"Amount"] Entry Centi
Amount,
      line66_copy :: FieldConst Centi
line66_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Amount"] Entry Centi
Amount,
      line67_least :: FieldConst Centi
line67_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line67", Text
"Amount"] Entry Centi
Amount,
      line68_sum :: SubCalculation FieldConst
line68_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line68" [Text
"Amount"] [Text
"Amount2"],
      line69_copy :: FieldConst Centi
line69_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line69", Text
"Amount"] Entry Centi
Amount,
      line70_copy :: FieldConst Centi
line70_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line70", Text
"Amount"] Entry Centi
Amount,
      line71_difference :: FieldConst Centi
line71_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line71", Text
"Amount"] Entry Centi
Amount,
      line72_conditionalCopy :: FieldConst Centi
line72_conditionalCopy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line72", Text
"Amount"] Entry Centi
Amount,
      line73_abs :: FieldConst Centi
line73_abs = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line73", Text
"Amount"] Entry Centi
Amount,
      line74_copy :: FieldConst Centi
line74_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line74", Text
"Amount"] Entry Centi
Amount,
      line75_least :: FieldConst Centi
line75_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line75", Text
"Amount"] Entry Centi
Amount,
      line76_sum :: SubCalculation FieldConst
line76_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line76" [Text
"Amount"] [Text
"Amount2"],
      line77_sum :: FieldConst Centi
line77_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line77", Text
"Amount"] Entry Centi
Amount,
      line78_half :: SubCalculation FieldConst
line78_half = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line78" [Text
"Amount1"] [Text
"Amount2"],
      line79_half :: SubCalculation FieldConst
line79_half = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line79" [Text
"Amount1"] [Text
"Amount2"],
      line80_sum :: FieldConst Centi
line80_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line80", Text
"Amount2"] Entry Centi
Amount,
      line81_positiveCopy :: FieldConst Centi
line81_positiveCopy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line81", Text
"Amount2"] Entry Centi
Amount,
      line82_difference :: FieldConst Centi
line82_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line82", Text
"Amount"] Entry Centi
Amount,
      line83_fraction :: SubCalculation FieldConst
line83_fraction = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line83" [Text
"AmountA", Text
"Amount1"] [Text
"Amount2"],
      line84_copy :: FieldConst Centi
line84_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line84", Text
"Amount2"] Entry Centi
Amount,
      line85_difference :: FieldConst Centi
line85_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line85", Text
"Amount"] Entry Centi
Amount},
   page10 :: Page10 FieldConst
page10 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page10" (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
"Part5-Cont" (forall {a}. FieldConst a -> FieldConst a)
-> Page10 FieldConst -> Page10 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) -> Page10 p -> Page10 q
Rank2.<$> Page10{
      line86_copy :: FieldConst Centi
line86_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line86", Text
"Amount2"] Entry Centi
Amount,
      line87_copy :: FieldConst Centi
line87_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line87", Text
"Amount2"] Entry Centi
Amount,
      line88_copy :: FieldConst Centi
line88_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line88", Text
"Amount2"] Entry Centi
Amount,
      line89_difference :: SubCalculation FieldConst
line89_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line89" [Text
"Amount1"] [Text
"Amount"],
      line90_copy :: FieldConst Centi
line90_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line90", Text
"Amount2"] Entry Centi
Amount,
      line91_copy :: FieldConst Centi
line91_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line91", Text
"Amount2"] Entry Centi
Amount,
      line92_difference :: SubCalculation FieldConst
line92_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line92" [Text
"Amount1"] [Text
"Amount"],
      line93_half :: SubCalculation FieldConst
line93_half = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line93" [Text
"Amount1"] [Text
"Amount2"],
      line94_copy :: FieldConst Centi
line94_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line94", Text
"Amount2"] Entry Centi
Amount,
      line95_join :: FieldConst Centi
line95_join = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line95", Text
"Amount2"] Entry Centi
Amount,
      line96_difference :: SubCalculation FieldConst
line96_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line96" [Text
"Amount1"] [Text
"Amount"],
      line97_sum :: FieldConst Centi
line97_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line97", Text
"Amount"] Entry Centi
Amount}}