{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Tax.Canada.T4 (T4(..), T4Slip(..), t4Fields) where

import Control.Applicative (ZipList(ZipList))
import Data.Fixed (Centi)
import Data.Functor.Product (Product(Pair))
import Data.CAProvinceCodes qualified as Province
import Data.Text (Text)
import Rank2 qualified
import Rank2.TH qualified
import Transformation.Shallow.TH qualified

import Tax.FDF (FieldConst (Field, NoField), Entry (Amount, Province, Textual, Year), within)

data T4 line = T4{
   forall (line :: * -> *). T4 line -> T4Slip line
slip1 :: T4Slip line,
   forall (line :: * -> *). T4 line -> T4Slip line
slip2 :: T4Slip line}

data T4Slip line = T4Slip{
   forall (line :: * -> *). T4Slip line -> line Int
year :: line Int,
   forall (line :: * -> *). T4Slip line -> line Code
box10_provinceOfEmployment :: line Province.Code,
   forall (line :: * -> *). T4Slip line -> line Text
box12_SIN :: line Text,
   forall (line :: * -> *). T4Slip line -> line Text
employerName :: line Text,
   forall (line :: * -> *). T4Slip line -> line Text
employeeFirstName :: line Text,
   forall (line :: * -> *). T4Slip line -> line Text
employeeLastName :: line Text,
   forall (line :: * -> *). T4Slip line -> line Text
employeeInitial :: line Text,
   forall (line :: * -> *). T4Slip line -> line Text
employeeAddress :: line Text,
   forall (line :: * -> *). T4Slip line -> line Centi
box14_employmentIncome :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Centi
box16_employeeCPP :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Centi
box16a_employeeCPP :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Centi
box17_employeeQPP :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Centi
box17a_employeeQPP :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Centi
box18_employeeEI :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Centi
box20_employeeRPP :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Centi
box22_incomeTaxDeducted :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Centi
box24_insurableEarnings :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Centi
box26_pensionableEarnings :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Text
box29_employmentCode :: line Text,
   forall (line :: * -> *). T4Slip line -> line Centi
box44_unionDues :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Text
box45_dental :: line Text,
   forall (line :: * -> *). T4Slip line -> line Centi
box46_charityDonations :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Text
box50_rppNumber :: line Text,
   forall (line :: * -> *). T4Slip line -> line Centi
box52_pensionAdjustment :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Text
box54_employersAccount :: line Text,
   forall (line :: * -> *). T4Slip line -> line Centi
box55_premiumPPIP :: line Centi,
   forall (line :: * -> *). T4Slip line -> line Centi
box56_insurableEarningsPPIP :: line Centi,
   forall (line :: * -> *).
T4Slip line -> ZipList (Product (Only Text) (Only Centi) line)
otherInformation :: ZipList (Product (Rank2.Only Text) (Rank2.Only Centi) line)}

deriving instance (Show (line Centi), Show (line Province.Code), Show (line Text), Show (line Int)) => Show (T4 line)
deriving instance (Eq (line Centi), Eq (line Province.Code), Eq (line Text), Eq (line Int)) => Eq (T4 line)
deriving instance (Show (line Centi), Show (line Province.Code),
                   Show (line Text), Show (line Int)) => Show (T4Slip line)
deriving instance (Eq (line Centi), Eq (line Province.Code), Eq (line Text), Eq (line Int)) => Eq (T4Slip line)

Rank2.TH.deriveFunctor ''T4Slip
Rank2.TH.deriveApply ''T4Slip
Rank2.TH.deriveApplicative ''T4Slip
Rank2.TH.deriveFoldable ''T4Slip
Rank2.TH.deriveTraversable ''T4Slip
Rank2.TH.deriveFunctor ''T4
Rank2.TH.deriveApply ''T4
Rank2.TH.deriveApplicative ''T4
Rank2.TH.deriveFoldable ''T4
Rank2.TH.deriveTraversable ''T4
Transformation.Shallow.TH.deriveAll ''T4Slip
Transformation.Shallow.TH.deriveAll ''T4

t4Fields :: T4 FieldConst
t4Fields :: T4 FieldConst
t4Fields = 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)
-> T4 FieldConst -> T4 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) -> T4 p -> T4 q
Rank2.<$> T4{
  slip1 :: T4Slip FieldConst
slip1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Slip1" (forall {a}. FieldConst a -> FieldConst a)
-> T4Slip FieldConst -> T4Slip 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) -> T4Slip p -> T4Slip q
Rank2.<$> T4Slip FieldConst
t4SlipFields,
  slip2 :: T4Slip FieldConst
slip2 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Slip2" (forall {a}. FieldConst a -> FieldConst a)
-> T4Slip FieldConst -> T4Slip 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) -> T4Slip p -> T4Slip q
Rank2.<$> T4Slip FieldConst
t4SlipFields}

t4SlipFields :: T4Slip FieldConst
t4SlipFields :: T4Slip FieldConst
t4SlipFields = T4Slip{
   year :: FieldConst Int
year = [Text] -> Entry Int -> FieldConst Int
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Year", Text
"Slip1Year"] Entry Int
Year,
   box10_provinceOfEmployment :: FieldConst Code
box10_provinceOfEmployment = [Text] -> Entry Code -> FieldConst Code
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box10", Text
"Slip1Box10"] Entry Code
Province,
   box12_SIN :: FieldConst Text
box12_SIN = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box12", Text
"Slip1Box12"] Entry Text
Textual,
   employerName :: FieldConst Text
employerName = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"EmployersName", Text
"Slip1EmployersName"] Entry Text
Textual,
   employeeFirstName :: FieldConst Text
employeeFirstName = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Employee", Text
"FirstName", Text
"Slip1FirstName"] Entry Text
Textual,
   employeeLastName :: FieldConst Text
employeeLastName = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Employee", Text
"LastName", Text
"Slip1LastName"] Entry Text
Textual,
   employeeInitial :: FieldConst Text
employeeInitial = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Employee", Text
"Initial", Text
"Slip1Initial"] Entry Text
Textual,
   employeeAddress :: FieldConst Text
employeeAddress = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Employee", Text
"Slip1Address"] Entry Text
Textual,
   box14_employmentIncome :: FieldConst Centi
box14_employmentIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box14", Text
"Slip1Box14"] Entry Centi
Amount,
   box16_employeeCPP :: FieldConst Centi
box16_employeeCPP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box16", Text
"Slip1Box16"] Entry Centi
Amount,
   box16a_employeeCPP :: FieldConst Centi
box16a_employeeCPP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box16A", Text
"Slip1Box16A"] Entry Centi
Amount,
   box17_employeeQPP :: FieldConst Centi
box17_employeeQPP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box17", Text
"Slip1Box17"] Entry Centi
Amount,
   box17a_employeeQPP :: FieldConst Centi
box17a_employeeQPP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box17A", Text
"Slip1Box17A"] Entry Centi
Amount,
   box18_employeeEI :: FieldConst Centi
box18_employeeEI = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box18", Text
"Slip1Box18"] Entry Centi
Amount,
   box20_employeeRPP :: FieldConst Centi
box20_employeeRPP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box20", Text
"Slip1Box20"] Entry Centi
Amount,
   box22_incomeTaxDeducted :: FieldConst Centi
box22_incomeTaxDeducted = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box22", Text
"Slip1Box22"] Entry Centi
Amount,
   box24_insurableEarnings :: FieldConst Centi
box24_insurableEarnings = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box24", Text
"Slip1Box24"] Entry Centi
Amount,
   box26_pensionableEarnings :: FieldConst Centi
box26_pensionableEarnings = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box26", Text
"Slip1Box26"] Entry Centi
Amount,
   box29_employmentCode :: FieldConst Text
box29_employmentCode = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box29", Text
"Slip1Box29"] Entry Text
Textual,
   box44_unionDues :: FieldConst Centi
box44_unionDues = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box44", Text
"Slip1Box44"] Entry Centi
Amount,
   box45_dental :: FieldConst Text
box45_dental = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box45", Text
"DropDownList"] Entry Text
Textual,
   box46_charityDonations :: FieldConst Centi
box46_charityDonations = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box46", Text
"Slip1Box46"] Entry Centi
Amount,
   box50_rppNumber :: FieldConst Text
box50_rppNumber = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box50", Text
"Slip1Box50"] Entry Text
Textual,
   box52_pensionAdjustment :: FieldConst Centi
box52_pensionAdjustment = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box52", Text
"Slip1Box52"] Entry Centi
Amount,
   box54_employersAccount :: FieldConst Text
box54_employersAccount = [Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"EmployersAccount", Text
"Slip1Box54"] Entry Text
Textual,
   box55_premiumPPIP :: FieldConst Centi
box55_premiumPPIP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box55", Text
"Slip1Box55"] Entry Centi
Amount,
   box56_insurableEarningsPPIP :: FieldConst Centi
box56_insurableEarningsPPIP = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box56", Text
"Slip1Box56"] Entry Centi
Amount,
   otherInformation :: ZipList (Product (Only Text) (Only Centi) FieldConst)
otherInformation = (Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"OtherInformation" (forall {a}. FieldConst a -> FieldConst a)
-> Product (Only Text) (Only Centi) FieldConst
-> Product (Only Text) (Only Centi) 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)
-> Product (Only Text) (Only Centi) p
-> Product (Only Text) (Only Centi) q
Rank2.<$>) (Product (Only Text) (Only Centi) FieldConst
 -> Product (Only Text) (Only Centi) FieldConst)
-> ZipList (Product (Only Text) (Only Centi) FieldConst)
-> ZipList (Product (Only Text) (Only Centi) FieldConst)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Product (Only Text) (Only Centi) FieldConst]
-> ZipList (Product (Only Text) (Only Centi) FieldConst)
forall a. [a] -> ZipList a
ZipList [
       FieldConst Text -> Only Text FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box1", Text
"Slip1Box1"] Entry Text
Textual)
       Only Text FieldConst
-> Only Centi FieldConst
-> Product (Only Text) (Only Centi) FieldConst
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
`Pair`
       FieldConst Centi -> Only Centi FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount1", Text
"Slip1Amount1"] Entry Centi
Amount),
       FieldConst Text -> Only Text FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box2", Text
"Slip1Box2"] Entry Text
Textual)
       Only Text FieldConst
-> Only Centi FieldConst
-> Product (Only Text) (Only Centi) FieldConst
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
`Pair`
       FieldConst Centi -> Only Centi FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount2", Text
"Slip1Amount2"] Entry Centi
Amount),
       FieldConst Text -> Only Text FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box3", Text
"Slip1Box3"] Entry Text
Textual)
       Only Text FieldConst
-> Only Centi FieldConst
-> Product (Only Text) (Only Centi) FieldConst
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
`Pair`
       FieldConst Centi -> Only Centi FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount3", Text
"Slip1Amount3"] Entry Centi
Amount),
       FieldConst Text -> Only Text FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box4", Text
"Slip1Box4"] Entry Text
Textual)
       Only Text FieldConst
-> Only Centi FieldConst
-> Product (Only Text) (Only Centi) FieldConst
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
`Pair`
       FieldConst Centi -> Only Centi FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount4", Text
"Slip1Amount4"] Entry Centi
Amount),
       FieldConst Text -> Only Text FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box5", Text
"Slip1Box5"] Entry Text
Textual)
       Only Text FieldConst
-> Only Centi FieldConst
-> Product (Only Text) (Only Centi) FieldConst
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
`Pair`
       FieldConst Centi -> Only Centi FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount5", Text
"Slip1Amount5"] Entry Centi
Amount),
       FieldConst Text -> Only Text FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Text -> FieldConst Text
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Box6", Text
"Slip1Box6"] Entry Text
Textual)
       Only Text FieldConst
-> Only Centi FieldConst
-> Product (Only Text) (Only Centi) FieldConst
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
`Pair`
       FieldConst Centi -> Only Centi FieldConst
forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only ([Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount6", Text
"Slip1Amount6"] Entry Centi
Amount)]}