{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

module Tax.Canada.T1.FieldNames.QC (t1Fields) where

import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.Builder.Int (decimal)
import Rank2 qualified

import Tax.FDF (FieldConst (Field, NoField), Entry (..), within)
import Tax.Canada.Shared (TaxIncomeBracket (..), subCalculationFields)
import Tax.Canada.Shared qualified as TaxIncomeBracket (TaxIncomeBracket (..))
import Tax.Canada.T1.Types
import Tax.Canada.T1.Types qualified as Page8 (Page8(..))
import Tax.Canada.T1.Types qualified as MedicalExpenses (MedicalExpenses(..))
import Tax.Canada.T1.FieldNames.ON qualified as ON
import Tax.Canada.T1.FieldNames.BC qualified as BC

t1Fields :: T1 FieldConst
t1Fields :: T1 FieldConst
t1Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (forall {a}. FieldConst a -> FieldConst a)
-> T1 FieldConst -> T1 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) -> T1 p -> T1 q
Rank2.<$> T1 {
   $sel:page1:T1 :: Page1 FieldConst
page1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page1" (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
"Return-pg1" (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 FieldConst
ON.page1Fields,
   $sel:page2:T1 :: 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
"Return-pg2" (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 FieldConst
page2Fields,
   $sel:page3:T1 :: 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
"Return-pg3" (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 FieldConst
page3Fields,
   $sel:page4:T1 :: 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
"Step3" (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 FieldConst
page4Fields,
   $sel:page5:T1 :: Page5 FieldConst
page5 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page5" (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 FieldConst
page5Fields,
   $sel:page6:T1 :: 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
"PartB" (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 FieldConst
page6Fields,
   $sel:page7:T1 :: Page7 FieldConst
page7 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page7" (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 FieldConst
page7Fields,
   $sel:page8:T1 :: Page8 FieldConst
page8 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page8" (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 FieldConst
page8Fields}

page2Fields :: Page2 FieldConst
page2Fields = Page2 FieldConst
ON.page2Fields {
   cai = NoField,
   organ_donor = NoField}

page3Fields :: Page3 FieldConst
page3Fields = Page3 FieldConst
ON.page3Fields{
   line_10100_EmploymentIncome = Field ["Line1", "Line_10100_Amount"] Amount}

page4Fields :: Page4 FieldConst
page4Fields = Page4 FieldConst
ON.page4Fields{
   line_20810_PRPP = Field ["Line20810", "Amount"] Amount,
   line_22300_DeductionPPIP = Field ["Line22300", "Line_22300_Amount"] Amount}

page5Fields :: Page5 FieldConst
page5Fields = Page5 {
   $sel:step4_TaxableIncome:Page5 :: Step4 FieldConst
step4_TaxableIncome = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Step4" (forall {a}. FieldConst a -> FieldConst a)
-> Step4 FieldConst -> Step4 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) -> Step4 p -> Step4 q
Rank2.<$> Step4 FieldConst
step4Fields,
   $sel:partA_FederalTax:Page5 :: Page5PartA FieldConst
partA_FederalTax = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Part_A" (forall {a}. FieldConst a -> FieldConst a)
-> Page5PartA FieldConst -> Page5PartA 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) -> Page5PartA p -> Page5PartA q
Rank2.<$> Page5PartA FieldConst
partA1{column4 = column4, column5 = partA2.column5},
   $sel:partB_FederalTaxCredits:Page5 :: Page5PartB FieldConst
partB_FederalTaxCredits = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Part_B" (forall {a}. FieldConst a -> FieldConst a)
-> Page5PartB FieldConst -> Page5PartB 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) -> Page5PartB p -> Page5PartB q
Rank2.<$> Page5PartB FieldConst
partBFields}
   where partA1 :: Page5PartA FieldConst
partA1 = (Int -> Int -> Bool -> Text)
-> Text -> Int -> Page5PartA FieldConst
ON.partAFieldsWith Int -> Int -> Bool -> Text
forall {a} {p}. Integral a => a -> p -> Bool -> Text
fieldName1 Text
"Column" Int
71
         partA2 :: Page5PartA FieldConst
partA2 = (Int -> Int -> Bool -> Text)
-> Text -> Int -> Page5PartA FieldConst
ON.partAFieldsWith Int -> Int -> Bool -> Text
forall {a} {a}. (Integral a, Integral a) => a -> a -> Bool -> Text
fieldName2 Text
"Column" Int
39
         column4 :: TaxIncomeBracket FieldConst
column4 = Page5PartA FieldConst
partA2.column4{
           TaxIncomeBracket.income = partA1.column4.income,
           TaxIncomeBracket.threshold = partA1.column4.threshold}
         fieldName1 :: a -> p -> Bool -> Text
fieldName1 a
line p
_column Bool
True = Text
"Percent_Line" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Builder -> Text
toText (a -> Builder
forall a. Integral a => a -> Builder
decimal a
line)
         fieldName1 a
line p
_column Bool
False = Text
"Amount_Line" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Builder -> Text
toText (a -> Builder
forall a. Integral a => a -> Builder
decimal a
line)
         fieldName2 :: a -> a -> Bool -> Text
fieldName2 a
line a
column Bool
isRate =
            Builder -> Text
toText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Builder
"Line" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. Integral a => a -> Builder
decimal a
line Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Bool
isRate then Builder
"Rate" else Builder
"Amount") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. Integral a => a -> Builder
decimal a
column
         toText :: Builder -> Text
toText = Text -> Text
toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText

step4Fields :: Step4 FieldConst
step4Fields = Step4 FieldConst
ON.step4Fields {
   line_23600_NetIncome_2 = Field ["Line58", "Amount"] Amount}

partBFields :: Page5PartB FieldConst
partBFields = Page5PartB FieldConst
ON.partBFields {
   line30499_ChildrenNum = Field ["Line30500", "Line30499", "Line_30499_Number"] Count,
   line30500 = Field ["Line30500", "Line_30499_Amount"] Amount,
   line_81 = Field ["Line84", "Amount"] Amount}

page6Fields :: Page6 FieldConst
page6Fields = Page6 FieldConst
ON.page6Fields {
   line82 = Field ["Line85", "Amount"] Amount,
   line31205 = Field ["Line31205", "Line_31205_Amount"] Amount,
   line31210 = Field ["Line31210", "Line_31210_Amount"] Amount,
   line31215 = Field ["Line31215", "Line_31215_Amount"] Amount,
   line31600 = Field ["Line31600", "Line_31600_mount"] Amount,
   line94_sum = subCalculationFields "Line100" ["Amount1"] ["Amount2"],
   line96 = Field ["Line102", "Amount"] Amount,
   line99 = Field ["Line105", "Amount"] Amount,
   line104 = Field ["Line110", "Amount"] Amount,
   medical_expenses = page6MedicalExpensesFields,
   line33200_sum = subCalculationFields "Line33200" ["Line_33200_Amount1"] ["Line_33200_Line32Amount2"],
   line112 = Field ["Line118", "Percent"] $ Constant 0.15 Percent}

page6MedicalExpensesFields :: MedicalExpenses FieldConst
page6MedicalExpensesFields = MedicalExpenses FieldConst
ON.page6MedicalExpensesFields {
   taxableIncome = Field ["Line112", "Amount1"] Amount,
   taxableIncomeFraction = Field ["Line112", "Amount2"] Amount,
   MedicalExpenses.threshold = Field ["Line113", "Amount"] Amount,
   difference = Field ["Line114", "Amount"] Amount}

page7Fields :: Page7 FieldConst
page7Fields = Page7 {
   $sel:partC_NetFederalTax:Page7 :: Page7PartC FieldConst
partC_NetFederalTax = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"PartC" (forall {a}. FieldConst a -> FieldConst a)
-> Page7PartC FieldConst -> Page7PartC 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) -> Page7PartC p -> Page7PartC q
Rank2.<$> Page7PartC FieldConst
partCFields,
   $sel:step6_RefundOrBalanceOwing:Page7 :: Page7Step6 FieldConst
step6_RefundOrBalanceOwing = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Step6" (forall {a}. FieldConst a -> FieldConst a)
-> Page7Step6 FieldConst -> Page7Step6 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) -> Page7Step6 p -> Page7Step6 q
Rank2.<$> Page7Step6 FieldConst
page7step6Fields}

partCFields :: Page7PartC FieldConst
partCFields = Page7PartC FieldConst
ON.partCFields {
   line116 = Field ["Line122", "Amount"] Amount,
   line119 = Field ["Line125", "Amount"] Amount,
   line122_sum = subCalculationFields "Line128" ["Amount1"] ["Amount2"],
   line124 = Field ["Line130", "Amount"] Amount,
   line125 = Field ["Line131", "Amount"] Amount,
   line127 = Field ["Line133", "Amount"] Amount,
   line128 = Field ["Line134", "Amount"] Amount,
   line129 = Field ["Line135", "Amount"] Amount,
   line130 = Field ["Line136", "Amount"] Amount}

page7step6Fields :: Page7Step6 FieldConst
page7step6Fields = Page7Step6 FieldConst
ON.page7step6Fields {
   line140 = Field ["Line146", "Amount"] Amount,
   line_42100_CPPContributions = NoField}

page8Fields :: Page8 FieldConst
page8Fields = Page8 FieldConst
ON.page8Fields {
   Page8.step6_RefundOrBalanceOwing = within "Step6-Continued" Rank2.<$> page8step6Fields,
   line_1_ONOpportunitiesFund = NoField,
   line_46500 = NoField,
   line_46600 = NoField,
   line48400_Refund = Field ["Refund_or_Balancing-owing", "Line48400", "Line_48400_Amount"] Amount,
   line48500_BalanceOwing = Field ["Refund_or_Balancing-owing", "Line48500", "Line_48500_Amount"] Amount}

page8step6Fields :: Page8Step6 FieldConst
page8step6Fields = Page8Step6 FieldConst
ON.page8step6Fields {
   line_43500_totalpayable = Field ["Line151", "Amount"] Amount,
   line_43800_TaxTransferQC = Field ["Line43800", "Line_43800_Amount"] Amount,
   line_43850_diff = subCalculationFields "Line43900" ["Line_43900_Amount1"] ["Line_43900_Amount2"],
   line_42900_copy = Field ["Line44000", "Line_44000_Amount1"] Amount,
   line_44000 = Field ["Line44000", "Line_44000_Amount2"] Amount,
   line_44800_CPPOverpayment = NoField,
   line_31210_copy = Field ["Line157", "Amount"] Amount,
   line_45100_diff = subCalculationFields "Line45100" ["Line_45100_Amount1"] ["Line_45100_Amount2"],
   line_45350_CTC = Field ["Line45350", "Line_45300_Amount"] Amount,
   line_47555_TaxPaid = Field ["Line47555", "Line_47555_Amount"] Amount,
   line_47900_ProvTerrCredits = NoField,
   line164_Refund_or_BalanceOwing = Field ["Line172", "Refund_or_BalanceOwing_Amount"] Amount}