diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ Canadian Income Tax =================== -### Use ### +## Use for Canadians outside Ontario ## This Haskell package consists of a library and executable to fill out the Canadian T1 tax form. The way to use it is as follows: @@ -9,41 +9,84 @@ 1. Download the fillable PDF form from [the canada.ca Web site](https://www.canada.ca/en/revenue-agency/services/forms-publications/tax-packages-years/general-income-tax-benefit-package/ontario/5006-r.html). -2. Fill out the form; don't bother filling out any fields that are calculated from other fields in the same +2. Fill in the downloaded T1 form; don't bother with any fields that are calculated from other fields in the same form, that part will be performed automatically. 3. Save the filled-out PDF form. 4. Run - pdftk 5006-r-fill-22e.pdf generate_fdf output 5006-r-fill-22e.fdf + pdftk 5006-r-fill-22e.pdf generate_fdf output 5006-r-fill-22e-filled.fdf -where `5006-r-fill-22e.pdf` is the file you previously saved and `5006-r-fill-22e.pdf` is the name of the +where `5006-r-fill-22e.pdf` is the file you previously saved and `5006-r-fill-22e-filled.fdf` is the name of the output file; feel free to change them. 5. Run - complete-canadian-t1-form 5006-r-fill-22e.fdf -o 5006-r-fill-22e-filled.fdf + mkdir completed/ + complete-canadian-taxes --t1 5006-r-fill-22e-filled.fdf -o completed/ -where `5006-r-fill-22e-filled.fdf` is the output FDF file name with all calculated fields automatically -filled in. + to complete all the field calculations and store the result in the output file + `completed/5006-r-fill-22e-filled.fdf`. 6. Run - pdftk 5006-r-fill-22e.pdf fill_form 5006-r-fill-22e-filled.fdf output 5006-r-fill-22e-filled.pdf + pdftk 5006-r-fill-22e.pdf fill_form completed/5006-r-fill-22e-filled.fdf output 5006-r-fill-22e-filled.pdf to transfer the FDF field values from the previous step to the new PDF file, `5006-r-fill-22e-filled.pdf`. -7. Verify the final PDF file. The executable comes with no warranty and has not been approved by CRA. The -reponsibility for its correctness is still yours. +7. Carefully examine the final PDF. The executable comes with no warranty and has not been verified by CRA. The +reponsibility for the correctness of the tax return is still yours. -8. Print and sign the tax return, then send it to CRA by mail along with your documents. At some point -they'll hopefully open a way to digitally file the same information they accept on paper, but their EFILE +8. Print and sign the tax return, then send it to CRA by mail along with your other documents. At some point they'll +hopefully leave the 19th century and let us digitally file the same information they accept on paper, but their EFILE protocol is so far not open to the public. -### Installation ### +### Use for Ontario tax returns ### +1. Download the fillable federal +[(T1)](https://www.canada.ca/en/revenue-agency/services/forms-publications/tax-packages-years/general-income-tax-benefit-package/ontario/5006-r.html) +and provincial +[(ON428)](https://www.canada.ca/en/revenue-agency/services/forms-publications/tax-packages-years/general-income-tax-benefit-package/ontario/5006-c.html) +PDF forms from [the canada.ca Web site](https://www.canada.ca/en/revenue-agency/services/forms-publications/tax-packages-years/general-income-tax-benefit-package/ontario.html) + +2. Fill in the two downloaded forms; don't bother with any fields that are copied or calculated from other fields in +the two forms, that part will be performed automatically. + +3. Save the filled-out PDF forms. + +4. Run + + pdftk 5006-r-fill-22e.pdf generate_fdf output 5006-r-fill-22e-filled.fdf + pdftk 5006-c-fill-22e.pdf generate_fdf output 5006-c-fill-22e-filled.fdf + +where `5006-r-fill-22e.pdf` and `5006-c-fill-22e.pdf` are the two PDFs you previously saved and +`*-filled.fdf` are the names of the output FDF files; feel free to change them. + +5. Run + + mkdir completed/ + complete-canadian-taxes --t1 5006-r-fill-22e-filled.fdf --on428 5006-c-fill-22e-filled.fdf -o completed/ + + to complete all the field calculations and store the result in the output directory `completed/`. + +6. Run + + pdftk 5006-r-fill-22e.pdf fill_form completed/5006-r-fill-22e-filled.fdf output completed/5006-r-fill-22e.pdf + pdftk 5006-c-fill-22e.pdf fill_form completed/5006-c-fill-22e-filled.fdf output completed/5006-c-fill-22e.pdf + +to transfer the FDF field values from the previous step to the new PDF files in the `completed/` directory. + +7. Carefully examine the final PDF outputs. The executable comes with no warranty and has not been verified by +CRA. The reponsibility for the tax returns' correctness is still yours. + +8. Print the PDFs, sign the tax return, then send it to CRA by mail along with the rest of your documents. At some +point they'll hopefully open a way to digitally file the same information they accept on paper, but their EFILE +protocol is so far not open to the public. + +## Installation ## + As you can see from the above instructions, you'll need to install the free `pdftk` executable to deal with PDF <-> FDF conversion. See [their instructions](https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/). On Ubuntu you can simply run @@ -55,3 +98,17 @@ (version 9.2 or greater) and `cabal`, then to run cabal install canadian-income-tax + +## Design notes and hints ## + +The executable `complete-canadian-taxes` follows the Unix philosphy of doing one well-defined thing. It doesn't +attempt to guide you, the user, through the entire process of filing the taxes. It merely performs the task that is +easy to automate, and therefore also the most boring. It's not likely to make the tax-filing process a joy, but at +least it's going to involve less drudgery. + +If at any point you find you made a mistake in your initial form entry, or you want to adjust it for any reason, you +can make the adjustments either on the forms you kept from step #2 or on the final forms, and feed them back in +step #3. The executable will overwrite all calculated fields with theit proper values. + +The FDF files are almost text files, which makes them `diff`able. You can use this to quickly compare the effect of +different changes without eyeballing through the PDF forms. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -4,26 +4,30 @@ module Main where -import Control.Applicative ((<**>)) +import Codec.Archive.Tar qualified as Tar +import Codec.Archive.Tar.Entry (fileEntry, toTarPath) +import Control.Applicative ((<**>), optional) import Control.Monad (when) import Control.Monad.Trans.State.Strict (get, put, evalState) import Data.ByteString qualified as ByteString +import Data.ByteString.Lazy qualified as ByteString.Lazy import Options.Applicative (Parser, execParser, helper, info, long, metavar, progDesc, short, strArgument, strOption, switch, value) +import System.Directory (doesDirectoryExist) +import System.FilePath (replaceDirectory, takeFileName) import System.IO (hPutStrLn, stderr) import Text.FDF (parse, serialize) -import Tax.Canada.T1.FDF qualified as FDF -import Tax.Canada.T1.FieldNames -import Tax.Canada.T1.Fix (fixT1) -import Tax.Canada.T1.Types +import Tax.FDF qualified as FDF +import Tax.Canada (fixOntarioReturns, fixON428, fixT1, on428Fields, t1Fields) main :: IO () main = execParser (info optionsParser $ progDesc "Update all calculated fields in a Canadian T1 tax form") >>= process data Options = Options { - inputPath :: FilePath, + t1InputPath :: Maybe FilePath, + on428InputPath :: Maybe FilePath, outputPath :: FilePath, verbose :: Bool} @@ -31,20 +35,63 @@ optionsParser :: Parser Options optionsParser = Options - <$> strArgument (metavar "") + <$> optional (strOption (long "t1" <> metavar "")) + <*> optional (strOption (long "on428" <> metavar "")) <*> strOption (short 'o' <> long "output" <> value "-" <> metavar "") <*> switch (short 'v' <> long "verbose") <**> helper process :: Options -> IO () -process Options{inputPath, outputPath, verbose} = do - bytes <- if inputPath == "-" then ByteString.getContents else ByteString.readFile inputPath - case parse bytes >>= (\x-> (,) x <$> FDF.load x) of - Left err -> error err - Right (fdf, t1) -> do - let fdf' = FDF.update t1' fdf - t1' = fixT1 t1 - write = if outputPath == "-" then ByteString.putStr else ByteString.writeFile outputPath - when verbose (hPutStrLn stderr $ show t1') - write (serialize fdf') +process Options{t1InputPath, on428InputPath, outputPath, verbose} = do + let read path = if path == "-" then ByteString.getContents else ByteString.readFile path + writeFrom inputPath content = + if outputPath == "-" + then ByteString.putStr content + else do isDir <- doesDirectoryExist outputPath + if isDir + then ByteString.writeFile (replaceDirectory inputPath outputPath) content + else ByteString.writeFile outputPath content + case (t1InputPath, on428InputPath) of + (Nothing, Nothing) -> error "You must specify a T1 form, ON428 form, or both." + (Just path, Nothing) -> do + bytes <- read path + case parse bytes >>= \x-> (,) x <$> FDF.load t1Fields x of + Left err -> error err + Right (fdf, form) -> do + let fdf' = FDF.update t1Fields form' fdf + form' = fixT1 form + when verbose (hPutStrLn stderr $ show form') + writeFrom path (serialize fdf') + (Nothing, Just path) -> do + bytes <- read path + case parse bytes >>= \x-> (,) x <$> FDF.load on428Fields x of + Left err -> error err + Right (fdf, form) -> do + let fdf' = FDF.update on428Fields form' fdf + form' = fixON428 form + when verbose (hPutStrLn stderr $ show form') + writeFrom path (serialize fdf') + (Just pathT1, Just pathON) -> do + bytesT1 <- read pathT1 + bytesON <- read pathON + case (,) <$> (parse bytesT1 >>= \x-> (,) x <$> FDF.load t1Fields x) + <*> (parse bytesON >>= \x-> (,) x <$> FDF.load on428Fields x) of + Left err -> error err + Right ((fdfT1, formT1), (fdfON, formON)) -> do + let fdf'T1 = serialize $ FDF.update t1Fields form'T1 fdfT1 + fdf'ON = serialize $ FDF.update on428Fields form'ON fdfON + (form'T1, form'ON) = fixOntarioReturns (formT1, formON) + fdfEntry path content = + (`fileEntry` ByteString.Lazy.fromStrict content) <$> toTarPath False (takeFileName path) + tarEntries = sequenceA [fdfEntry pathT1 fdf'T1, + fdfEntry pathON fdf'ON] + tarFile = either (error . ("Can't tar: " <>)) (ByteString.Lazy.toStrict . Tar.write) tarEntries + when verbose (hPutStrLn stderr $ show (form'T1, form'ON)) + if outputPath == "-" + then ByteString.putStr tarFile + else do isDir <- doesDirectoryExist outputPath + if isDir + then do writeFrom pathT1 fdf'T1 + writeFrom pathON fdf'ON + else ByteString.writeFile outputPath tarFile diff --git a/canadian-income-tax.cabal b/canadian-income-tax.cabal --- a/canadian-income-tax.cabal +++ b/canadian-income-tax.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: canadian-income-tax -version: 2022.1 +version: 2022.2 synopsis: Canadian income tax calculation @@ -16,6 +16,7 @@ author: Mario Blažević maintainer: blamario@protonmail.com bug-reports: https://github.com/blamario/canadian-income-tax/issues +tested-with: ghc == 9.4.4 extra-source-files: CHANGELOG.md, README.md source-repository head @@ -24,10 +25,15 @@ library exposed-modules: + Tax.FDF + Tax.Canada Tax.Canada.T1.Types - Tax.Canada.T1.FDF Tax.Canada.T1.FieldNames Tax.Canada.T1.Fix + Tax.Canada.ON428.Types + Tax.Canada.ON428.FieldNames + Tax.Canada.ON428.Fix + Tax.Util -- Modules included in this library but not exported. -- other-modules: @@ -37,12 +43,12 @@ build-depends: base == 4.*, text >= 1.0 && < 2.1, time == 1.*, containers >= 0.5 && < 0.7, monoid-subclasses == 1.*, rank2classes ^>= 1.5, - ca-province-codes == 1.0.*, forms-data-format == 0.1.*, + ca-province-codes == 1.0.*, forms-data-format ^>= 0.2, template-haskell == 2.* hs-source-dirs: src default-language: Haskell2010 -executable complete-canadian-t1-form +executable complete-canadian-taxes main-is: Main.hs -- Modules included in this executable, other than Main. @@ -53,6 +59,7 @@ build-depends: base == 4.*, text, bytestring >= 0.10.4 && < 1, transformers >= 0.1 && < 0.7, rank2classes, optparse-applicative >= 0.15 && < 0.18, + filepath >= 1.3 && < 1.5, directory >= 1.2 && < 1.4, tar >= 0.4 && < 0.6, forms-data-format, canadian-income-tax hs-source-dirs: app diff --git a/src/Tax/Canada.hs b/src/Tax/Canada.hs new file mode 100644 --- /dev/null +++ b/src/Tax/Canada.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE OverloadedRecordDot #-} + +module Tax.Canada (T1, ON428, fixOntarioReturns, fixT1, fixON428, t1Fields, on428Fields) where + +import Tax.Canada.T1.Types qualified as T1 +import Tax.Canada.T1.Types (T1 (T1, page7), Page7(Page7, step6_RefundOrBalanceOwing)) +import Tax.Canada.T1.Fix (fixT1) +import Tax.Canada.T1.FieldNames (t1Fields) +import Tax.Canada.ON428.Types qualified as ON hiding (Page1(..)) +import Tax.Canada.ON428.Types (ON428 (ON428, page1, page2), + Page1(Page1, line1, partB)) +import Tax.Canada.ON428.Fix (fixON428) +import Tax.Canada.ON428.FieldNames (on428Fields) +import Tax.Util (fixEq) + +fixOntarioReturns :: (T1 Maybe, ON428 Maybe) -> (T1 Maybe, ON428 Maybe) +fixOntarioReturns = + fixEq $ \(t1@T1{page7 = page7@Page7{step6_RefundOrBalanceOwing}}, + on428@ON428{page1 = page1@Page1{partB}, + page2 = page2@ON.Page2{ON.partB = partB2@ON.Page2PartB{ON.medicalExpenses}, + ON.partC}}) + -> (fixT1 t1{page7 = + page7{step6_RefundOrBalanceOwing = + step6_RefundOrBalanceOwing{T1.line_42800_ProvTerrTax = on428.page4.line90}}}, + fixON428 on428{page1 = + page1{line1 = t1.page5.step4_TaxableIncome.line_26000_TaxableIncome, + partB = partB{ON.line12_spouseIncome = t1.page1.spouse.line23600, + ON.line19_cppQpp = t1.page6.line30800, + ON.line20_cppQpp = t1.page6.line31000, + ON.line21_employmentInsurance = t1.page6.line31200, + ON.line22_employmentInsurance = t1.page6.line31217}}, + page2 = + page2{ON.partB = partB2{ON.line32_interest = t1.page6.line31900, + ON.medicalExpenses = + medicalExpenses{ON.line37_income = + t1.page4.line_23600_NetIncome}}, + ON.partC = partC{ON.line59_copy = t1.page7.partC_NetFederalTax.line40427}}}) diff --git a/src/Tax/Canada/ON428/FieldNames.hs b/src/Tax/Canada/ON428/FieldNames.hs new file mode 100644 --- /dev/null +++ b/src/Tax/Canada/ON428/FieldNames.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Tax.Canada.ON428.FieldNames (on428Fields) where + +import Data.Fixed (Centi) +import Rank2 qualified + +import Tax.Canada.ON428.Types +import Tax.FDF (Entry (Count, Amount, Percent), FieldConst (Field), within) + +on428Fields = within "form1" Rank2.<$> ON428 { + page1 = within "Page1" Rank2.<$> page1Fields, + page2 = within "Page2" Rank2.<$> page2Fields, + page3 = within "Page3" Rank2.<$> page3Fields, + page4 = within "Page4" Rank2.<$> page4Fields} + + +page1Fields = Page1 { + line1 = Field ["Line1", "Amount"] Amount, + partA = within "Chart" Rank2.<$> page1PartAFields, + partB = within "Part_B" Rank2.<$> page1PartBFields} + +page1PartAFields = Page1PartA { + column1 = within "Column1" Rank2.<$> taxIncomeBracketFields, + column2 = within "Column2" Rank2.<$> taxIncomeBracketFields, + column3 = within "Column3" Rank2.<$> taxIncomeBracketFields, + column4 = within "Column4" Rank2.<$> taxIncomeBracketFields, + column5 = within "Column5" Rank2.<$> taxIncomeBracketFields} + +taxIncomeBracketFields = TaxIncomeBracket { + line2_income = Field ["Line2", "Amount"] Amount, + line3_threshold = Field ["Line3", "Amount"] Amount, + line4_overThreshold = Field ["Line4", "Amount"] Amount, + line5_rate = Field ["Line5", "Percent"] Percent, + line6_timesRate = Field ["Line6", "Amount"] Amount, + line7_baseTax = Field ["Line7", "Amount"] Amount, + line8_equalsTax = Field ["Line8", "Amount"] Amount} + +page1PartBFields = Page1PartB { + line9_basic = Field ["Line9", "Amount"] Amount, + line10_age = Field ["Line10", "Amount"] Amount, + line11_base = Field ["Spouse-Amount", "Line11", "Amount"] Amount, + line12_spouseIncome = Field ["Spouse-Amount", "Line12", "Amount"] Amount, + line13_difference = Field ["Spouse-Amount", "Line13", "Amount1"] Amount, + line13_cont = Field ["Spouse-Amount", "Line13", "Amount2"] Amount, + line14_base = Field ["Eligible-Dependant", "Line14", "Amount"] Amount, + line15_dependentIncome = Field ["Eligible-Dependant", "Line15", "Amount"] Amount, + line16_difference = Field ["Eligible-Dependant", "Line16", "Amount1"] Amount, + line16_cont = Field ["Eligible-Dependant", "Line16", "Amount2"] Amount, + line17_caregiver = Field ["Line17", "Amount"] Amount, + line18 = Field ["Line18", "Amount"] Amount, + line19_cppQpp = Field ["CPP-QPP", "Line19", "Amount"] Amount, + line20_cppQpp = Field ["CPP-QPP", "Line20", "Amount"] Amount, + line21_employmentInsurance = Field ["Employment-Insurance", "Line21", "Amount"] Amount, + line22_employmentInsurance = Field ["Employment-Insurance", "Line22", "Amount"] Amount, + line23_adoption = Field ["Line23", "Amount"] Amount, + line24_sum = Field ["Line24", "Amount1"] Amount, + line24_cont = Field ["Line24", "Amount2"] Amount, + line25 = Field ["Line25", "Amount"] Amount} + +page2Fields = Page2 { + partB = page2PartBFields, + partC = page2PartCFields} + +page2PartBFields = Page2PartB { + line26 = Field ["Line26", "Amount"] Amount, + line27_pension = Field ["Line27", "Amount"] Amount, + line28 = Field ["Line28", "Amount"] Amount, + line29_disability = Field ["Line29", "Amount"] Amount, + line30 = Field ["Line30", "Amount"] Amount, + line31 = Field ["Line31", "Amount"] Amount, + line32_interest = Field ["Line32", "Amount"] Amount, + line33_education = Field ["Line33", "Amount"] Amount, + line34_transferred = Field ["Line34", "Amount"] Amount, + line35 = Field ["Line35", "Amount"] Amount, + medicalExpenses = within "Medical-Expenses" Rank2.<$> medicalExpensesFields, + line42 = Field ["Line42", "Amount"] Amount, + line43_sum = Field ["Line43", "Amount1"] Amount, + line43_cont = Field ["Line43", "Amount2"] Amount, + line44 = Field ["Line44", "Amount"] Amount, + line45_rate = Field ["Line45", "Percent_ReadOnly"] Percent, + line46_fraction = Field ["Line46", "Amount"] Amount, + donations = within "Donations" Rank2.<$> donationsFields, + line50 = Field ["Line50", "Amount"] Amount} + +medicalExpensesFields = MedicalExpenses { + line36_expenses = Field ["Line36", "Amount"] Amount, + line37_income = Field ["Line37", "Amount"] Amount, + line38_rate = Field ["Line38", "Percent_ReadOnly"] Percent, + line39_fraction = Field ["Line39", "Amount"] Amount, + line40_lesser = Field ["Line40", "Amount"] Amount, + line41_difference = Field ["Line41", "Amount"] Amount} + +donationsFields = Donations { + line47_base = Field ["Line47", "Amount1"] Amount, + line47_fraction = Field ["Line47", "Amount2"] Amount, + line48_base = Field ["Line48", "Amount1"] Amount, + line48_fraction = Field ["Line48", "Amount2"] Amount, + line49_sum = Field ["Line49", "Amount1"] Amount, + line49_cont = Field ["Line49", "Amount2"] Amount} + +page2PartCFields = Page2PartC { + line51_tax = Field ["Line51", "Amount"] Amount, + line52_credits = Field ["Line52", "Amount"] Amount, + line53 = Field ["Line53", "Amount"] Amount, + line54 = Field ["Line54", "Amount"] Amount, + line55 = Field ["Line55", "Amount"] Amount, + line56 = Field ["Min-Tax-Carryover", "Line56", "Amount"] Amount, + line57 = Field ["Min-Tax-Carryover", "Line57", "Amount"] Amount, + line58 = Field ["Min-Tax-Carryover", "Line58", "Amount"] Amount, + line59_copy = Field ["Min-Tax-Carryover", "Line59", "Amount1"] Amount, + line59_product = Field ["Min-Tax-Carryover", "Line59", "Amount2"] Amount, + line60_lesser = Field ["Min-Tax-Carryover", "Line60", "Amount"] Amount, + line61 = Field ["Line61", "Amount"] Amount} + +page3Fields = Page3 { + line62 = Field ["Line62", "Amount"] Amount, + line63 = Field ["ON-Surtax", "Line63", "Amount"] Amount, + line64 = Field ["ON-Surtax", "Line64", "Amount"] Amount, + line65 = Field ["ON-Surtax", "Line65", "Amount"] Amount, + line66_copy = Field ["Line66", "Amount1"] Amount, + line66_surtax = Field ["Line66", "Amount2"] Amount, + line67_copy = Field ["Line67", "Amount1"] Amount, + line67_surtax = Field ["Line67", "Amount2"] Amount, + line68_sum = Field ["Line68", "Amount1"] Amount, + line68_cont = Field ["Line68", "Amount2"] Amount, + line69 = Field ["Line69", "Amount2"] Amount, + line70 = Field ["Line70", "Amount"] Amount, + line71 = Field ["Line71", "Amount"] Amount, + line72 = Field ["Line72", "Amount"] Amount, + line73 = Field ["Line73", "Amount"] Amount, + line74_basicReduction = Field ["Line74", "Amount"] Amount, + line75_childrenNum = Field ["Line75", "Line_60969", "Number"] Count, + line75_amount = Field ["Line75", "Amount"] Amount, + line76_childrenNum = Field ["Line76", "Line_60970", "Number"] Count, + line76_amount = Field ["Line76", "Amount"] Amount, + line77 = Field ["Line77", "Amount"] Amount, + line78_copy = Field ["Line78", "Amount1"] Amount, + line78_product = Field ["Line78", "Amount2"] Amount, + line79 = Field ["Line79", "Amount"] Amount, + line80_difference = Field ["Line80", "Amount1"] Amount, + line80_cont = Field ["Line80", "Amount2"] Amount, + line81 = Field ["Line81", "Amount"] Amount, + line82 = Field ["Line82", "Amount"] Amount, + line83 = Field ["Line83", "Amount"] Amount} + +page4Fields = Page4 { + line84 = Field ["Line84", "Amount"] Amount, + line85_lift = Field ["Line85", "Amount"] Amount, + line86 = Field ["Line86", "Amount"] Amount, + line87_foodDonations = Field ["Line87", "Line62150", "Amount1"] Amount, + line87_fraction = Field ["Line87", "Amount2"] Amount, + line88 = Field ["Line88", "Amount"] Amount, + line89_health = Field ["Line89", "Amount"] Amount, + line90 = Field ["Line90", "Amount"] Amount, + healthPremium = within "ON_Health_Prenium-worksheet" . within "Chart_ON_Health_Prenium" Rank2.<$> healthPremiumFields} + +healthPremiumFields = HealthPremium { + row1 = within "Taxable_Line2" Rank2.<$> healthPremiumBracketFields{equalsTax = Field ["Amount3"] Amount}, + row2 = within "Taxable_Line4" Rank2.<$> healthPremiumBracketFields, + row3 = within "Taxable_Line6" Rank2.<$> healthPremiumBracketFields, + row4 = within "Taxable_Line8" Rank2.<$> healthPremiumBracketFields, + row5 = within "Taxable_Line10" Rank2.<$> healthPremiumBracketFields} + +healthPremiumBracketFields = HealthPremiumBracket { + taxableIncome = Field ["Amount1"] Amount, + overThreshold = Field ["Amount2"] Amount, + timesRate = Field ["Amount3"] Amount, + equalsTax = Field ["Amount4"] Amount} diff --git a/src/Tax/Canada/ON428/Fix.hs b/src/Tax/Canada/ON428/Fix.hs new file mode 100644 --- /dev/null +++ b/src/Tax/Canada/ON428/Fix.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Tax.Canada.ON428.Fix (fixON428) where + +import Control.Applicative (liftA2) +import Control.Monad (guard, mfilter) +import Data.Fixed (Centi) +import Rank2 qualified + +import Tax.Canada.ON428.Types +import Tax.Util (fixEq, fractionOf, nonNegativeDifference, totalOf) + +fixON428 :: ON428 Maybe -> ON428 Maybe +fixON428 = fixEq $ \on428@ON428{..}-> ON428{page1 = fixPage1 page1, + page2 = fixPage2 on428 page2, + page3 = fixPage3 on428 page3, + page4 = fixPage4 on428 page4} + +fixPage1 :: Page1 Maybe -> Page1 Maybe +fixPage1 = fixEq $ \Page1{..}-> Page1{ + line1 = line1, + partA = fixPage1PartA line1 partA, + partB = fixPage1PartB partB} + +fixPage1PartA :: Maybe Centi -> Page1PartA Maybe -> Page1PartA Maybe +fixPage1PartA income = fixEq $ \Page1PartA{..}-> Page1PartA{ + column1 = fixTaxIncomeBracket income (Just column2) column1, + column2 = fixTaxIncomeBracket income (Just column3) column2, + column3 = fixTaxIncomeBracket income (Just column4) column3, + column4 = fixTaxIncomeBracket income (Just column5) column4, + column5 = fixTaxIncomeBracket income Nothing column5} + +fixTaxIncomeBracket :: Maybe Centi -> Maybe (TaxIncomeBracket Maybe) -> TaxIncomeBracket Maybe -> TaxIncomeBracket Maybe +fixTaxIncomeBracket income nextBracket bracket@TaxIncomeBracket{..} = bracket{ + line2_income = do i <- income + floor <- line3_threshold + let ceiling = nextBracket >>= (.line3_threshold) + guard (floor <= i && all (i <) ceiling) + income, + line4_overThreshold = liftA2 (-) line2_income line3_threshold, + line6_timesRate = fromRational <$> liftA2 (*) (toRational <$> line4_overThreshold) line5_rate, + line8_equalsTax = liftA2 (+) line6_timesRate line7_baseTax} + +fixPage1PartB :: Page1PartB Maybe -> Page1PartB Maybe +fixPage1PartB = fixEq $ \part@Page1PartB{..}-> part{ + line9_basic = Just 11141, + line11_base = Just 10406, + line13_difference = mfilter (> 0) $ liftA2 (-) line11_base line12_spouseIncome, + line13_cont = line13_difference, + line14_base = Just 10406, + line16_difference = mfilter (> 0) $ liftA2 (-) line14_base line15_dependentIncome, + line16_cont = line16_difference, + line18 = totalOf [line9_basic, line10_age, line13_cont, line16_cont, line17_caregiver], + line24_sum = totalOf [line19_cppQpp, + line20_cppQpp, + line21_employmentInsurance, + line22_employmentInsurance, + line23_adoption], + line24_cont = line24_sum, + line25 = totalOf [line18, line24_cont]} + +fixPage2 :: ON428 Maybe -> Page2 Maybe -> Page2 Maybe +fixPage2 on428 = fixEq $ \Page2{..}-> Page2{ + partB = fixPage2PartB on428 partB, + partC = fixPage2PartC on428 partC} + +fixPage2PartB :: ON428 Maybe -> Page2PartB Maybe -> Page2PartB Maybe +fixPage2PartB on428 = fixEq $ \part@Page2PartB{..}-> part{ + line26 = on428.page1.partB.line25, + line28 = totalOf [line26, line27_pension], + line31 = totalOf [line28, line29_disability, line30], + line35 = totalOf [line31, line32_interest, line33_education, line34_transferred], + medicalExpenses = fixMedicalExpenses medicalExpenses, + line43_sum = totalOf [medicalExpenses.line41_difference, line42], + line43_cont = line43_sum, + line44 = totalOf [line35, line43_cont], + line46_fraction = line45_rate `fractionOf` line44, + donations = fixDonations donations, + line50 = totalOf [line46_fraction, donations.line49_cont]} + +fixPage2PartC :: ON428 Maybe -> Page2PartC Maybe -> Page2PartC Maybe +fixPage2PartC on428 = fixEq $ \part@Page2PartC{..}-> part{ + line51_tax = totalOf [on428.page1.partA.column1.line8_equalsTax, + on428.page1.partA.column2.line8_equalsTax, + on428.page1.partA.column3.line8_equalsTax, + on428.page1.partA.column4.line8_equalsTax, + on428.page1.partA.column5.line8_equalsTax], + line52_credits = on428.page2.partB.line50, + line53 = nonNegativeDifference line51_tax line52_credits, + line55 = totalOf [line53, line54], + line56 = line53, + line58 = nonNegativeDifference line56 line57, + line59_product = Just 0.3367 `fractionOf` line59_copy, + line60_lesser = min <$> line58 <*> line59_product, + line61 = nonNegativeDifference line55 line60_lesser} + +fixMedicalExpenses :: MedicalExpenses Maybe -> MedicalExpenses Maybe +fixMedicalExpenses = fixEq $ \part@MedicalExpenses{..} -> part{ + line38_rate = Just 0.03, + line39_fraction = line38_rate `fractionOf` line37_income, + line40_lesser = min 2522 <$> line39_fraction, + line41_difference = nonNegativeDifference line36_expenses line40_lesser} + +fixDonations :: Donations Maybe -> Donations Maybe +fixDonations = fixEq $ \part@Donations{..} -> part{ + line47_fraction = Just 0.0505 `fractionOf` line47_base, + line48_fraction = Just 0.1116 `fractionOf` line48_base, + line49_sum = totalOf [line47_fraction, line48_fraction], + line49_cont = line49_sum} + +fixPage3 :: ON428 Maybe -> Page3 Maybe -> Page3 Maybe +fixPage3 on428 = fixEq $ \page@Page3{..}-> page{ + line62 = on428.page2.partC.line61, + line63 = line62, + line64 = on428.page2.partC.line54, + line65 = nonNegativeDifference line63 line64, + line66_copy = line65, + line66_surtax = Just 0.2 `fractionOf` nonNegativeDifference line66_copy (Just 4991), + line67_copy = line65, + line67_surtax = Just 0.36 `fractionOf` nonNegativeDifference line67_copy (Just 6387), + line68_sum = totalOf [line66_surtax, line67_surtax], + line68_cont = line68_sum, + line69 = totalOf [line62, line68_cont], + line70 = on428.page2.partC.line57, + line71 = nonNegativeDifference line69 line70, + line73 = totalOf [line71, line72], + line74_basicReduction = Just 257, + line75_amount = ((475 *) . fromIntegral) <$> line75_childrenNum, + line76_amount = ((475 *) . fromIntegral) <$> line76_childrenNum, + line77 = totalOf [line74_basicReduction, line75_amount, line76_amount], + line78_copy = line77, + line78_product = (2 *) <$> line78_copy, + line79 = line73, + line80_difference = nonNegativeDifference line78_product line79, + line80_cont = line80_difference, + line81 = nonNegativeDifference line73 line80_cont, + line83 = nonNegativeDifference line81 line82} + +fixPage4 :: ON428 Maybe -> Page4 Maybe -> Page4 Maybe +fixPage4 on428 = fixEq $ \page@Page4{..}-> page{ + line84 = on428.page3.line83, + line86 = nonNegativeDifference line84 line85_lift, + line87_fraction = Just 0.25 `fractionOf` line87_foodDonations, + line88 = nonNegativeDifference line86 line87_fraction, + line89_health = totalOf [between 0 20000 0, + healthPremium.row1.equalsTax, + between 25000 36000 300, + healthPremium.row2.equalsTax, + between 38500 48000 450, + healthPremium.row3.equalsTax, + between 48600 72000 600, + healthPremium.row4.equalsTax, + between 72600 200000 750, + healthPremium.row5.equalsTax, + if income > 200600 then Just 900 else Nothing], + line90 = totalOf [line88, line89_health], + healthPremium = fixHealthPremium income healthPremium} + where income = sum on428.page1.line1 + between floor ceiling tax + | income > floor && income <= ceiling = Just tax + | otherwise = Nothing + +fixHealthPremium :: Centi -> HealthPremium Maybe -> HealthPremium Maybe +fixHealthPremium income = fixEq $ \HealthPremium{..}-> HealthPremium{ + row1 = fixHealthPremiumBracket income 20000 25000 0.06 0 row1, + row2 = fixHealthPremiumBracket income 36000 38500 0.06 300 row2, + row3 = fixHealthPremiumBracket income 48000 48600 0.25 450 row3, + row4 = fixHealthPremiumBracket income 72000 72600 0.25 600 row4, + row5 = fixHealthPremiumBracket income 200000 200600 0.25 750 row5} + +fixHealthPremiumBracket :: Centi -> Centi -> Centi -> Rational -> Centi -> HealthPremiumBracket Maybe -> HealthPremiumBracket Maybe +fixHealthPremiumBracket income floor ceiling rate base HealthPremiumBracket{..} + | income > floor && income < ceiling = HealthPremiumBracket{ + taxableIncome = Just income, + overThreshold = Just $ income - floor, + timesRate = Just rate `fractionOf` overThreshold, + equalsTax = totalOf [timesRate, Just base]} + | otherwise = Rank2.pure Nothing diff --git a/src/Tax/Canada/ON428/Types.hs b/src/Tax/Canada/ON428/Types.hs new file mode 100644 --- /dev/null +++ b/src/Tax/Canada/ON428/Types.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} + +module Tax.Canada.ON428.Types where + +import Data.Fixed (Centi) +import Language.Haskell.TH qualified as TH +import Rank2.TH qualified + +data ON428 line = ON428 { + page1 :: Page1 line, + page2 :: Page2 line, + page3 :: Page3 line, + page4 :: Page4 line} + +data Page1 line = Page1 { + line1 :: line Centi, + partA :: Page1PartA line, + partB :: Page1PartB line} + +data Page1PartA line = Page1PartA { + column1 :: TaxIncomeBracket line, + column2 :: TaxIncomeBracket line, + column3 :: TaxIncomeBracket line, + column4 :: TaxIncomeBracket line, + column5 :: TaxIncomeBracket line} + +data TaxIncomeBracket line = TaxIncomeBracket { + line2_income :: line Centi, + line3_threshold :: line Centi, + line4_overThreshold :: line Centi, + line5_rate :: line Rational, + line6_timesRate :: line Centi, + line7_baseTax :: line Centi, + line8_equalsTax :: line Centi + } + +data Page1PartB line = Page1PartB { + line9_basic :: line Centi, + line10_age :: line Centi, + line11_base :: line Centi, + line12_spouseIncome :: line Centi, + line13_difference :: line Centi, + line13_cont :: line Centi, + line14_base :: line Centi, + line15_dependentIncome :: line Centi, + line16_difference :: line Centi, + line16_cont :: line Centi, + line17_caregiver :: line Centi, + line18 :: line Centi, + line19_cppQpp :: line Centi, + line20_cppQpp :: line Centi, + line21_employmentInsurance :: line Centi, + line22_employmentInsurance :: line Centi, + line23_adoption :: line Centi, + line24_sum :: line Centi, + line24_cont :: line Centi, + line25 :: line Centi} + +data Page2 line = Page2 { + partB :: Page2PartB line, + partC :: Page2PartC line} + +data Page2PartB line = Page2PartB { + line26 :: line Centi, + line27_pension :: line Centi, + line28 :: line Centi, + line29_disability :: line Centi, + line30 :: line Centi, + line31 :: line Centi, + line32_interest :: line Centi, + line33_education :: line Centi, + line34_transferred :: line Centi, + line35 :: line Centi, + medicalExpenses :: MedicalExpenses line, + line42 :: line Centi, + line43_sum :: line Centi, + line43_cont :: line Centi, + line44 :: line Centi, + line45_rate :: line Rational, + line46_fraction :: line Centi, + donations :: Donations line, + line50 :: line Centi} + +data MedicalExpenses line = MedicalExpenses { + line36_expenses :: line Centi, + line37_income :: line Centi, + line38_rate :: line Rational, + line39_fraction :: line Centi, + line40_lesser :: line Centi, + line41_difference :: line Centi} + +data Donations line = Donations { + line47_base :: line Centi, + line47_fraction :: line Centi, + line48_base :: line Centi, + line48_fraction :: line Centi, + line49_sum :: line Centi, + line49_cont :: line Centi} + +data Page2PartC line = Page2PartC { + line51_tax :: line Centi, + line52_credits :: line Centi, + line53 :: line Centi, + line54 :: line Centi, + line55 :: line Centi, + line56 :: line Centi, + line57 :: line Centi, + line58 :: line Centi, + line59_copy :: line Centi, + line59_product :: line Centi, + line60_lesser :: line Centi, + line61 :: line Centi} + +data Page3 line = Page3 { + line62 :: line Centi, + line63 :: line Centi, + line64 :: line Centi, + line65 :: line Centi, + line66_copy :: line Centi, + line66_surtax :: line Centi, + line67_copy :: line Centi, + line67_surtax :: line Centi, + line68_cont :: line Centi, + line68_sum :: line Centi, + line69 :: line Centi, + line70 :: line Centi, + line71 :: line Centi, + line72 :: line Centi, + line73 :: line Centi, + line74_basicReduction :: line Centi, + line75_amount :: line Centi, + line75_childrenNum :: line Word, + line76_amount :: line Centi, + line76_childrenNum :: line Word, + line77 :: line Centi, + line78_copy :: line Centi, + line78_product :: line Centi, + line79 :: line Centi, + line80_cont :: line Centi, + line80_difference :: line Centi, + line81 :: line Centi, + line82 :: line Centi, + line83 :: line Centi} + +data Page4 line = Page4 { + line84 :: line Centi, + line85_lift :: line Centi, + line86 :: line Centi, + line87_foodDonations :: line Centi, + line87_fraction :: line Centi, + line88 :: line Centi, + line89_health :: line Centi, + line90 :: line Centi, + healthPremium :: HealthPremium line} + +data HealthPremium line = HealthPremium { + row1 :: HealthPremiumBracket line, + row2 :: HealthPremiumBracket line, + row3 :: HealthPremiumBracket line, + row4 :: HealthPremiumBracket line, + row5 :: HealthPremiumBracket line} + +data HealthPremiumBracket line = HealthPremiumBracket { + taxableIncome :: line Centi, + overThreshold :: line Centi, + timesRate :: line Centi, + equalsTax :: line Centi} + +$(foldMap + (\t-> [d| + deriving instance (Show (line Centi), Show (line Rational), Show (line Word)) + => Show ($(TH.conT t) line) + deriving instance (Eq (line Centi), Eq (line Rational), Eq (line Word)) + => Eq ($(TH.conT t) line) + |]) + [''ON428, ''Page1, ''Page2, ''Page3, ''Page4, + ''Page1PartA, ''Page1PartB, ''Page2PartB, ''Page2PartC, + ''MedicalExpenses, ''Donations, + ''TaxIncomeBracket, ''HealthPremium, ''HealthPremiumBracket]) + +$(foldMap Rank2.TH.deriveAll + [''ON428, ''Page1, ''Page2, ''Page3, ''Page4, + ''Page1PartA, ''Page1PartB, ''Page2PartB, ''Page2PartC, + ''MedicalExpenses, ''Donations, + ''TaxIncomeBracket, ''HealthPremium, ''HealthPremiumBracket]) diff --git a/src/Tax/Canada/T1/FDF.hs b/src/Tax/Canada/T1/FDF.hs deleted file mode 100644 --- a/src/Tax/Canada/T1/FDF.hs +++ /dev/null @@ -1,91 +0,0 @@ -{-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} - -module Tax.Canada.T1.FDF where - -import Data.Fixed (Centi) -import Data.Foldable (find) -import Data.Functor.Const (Const (Const, getConst)) -import Data.Map.Lazy (Map) -import Data.Map.Lazy qualified as Map -import Data.Text (Text) -import Data.Text qualified as Text -import Data.Time (Day, defaultTimeLocale, formatTime, parseTimeM) -import Rank2 qualified -import Text.FDF (FDF, foldMapWithKey, mapWithKey, parse, serialize) -import Text.Read (readEither) - -import Tax.Canada.T1.Types -import Tax.Canada.T1.FieldNames (FieldConst (Field, path, entry), Entry (..), t1Fields) - -load :: FDF -> Either String (T1 Maybe) -load = fromFieldMap . foldMapWithKey Map.singleton - -update :: T1 Maybe -> FDF -> FDF -update = mapWithKey . updateKey . Rank2.foldMap (uncurry Map.singleton . getConst) . Rank2.liftA2 pairKey t1Fields - where pairKey :: FieldConst a -> Maybe a -> Const ([Text], Text) a - pairKey Field {path, entry} v = Const ((<> "[0]") <$> path, foldMap (fromEntry entry) v) - updateKey :: Map [Text] Text -> [Text] -> Text -> Text - updateKey m k v = Map.findWithDefault v k m - fromEntry :: Entry a -> a -> Text - fromEntry Textual v = v - fromEntry Date v = Text.pack $ formatTime defaultTimeLocale "%Y%m%d" v - fromEntry Checkbox True = "Yes" - fromEntry Checkbox False = "No" - fromEntry (RadioButton values) v = Text.pack $ show $ fromEnum v + 1 - fromEntry Amount v = Text.pack (show v) - fromEntry Count v = Text.pack (show v) - fromEntry Province v = Text.pack (show v) - -fromFieldMap :: Map [Text] Text -> Either String (T1 Maybe) -fromFieldMap fieldValues = Rank2.traverse fill t1Fields - where fill :: FieldConst a -> Either String (Maybe a) - fill Field {path, entry} - | Just v <- Map.lookup path fieldValues = toEntry entry (Text.unpack v) - | Just v <- Map.lookup ((<> "[0]") <$> path) fieldValues = toEntry entry (Text.unpack v) - | RadioButtons leaf values <- entry, - Just (n, v) <- find (\(i, _)-> any (`notElem` ["", "Off"]) $ - Map.lookup (((<> "[0]") <$> path) <> [leaf <> "[" <> Text.pack (show i) <> "]"]) fieldValues) - (zip [0 ..] values) - = Right $ Just v - | Switch yes no leaf <- entry, - Just yesValue <- Map.lookup ((<> "[0]") <$> (path <> [yes, leaf])) fieldValues, - Just noValue <- Map.lookup ((<> "[0]") <$> (path <> [no, leaf])) fieldValues - = if yesValue `elem` ["", "Off"] && noValue `elem` ["", "Off"] then Right Nothing - else if yesValue == "1" && noValue `elem` ["", "Off"] then Right (Just True) - else if yesValue `elem` ["", "Off"] && noValue `elem` ["1", "2"] then Right (Just False) - else error ("Can't figure out the checkbox at " <> show (path, entry, yesValue, noValue)) - | Switch' leaf <- entry, - Just yesValue <- Map.lookup (map (<> "[0]") path <> [leaf <> "[0]"]) fieldValues, - Just noValue <- Map.lookup (map (<> "[0]") path <> [leaf <> "[1]"]) fieldValues - = if yesValue `elem` ["", "Off"] && noValue `elem` ["", "Off"] then Right Nothing - else if yesValue == "1" && noValue `elem` ["", "Off"] then Right (Just True) - else if yesValue `elem` ["", "Off"] && noValue `elem` ["1", "2"] then Right (Just False) - else error ("Can't figure out the checkbox at " <> show (path, entry, yesValue, noValue)) - | otherwise = error ("Unknown field path " ++ show path ++ " between " - ++ show (Map.lookupLT ((<> "[0]") <$> path) fieldValues, - Map.lookupGT ((<> "[0]") <$> path) fieldValues)) - toEntry :: Entry a -> String -> Either String (Maybe a) - toEntry _ "" = Right Nothing - toEntry Count v = Just <$> readEither v - toEntry Date v = Just <$> parseTimeM False defaultTimeLocale "%Y%m%d" v - toEntry Province v = Just <$> readEither v - toEntry Textual v = Right $ Just $ Text.pack v - toEntry Amount v = Just <$> readEither v - toEntry Checkbox "Yes" = Right $ Just True - toEntry Checkbox "No" = Right $ Just False - toEntry Checkbox "Off" = Right $ Just False - toEntry Checkbox "1" = Right $ Just True - toEntry Checkbox v = Left ("Bad checkbox value: " <> show v) - toEntry e@(RadioButton values) v - | Right n <- readEither v, n > 0, x:_ <- drop (n - 1) values = Right $ Just x - | otherwise = Left ("Bad radio button value: " <> show (e, v)) - toEntry e@RadioButtons{} v = error (show (e, v)) - toEntry e@(Switch a b leaf) v = error (show (e, v)) - toEntry e@(Switch' leaf) v = error (show (e, v)) - -instance MonadFail (Either String) where - fail = Left diff --git a/src/Tax/Canada/T1/FieldNames.hs b/src/Tax/Canada/T1/FieldNames.hs --- a/src/Tax/Canada/T1/FieldNames.hs +++ b/src/Tax/Canada/T1/FieldNames.hs @@ -1,40 +1,19 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} -module Tax.Canada.T1.FieldNames where +module Tax.Canada.T1.FieldNames (t1Fields) where import Data.Fixed (Centi) import Data.Text (Text) import Data.Time (Day) -import Data.CAProvinceCodes qualified as Province import Rank2 qualified +import Tax.FDF (FieldConst (Field), Entry (..), within) import Tax.Canada.T1.Types -data FieldConst a = Field {path :: [Text], entry :: Entry a} - -data Entry a where - Count :: Entry Word - Date :: Entry Day - Province :: Entry Province.Code - Textual :: Entry Text - Amount :: Entry Centi - Checkbox :: Entry Bool - RadioButton :: (Bounded a, Enum a, Eq a, Show a) => [a] -> Entry a - RadioButtons :: (Bounded a, Enum a, Eq a, Show a) => Text -> [a] -> Entry a - Switch :: Text -> Text -> Text -> Entry Bool - Switch' :: Text -> Entry Bool - -deriving instance Show a => Show (Entry a) - -within :: Text -> FieldConst x -> FieldConst x -within root field@Field{path} = field{path = root:path} - +t1Fields :: T1 FieldConst t1Fields = within "form1" Rank2.<$> T1 { page1 = within "Page1" . within "Step1" Rank2.<$> page1Fields, page2 = within "Page2" Rank2.<$> page2Fields, @@ -234,7 +213,7 @@ line_81 = Field ["Line_81", "Line30_Amount"] Amount} page6Fields = Page6 { - line_79 = Field ["Line_79", "Line43Amount"] Amount, + line82 = Field ["Line_79", "Line43Amount"] Amount, line30800 = Field ["CPP_QPP_Sub", "Line30800_Sub", "Line8_Amount"] Amount, line31000 = Field ["CPP_QPP_Sub", "Line31000_Sub", "Line9_Amount"] Amount, line31200 = Field ["EIPremiums_Sub", "Line31200_Sub", "Line10_Amount"] Amount, diff --git a/src/Tax/Canada/T1/Fix.hs b/src/Tax/Canada/T1/Fix.hs --- a/src/Tax/Canada/T1/Fix.hs +++ b/src/Tax/Canada/T1/Fix.hs @@ -10,13 +10,13 @@ import Control.Applicative ((<|>)) import Data.Fixed (Centi) -import Data.List.NonEmpty (nonEmpty) -import Data.Maybe (fromMaybe, mapMaybe) +import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Time.Calendar (Year, dayPeriod) import Rank2 qualified import Tax.Canada.T1.Types +import Tax.Util (difference, fixEq, leastOf, nonNegativeDifference, totalOf) fixT1 :: T1 Maybe -> T1 Maybe fixT1 = fixEq $ \t1@T1{..}-> T1{page1 = fixPage1 page1, @@ -100,7 +100,9 @@ fixPage6 :: T1 Maybe -> Page6 Maybe -> Page6 Maybe fixPage6 t1 = fixEq $ \page@Page6{..}-> page{ - line_79 = t1.page5.partB_FederalTaxCredits.line_81, + line82 = t1.page5.partB_FederalTaxCredits.line_81, + line31260 = leastOf [Just 1287, + totalOf [t1.page3.line_10100_EmploymentIncome, t1.page3.line_10400_OtherEmploymentIncome]], line94_sum = totalOf [line30800, line31000, line31200, @@ -113,7 +115,7 @@ line31300, line31350], line94_cont = line94_sum, - line96 = totalOf [line94_cont, line31400], + line96 = totalOf [line82, line94_cont, line31400], line99 = totalOf [line96, line31600, line31800], line104 = totalOf [line99, line31900, line32300, line32400, line32600], medical_expenses = fixMedicalExpenses t1 medical_expenses, @@ -122,7 +124,7 @@ line33500 = totalOf [line104, line33200_cont], line33800 = (* 0.15) <$> line33500, line35000 = totalOf [line33800, line34900]} - + fixPage7 :: T1 Maybe -> Page7 Maybe -> Page7 Maybe fixPage7 t1 = fixEq $ \Page7{partC_NetFederalTax, step6_RefundOrBalanceOwing}-> Page7{ partC_NetFederalTax = fixPage7PartC t1 partC_NetFederalTax, @@ -193,7 +195,7 @@ taxableIncome = t1.page4.line_23600_NetIncome, taxableIncomeFraction = (* 0.03) <$> taxableIncome, threshold = min 2479 <$> taxableIncomeFraction, - difference = max 0 <$> nonNegativeDifference familyExpenses threshold} + difference = nonNegativeDifference familyExpenses threshold} fixPage7PartC :: T1 Maybe -> Page7PartC Maybe -> Page7PartC Maybe fixPage7PartC t1 = fixEq $ \part@Page7PartC{..}-> part{ @@ -253,20 +255,3 @@ line_47900_ProvTerrCredits], line_48200_cont = line_48200_sum, line164_Refund_or_BalanceOwing = difference line_43500_totalpayable line_48200_sum} - -fixEq :: Eq a => (a -> a) -> a -> a -fixEq f a - | a == a' = a - | otherwise = fixEq f a' - where a' = f a - -totalOf :: [Maybe Centi] -> Maybe Centi -totalOf = fmap sum . nonEmpty . mapMaybe id - -difference :: Maybe Centi -> Maybe Centi -> Maybe Centi -difference Nothing Nothing = Nothing -difference a b = Just (fromMaybe 0 a - fromMaybe 0 b) - -nonNegativeDifference :: Maybe Centi -> Maybe Centi -> Maybe Centi -nonNegativeDifference Nothing Nothing = Nothing -nonNegativeDifference a b = Just (max 0 $ fromMaybe 0 a - fromMaybe 0 b) diff --git a/src/Tax/Canada/T1/Types.hs b/src/Tax/Canada/T1/Types.hs --- a/src/Tax/Canada/T1/Types.hs +++ b/src/Tax/Canada/T1/Types.hs @@ -209,7 +209,7 @@ } data Page6 line = Page6 { - line_79 :: line Centi, + line82 :: line Centi, -- CPP_QPP line30800 :: line Centi, line31000 :: line Centi, diff --git a/src/Tax/FDF.hs b/src/Tax/FDF.hs new file mode 100644 --- /dev/null +++ b/src/Tax/FDF.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Tax.FDF where + +import Data.Char (isDigit) +import Data.CAProvinceCodes qualified as Province +import Data.Fixed (Centi) +import Data.Foldable (find) +import Data.Functor.Const (Const (Const, getConst)) +import Data.Map.Lazy (Map) +import Data.Map.Lazy qualified as Map +import Data.Semigroup.Cancellative (stripSuffix) +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Time (Day, defaultTimeLocale, formatTime, parseTimeM) +import Rank2 qualified +import Text.FDF (FDF, foldMapWithKey, mapWithKey, parse, serialize) +import Text.Read (readEither) + +data FieldConst a = Field {path :: [Text], entry :: Entry a} + +data Entry a where + Count :: Entry Word + Date :: Entry Day + Province :: Entry Province.Code + Textual :: Entry Text + Amount :: Entry Centi + Percent :: Entry Rational + Checkbox :: Entry Bool + RadioButton :: (Bounded a, Enum a, Eq a, Show a) => [a] -> Entry a + RadioButtons :: (Bounded a, Enum a, Eq a, Show a) => Text -> [a] -> Entry a + Switch :: Text -> Text -> Text -> Entry Bool + Switch' :: Text -> Entry Bool + +deriving instance Show a => Show (Entry a) + +within :: Text -> FieldConst x -> FieldConst x +within root field@Field{path} = field{path = root:path} + +load :: (Rank2.Apply form, Rank2.Traversable form) => form FieldConst -> FDF -> Either String (form Maybe) +load fields = fromFieldMap fields . foldMapWithKey Map.singleton + +update :: (Rank2.Apply form, Rank2.Foldable form) => form FieldConst -> form Maybe -> FDF -> FDF +update fields = mapWithKey . updateKey . Rank2.foldMap (uncurry Map.singleton . getConst) . Rank2.liftA2 pairKey fields + where pairKey :: FieldConst a -> Maybe a -> Const ([Text], Text) a + pairKey Field {path, entry} v = Const ((<> "[0]") <$> path, foldMap (fromEntry entry) v) + updateKey :: Map [Text] Text -> [Text] -> Text -> Text + updateKey m k v = Map.findWithDefault v k m + fromEntry :: Entry a -> a -> Text + fromEntry Textual v = v + fromEntry Date v = Text.pack $ formatTime defaultTimeLocale "%Y%m%d" v + fromEntry Checkbox True = "Yes" + fromEntry Checkbox False = "No" + fromEntry (RadioButton values) v = Text.pack $ show $ fromEnum v + 1 + fromEntry Amount v = Text.pack (show v) + fromEntry Percent v = Text.pack (show (fromRational $ v * 100 :: Centi)) <> "%" + fromEntry Count v = Text.pack (show v) + fromEntry Province v = Text.pack (show v) + +fromFieldMap :: Rank2.Traversable form => form FieldConst -> Map [Text] Text -> Either String (form Maybe) +fromFieldMap fields fieldValues = Rank2.traverse fill fields + where fill :: FieldConst a -> Either String (Maybe a) + fill Field {path, entry} + | Just v <- Map.lookup path fieldValues = toEntry entry (Text.unpack v) + | Just v <- Map.lookup ((<> "[0]") <$> path) fieldValues = toEntry entry (Text.unpack v) + | RadioButtons leaf values <- entry, + Just (n, v) <- find (\(i, _)-> any (`notElem` ["", "Off"]) $ + Map.lookup (((<> "[0]") <$> path) <> [leaf <> "[" <> Text.pack (show i) <> "]"]) fieldValues) + (zip [0 ..] values) + = Right $ Just v + | Switch yes no leaf <- entry, + Just yesValue <- Map.lookup ((<> "[0]") <$> (path <> [yes, leaf])) fieldValues, + Just noValue <- Map.lookup ((<> "[0]") <$> (path <> [no, leaf])) fieldValues + = if yesValue `elem` ["", "Off"] && noValue `elem` ["", "Off"] then Right Nothing + else if yesValue == "1" && noValue `elem` ["", "Off"] then Right (Just True) + else if yesValue `elem` ["", "Off"] && noValue `elem` ["1", "2"] then Right (Just False) + else error ("Can't figure out the checkbox at " <> show (path, entry, yesValue, noValue)) + | Switch' leaf <- entry, + Just yesValue <- Map.lookup (map (<> "[0]") path <> [leaf <> "[0]"]) fieldValues, + Just noValue <- Map.lookup (map (<> "[0]") path <> [leaf <> "[1]"]) fieldValues + = if yesValue `elem` ["", "Off"] && noValue `elem` ["", "Off"] then Right Nothing + else if yesValue == "1" && noValue `elem` ["", "Off"] then Right (Just True) + else if yesValue `elem` ["", "Off"] && noValue `elem` ["1", "2"] then Right (Just False) + else error ("Can't figure out the checkbox at " <> show (path, entry, yesValue, noValue)) + | otherwise = error ("Unknown field path " ++ show path ++ " between " + ++ show (Map.lookupLT ((<> "[0]") <$> path) fieldValues, + Map.lookupGT ((<> "[0]") <$> path) fieldValues)) + toEntry :: Entry a -> String -> Either String (Maybe a) + toEntry _ "" = Right Nothing + toEntry Count v = Just <$> readEither v + toEntry Date v = Just <$> parseTimeM False defaultTimeLocale "%Y%m%d" v + toEntry Province v = Just <$> readEither v + toEntry Textual v = Right $ Just $ Text.pack v + toEntry Amount v = Just <$> readEither (dropCommas v) + toEntry Percent v + | Just v' <- stripSuffix "%" v, + (wholePart, pointyPart) <- span (/= '.') v', + Right whole <- fromInteger <$> readEither wholePart, + Right decimal <- case pointyPart + of '.' : decimals -> (/ 10 ^ length decimals) . fromInteger <$> readEither decimals + "" -> Right 0 + _ -> Left "bad decimals" + = Right $ Just ((whole + decimal) / 100) + | otherwise = Left ("Bad percentage value: " <> show v) + toEntry Checkbox "Yes" = Right $ Just True + toEntry Checkbox "No" = Right $ Just False + toEntry Checkbox "Off" = Right $ Just False + toEntry Checkbox "1" = Right $ Just True + toEntry Checkbox v = Left ("Bad checkbox value: " <> show v) + toEntry e@(RadioButton values) v + | Right n <- readEither v, n > 0, x:_ <- drop (n - 1) values = Right $ Just x + | otherwise = Left ("Bad radio button value: " <> show (e, v)) + toEntry e@RadioButtons{} v = error (show (e, v)) + toEntry e@(Switch a b leaf) v = error (show (e, v)) + toEntry e@(Switch' leaf) v = error (show (e, v)) + dropCommas num + | (wholePart, pointyPart@('.' : decimals)) <- span (/= '.') num, + length decimals == 2, + all isDigit decimals + = filter (/= ',') wholePart <> pointyPart + | otherwise = num + +instance MonadFail (Either String) where + fail = Left diff --git a/src/Tax/Util.hs b/src/Tax/Util.hs new file mode 100644 --- /dev/null +++ b/src/Tax/Util.hs @@ -0,0 +1,36 @@ +-- | Shared utility functions used by other modules +module Tax.Util where + +import Data.Fixed (Centi) +import Data.List.NonEmpty (nonEmpty) +import Data.Maybe (fromMaybe, mapMaybe) + +-- | Repeatedly apply the function to the argument until it reaches the fixed point. +fixEq :: Eq a => (a -> a) -> a -> a +fixEq f a + | a == a' = a + | otherwise = fixEq f a' + where a' = f a + +-- | Sum the list of arguments; return 'Nothing' iff all items are 'Nothing'. +totalOf :: [Maybe Centi] -> Maybe Centi +totalOf = fmap sum . nonEmpty . mapMaybe id + +-- | Subtraction under 'Maybe' +difference :: Maybe Centi -> Maybe Centi -> Maybe Centi +difference Nothing Nothing = Nothing +difference a b = Just (fromMaybe 0 a - fromMaybe 0 b) + +-- | Non-negative subtraction under 'Maybe', returning @Just 0@ instead of negative results +nonNegativeDifference :: Maybe Centi -> Maybe Centi -> Maybe Centi +nonNegativeDifference Nothing Nothing = Nothing +nonNegativeDifference a b = Just (max 0 $ fromMaybe 0 a - fromMaybe 0 b) + +-- | Multiplication under 'Maybe' +fractionOf :: Maybe Rational -> Maybe Centi -> Maybe Centi +fractionOf (Just x) (Just amt) = Just $ fromRational (x * toRational amt) +fractionOf _ _ = Nothing + +-- | The minimum of all amounts, 'Nothing' ignored. +leastOf :: [Maybe Centi] -> Maybe Centi +leastOf = fmap minimum . nonEmpty . mapMaybe id