{-# 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.Schedule9 where

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

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

data Schedule9 line = Schedule9{
   forall (line :: * -> *). Schedule9 line -> Page1 line
page1 :: Page1 line,
   forall (line :: * -> *). Schedule9 line -> Page2 line
page2 :: Page2 line}

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

data Page2 line = Page2{
   forall (line :: * -> *). Page2 line -> line Text
propertyClass :: line Text,
   forall (line :: * -> *). Page2 line -> line Centi
line1_depreciation :: line Centi,
   forall (line :: * -> *). Page2 line -> line Centi
line2_dispositionProceeds :: line Centi,
   forall (line :: * -> *). Page2 line -> line Centi
line3_capitalCost :: line Centi,
   forall (line :: * -> *). Page2 line -> line Centi
line4_least :: line Centi,
   forall (line :: * -> *). Page2 line -> line Centi
line5_least :: line Centi,
   forall (line :: * -> *). Page2 line -> line Centi
line1_capitalGains :: line Centi,
   forall (line :: * -> *). Page2 line -> line Centi
line2_capitalGainsDeduction :: line Centi,
   forall (line :: * -> *). Page2 line -> line Centi
line3_difference :: line Centi}

$(foldMap
   (\t-> concat <$> sequenceA [
       [d|
           deriving instance (Show (line Centi), Show (line Text)) => Show ($(TH.conT t) line)
           deriving instance (Eq (line Centi), Eq (line Text)) => Eq ($(TH.conT t) line)
       |],
       Rank2.TH.deriveAll t,
       Transformation.Shallow.TH.deriveAll t])
   [''Schedule9, ''Page1, ''Page2])

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{Page1 Maybe
page1 :: forall (line :: * -> *). Schedule9 line -> Page1 line
page1 :: Page1 Maybe
page1, Page2 Maybe
page2 :: forall (line :: * -> *). Schedule9 line -> Page2 line
page2 :: Page2 Maybe
page2} -> Schedule9 Maybe
form{
  page1 = let Page1{..} = page1 in page1{
   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,
   line_33700_depreciable = page2.line5_least,
   line_33900_capital = page2.line3_difference,
   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]},
  page2 = let Page2{..} = page2 in page2{
   line4_least = minimum [line2_dispositionProceeds, line3_capitalCost],
   line5_least = minimum [line1_depreciation, line4_least],
   line3_difference = nonNegativeDifference line1_capitalGains line2_capitalGainsDeduction}}

schedule9Fields :: Schedule9 FieldConst
schedule9Fields :: Schedule9 FieldConst
schedule9Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (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 {
  page1 :: Page1 FieldConst
page1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page1" (forall {a}. FieldConst a -> FieldConst a)
-> Page1 FieldConst -> Page1 FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page1 p -> Page1 q
Rank2.<$> Page1{
   line1_charities :: FieldConst Centi
line1_charities = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
   line_32900_government :: 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,
   line_33300_universities :: 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,
   line_33400_UN :: 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,
   line5_sum :: FieldConst Centi
line5_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5", Text
"Amount"] Entry Centi
Amount,
   line6_copy :: 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,
   line6_fraction :: FieldConst Centi
line6_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"Amount"] Entry Centi
Amount,
   line_33700_depreciable :: 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,
   line_33900_capital :: 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,
   line7_sum :: 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,
   line7_fraction :: FieldConst Centi
line7_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount"] Entry Centi
Amount,
   line8_sum :: FieldConst Centi
line8_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", Text
"Amount"] Entry Centi
Amount,
   line9_limit :: FieldConst Centi
line9_limit = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount"] Entry Centi
Amount,
   line_34000_allowable :: 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,
   line_34200_ecocultural :: 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,
   line12_sum :: FieldConst Centi
line12_sum = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line12", Text
"Amount"] Entry Centi
Amount,
   line13_min :: 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,
   line14_difference :: 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,
   line_34210_ecological :: 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,
   line16_difference :: FieldConst Centi
line16_difference = [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_threshold :: 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
246_752 Entry Centi
Amount,
   line19_difference :: FieldConst Centi
line19_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line19", Text
"Amount"] Entry Centi
Amount,
   lineE_copy :: 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,
   line20_min :: 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,
   line20_fraction :: FieldConst Centi
line20_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line20", Text
"Amount"] Entry Centi
Amount,
   line21_difference :: 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,
   line21_fraction :: FieldConst Centi
line21_fraction = [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
"AmountH", Text
"Amount_Line14"] Entry Centi
Amount,
   line22_fraction :: FieldConst Centi
line22_fraction = [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},
  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
"Charts" (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{
   propertyClass :: FieldConst Text
propertyClass = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Chart1", Text
"TextField_Underlined_Bottom"] Entry Text
Textual,
   line1_depreciation :: FieldConst Centi
line1_depreciation = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Chart1", Text
"Line_1", Text
"Amount"] Entry Centi
Amount,
   line2_dispositionProceeds :: FieldConst Centi
line2_dispositionProceeds = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Chart1", Text
"Line_2", Text
"Amount"] Entry Centi
Amount,
   line3_capitalCost :: FieldConst Centi
line3_capitalCost = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Chart1", Text
"Line_3", Text
"Amount"] Entry Centi
Amount,
   line4_least :: FieldConst Centi
line4_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Chart1", Text
"Line_4", Text
"Amount"] Entry Centi
Amount,
   line5_least :: FieldConst Centi
line5_least = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Chart1", Text
"Line_5", Text
"Amount"] Entry Centi
Amount,
   line1_capitalGains :: FieldConst Centi
line1_capitalGains = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Chart2", Text
"Line1", Text
"Amount1"] Entry Centi
Amount,
   line2_capitalGainsDeduction :: FieldConst Centi
line2_capitalGainsDeduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Chart2", Text
"Line2", Text
"Amount"] Entry Centi
Amount,
   line3_difference :: FieldConst Centi
line3_difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Chart2", Text
"Line3", Text
"Amount"] Entry Centi
Amount}}