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

module Tax.Canada.Federal.Schedule9 where

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

import Tax.Canada.T1.Types (T1)
import Tax.Canada.T1.Types qualified
import Tax.FDF (Entry (Amount, Constant), FieldConst (Field), within)
import Tax.Util (fixEq, fractionOf, difference, nonNegativeDifference, totalOf)

data Schedule9 line = Schedule9{
   forall (line :: * -> *). Schedule9 line -> line Centi
line1_charities :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line_32900_government :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line_33300_universities :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line_33400_UN :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line5_sum :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line6_copy :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line6_fraction :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line_33700_depreciable :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line_33900_capital :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line7_sum :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line7_fraction :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line8_sum :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line9_limit :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line_34000_allowable :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line_34200_ecocultural :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line12_sum :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line13_min :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line14_difference :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line_34210_ecological :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line16_difference :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line17_copy :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line18_threshold :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line19_difference :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
lineE_copy :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line20_min :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line20_fraction :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line21_difference :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line21_fraction :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line22_copy :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line22_fraction :: line Centi,
   forall (line :: * -> *). Schedule9 line -> line Centi
line23_sum :: line Centi}

deriving instance Show (line Centi) => Show (Schedule9 line)
deriving instance Eq (line Centi) => Eq (Schedule9 line)

Rank2.TH.deriveAll ''Schedule9
Transformation.Shallow.TH.deriveAll ''Schedule9

fixSchedule9 :: T1 Maybe -> Schedule9 Maybe -> Schedule9 Maybe
fixSchedule9 :: T1 Maybe -> Schedule9 Maybe -> Schedule9 Maybe
fixSchedule9 T1 Maybe
t1 = (Schedule9 Maybe -> Schedule9 Maybe)
-> Schedule9 Maybe -> Schedule9 Maybe
forall a. Eq a => (a -> a) -> a -> a
fixEq ((Schedule9 Maybe -> Schedule9 Maybe)
 -> Schedule9 Maybe -> Schedule9 Maybe)
-> (Schedule9 Maybe -> Schedule9 Maybe)
-> Schedule9 Maybe
-> Schedule9 Maybe
forall a b. (a -> b) -> a -> b
$ \form :: Schedule9 Maybe
form@Schedule9{Maybe Centi
$sel:line1_charities:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line_32900_government:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line_33300_universities:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line_33400_UN:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line5_sum:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line6_copy:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line6_fraction:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line_33700_depreciable:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line_33900_capital:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line7_sum:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line7_fraction:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line8_sum:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line9_limit:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line_34000_allowable:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line_34200_ecocultural:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line12_sum:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line13_min:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line14_difference:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line_34210_ecological:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line16_difference:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line17_copy:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line18_threshold:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line19_difference:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:lineE_copy:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line20_min:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line20_fraction:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line21_difference:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line21_fraction:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line22_copy:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line22_fraction:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
$sel:line23_sum:Schedule9 :: forall (line :: * -> *). Schedule9 line -> line Centi
line1_charities :: Maybe Centi
line_32900_government :: Maybe Centi
line_33300_universities :: Maybe Centi
line_33400_UN :: Maybe Centi
line5_sum :: Maybe Centi
line6_copy :: Maybe Centi
line6_fraction :: Maybe Centi
line_33700_depreciable :: Maybe Centi
line_33900_capital :: Maybe Centi
line7_sum :: Maybe Centi
line7_fraction :: Maybe Centi
line8_sum :: Maybe Centi
line9_limit :: Maybe Centi
line_34000_allowable :: Maybe Centi
line_34200_ecocultural :: Maybe Centi
line12_sum :: Maybe Centi
line13_min :: Maybe Centi
line14_difference :: Maybe Centi
line_34210_ecological :: Maybe Centi
line16_difference :: Maybe Centi
line17_copy :: Maybe Centi
line18_threshold :: Maybe Centi
line19_difference :: Maybe Centi
lineE_copy :: Maybe Centi
line20_min :: Maybe Centi
line20_fraction :: Maybe Centi
line21_difference :: Maybe Centi
line21_fraction :: Maybe Centi
line22_copy :: Maybe Centi
line22_fraction :: Maybe Centi
line23_sum :: Maybe Centi
..} -> Schedule9 Maybe
form{
   line5_sum = totalOf [line1_charities, line_32900_government, line_33300_universities, line_33400_UN],
   line6_copy = t1.page4.line_23600_NetIncome,
   line6_fraction = (0.75 *) <$> line6_copy,
   line7_sum = totalOf [line_33700_depreciable, line_33900_capital],
   line7_fraction = (0.25 *) <$> line7_sum,
   line8_sum = totalOf [line6_fraction, line7_fraction],
   line9_limit = minimum [line6_copy, line8_sum],
   line_34000_allowable = minimum [line5_sum, line9_limit],
   line12_sum = totalOf [line_34000_allowable, line_34200_ecocultural],
   line13_min = minimum [line12_sum, Just 200],
   line14_difference = difference line12_sum line13_min,
   line16_difference = nonNegativeDifference line14_difference line_34210_ecological,
   line17_copy = t1.page5.step4_TaxableIncome.line_26000_TaxableIncome,
   line19_difference = nonNegativeDifference line17_copy line18_threshold,
   lineE_copy = line14_difference,
   line20_min = minimum [line16_difference, line19_difference],
   line20_fraction = (0.33 *) <$> line20_min,
   line21_difference = difference lineE_copy line20_min,
   line21_fraction = (0.29 *) <$> line21_difference,
   line22_copy = line13_min,
   line22_fraction = (0.15 *) <$> line22_copy,
   line23_sum = totalOf [line20_fraction, line21_fraction, line22_fraction]}

schedule9Fields :: Schedule9 FieldConst
schedule9Fields :: Schedule9 FieldConst
schedule9Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (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
"Page1" (forall {a}. FieldConst a -> FieldConst a)
-> Schedule9 FieldConst -> Schedule9 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) -> Schedule9 p -> Schedule9 q
Rank2.<$> Schedule9 {
   $sel:line1_charities:Schedule9 :: FieldConst Centi
line1_charities = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
   $sel:line_32900_government:Schedule9 :: FieldConst Centi
line_32900_government = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount"] Entry Centi
Amount,
   $sel:line_33300_universities:Schedule9 :: FieldConst Centi
line_33300_universities = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", Text
"Amount"] Entry Centi
Amount,
   $sel:line_33400_UN:Schedule9 :: FieldConst Centi
line_33400_UN = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line4", Text
"Amount"] Entry Centi
Amount,
   $sel:line5_sum:Schedule9 :: FieldConst Centi
line5_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5", Text
"Amount"] Entry Centi
Amount,
   $sel:line6_copy:Schedule9 :: FieldConst Centi
line6_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"AmountA", Text
"Amount"] Entry Centi
Amount,
   $sel:line6_fraction:Schedule9 :: FieldConst Centi
line6_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"Amount"] Entry Centi
Amount,
   $sel:line_33700_depreciable:Schedule9 :: FieldConst Centi
line_33700_depreciable = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"AmountB", Text
"Amount"] Entry Centi
Amount,
   $sel:line_33900_capital:Schedule9 :: FieldConst Centi
line_33900_capital = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"AmountC", Text
"Amount"] Entry Centi
Amount,
   $sel:line7_sum:Schedule9 :: FieldConst Centi
line7_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"AmountD", Text
"Amount"] Entry Centi
Amount,
   $sel:line7_fraction:Schedule9 :: FieldConst Centi
line7_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount"] Entry Centi
Amount,
   $sel:line8_sum:Schedule9 :: FieldConst Centi
line8_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", Text
"Amount"] Entry Centi
Amount,
   $sel:line9_limit:Schedule9 :: FieldConst Centi
line9_limit = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount"] Entry Centi
Amount,
   $sel:line_34000_allowable:Schedule9 :: FieldConst Centi
line_34000_allowable = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", Text
"Amount"] Entry Centi
Amount,
   $sel:line_34200_ecocultural:Schedule9 :: FieldConst Centi
line_34200_ecocultural = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line11", Text
"Amount"] Entry Centi
Amount,
   $sel:line12_sum:Schedule9 :: FieldConst Centi
line12_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line12", Text
"Amount"] Entry Centi
Amount,
   $sel:line13_min:Schedule9 :: FieldConst Centi
line13_min = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line13", Text
"Amount_Line13"] Entry Centi
Amount,
   $sel:line14_difference:Schedule9 :: FieldConst Centi
line14_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line14", Text
"Amount_Line14"] Entry Centi
Amount,
   $sel:line_34210_ecological:Schedule9 :: FieldConst Centi
line_34210_ecological = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line15", Text
"Amount"] Entry Centi
Amount,
   $sel:line16_difference:Schedule9 :: FieldConst Centi
line16_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"NumWithoutCurrency"] Entry Centi
Amount,
   $sel:line17_copy:Schedule9 :: FieldConst Centi
line17_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", Text
"Amount"] Entry Centi
Amount,
   $sel:line18_threshold:Schedule9 :: FieldConst Centi
line18_threshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
235_675 Entry Centi
Amount,
   $sel:line19_difference:Schedule9 :: FieldConst Centi
line19_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line19", Text
"Amount"] Entry Centi
Amount,
   $sel:lineE_copy:Schedule9 :: FieldConst Centi
lineE_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"AmountE", Text
"Amount_Line14"] Entry Centi
Amount,
   $sel:line20_min:Schedule9 :: FieldConst Centi
line20_min = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"AmountF", Text
"Amount"] Entry Centi
Amount,
   $sel:line20_fraction:Schedule9 :: FieldConst Centi
line20_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Amount"] Entry Centi
Amount,
   $sel:line21_difference:Schedule9 :: FieldConst Centi
line21_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line21", Text
"AmountG", Text
"Amount"] Entry Centi
Amount,
   $sel:line21_fraction:Schedule9 :: FieldConst Centi
line21_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line21", Text
"Amount"] Entry Centi
Amount,
   $sel:line22_copy:Schedule9 :: FieldConst Centi
line22_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"AmountH", Text
"Amount_Line14"] Entry Centi
Amount,
   $sel:line22_fraction:Schedule9 :: FieldConst Centi
line22_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line22", Text
"Amount"] Entry Centi
Amount,
   $sel:line23_sum:Schedule9 :: FieldConst Centi
line23_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount"] Entry Centi
Amount}