canadian-income-tax 2022.1 → 2022.2
raw patch · 13 files changed
+914/−175 lines, 13 filesdep +directorydep +filepathdep +tardep ~forms-data-formatnew-component:exe:complete-canadian-taxes
Dependencies added: directory, filepath, tar
Dependency ranges changed: forms-data-format
Files
- README.md +70/−13
- app/Main.hs +64/−17
- canadian-income-tax.cabal +11/−4
- src/Tax/Canada.hs +41/−0
- src/Tax/Canada/ON428/FieldNames.hs +172/−0
- src/Tax/Canada/ON428/Fix.hs +184/−0
- src/Tax/Canada/ON428/Types.hs +193/−0
- src/Tax/Canada/T1/FDF.hs +0/−91
- src/Tax/Canada/T1/FieldNames.hs +5/−26
- src/Tax/Canada/T1/Fix.hs +8/−23
- src/Tax/Canada/T1/Types.hs +1/−1
- src/Tax/FDF.hs +129/−0
- src/Tax/Util.hs +36/−0
README.md view
@@ -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.
app/Main.hs view
@@ -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 "<input FDF file>")+ <$> optional (strOption (long "t1" <> metavar "<input T1 FDF file>"))+ <*> optional (strOption (long "on428" <> metavar "<input ON428 FDF file>")) <*> strOption (short 'o' <> long "output" <> value "-" <> metavar "<output FDF file>") <*> 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
canadian-income-tax.cabal view
@@ -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
+ src/Tax/Canada.hs view
@@ -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}}})
+ src/Tax/Canada/ON428/FieldNames.hs view
@@ -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}
+ src/Tax/Canada/ON428/Fix.hs view
@@ -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
+ src/Tax/Canada/ON428/Types.hs view
@@ -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])
− src/Tax/Canada/T1/FDF.hs
@@ -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
src/Tax/Canada/T1/FieldNames.hs view
@@ -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,
src/Tax/Canada/T1/Fix.hs view
@@ -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)
src/Tax/Canada/T1/Types.hs view
@@ -209,7 +209,7 @@ } data Page6 line = Page6 {- line_79 :: line Centi,+ line82 :: line Centi, -- CPP_QPP line30800 :: line Centi, line31000 :: line Centi,
+ src/Tax/FDF.hs view
@@ -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
+ src/Tax/Util.hs view
@@ -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