packages feed

canadian-income-tax 2025.0 → 2025.1

raw patch · 15 files changed

+270/−79 lines, 15 files

Files

CHANGELOG.md view
@@ -1,5 +1,17 @@ # Revision history for `canadian-income-tax` +## 2025.1++* Breaking changes to the library:+  * Changed ther result type of `completeForms` and `completeRelevantForms` to also report the post-processing messages+* Features and improvements:+  * Added the `Message` and `Severity` types+  * Specify `-v` or `--verbose` on the command line to see the messages+  * Improved the visual design of web pages+* Fixes:+  * Updated the benefit amounts in Schedule 6 to the 2025 values+  * Updated 15% to the 2025 value of 14.5% in Schedules 9 and 11+ ## 2025.0  * Breaking changes to the library:
app/Main.hs view
@@ -16,13 +16,14 @@ import Data.ByteString.Lazy qualified as ByteString.Lazy import Data.CAProvinceCodes qualified as Province import Data.Char (toUpper)-import Data.Foldable (toList)+import Data.Foldable (for_, toList) import Data.Functor.Compose (Compose(Compose, getCompose)) import Data.List qualified as List import Data.Map.Lazy qualified as Map import Data.Maybe (catMaybes) import Data.Semigroup.Cancellative (isPrefixOf, isSuffixOf) import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO import Options.Applicative (Parser, ReadM, long, metavar, short) import Options.Applicative qualified as OptsAp import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)@@ -30,10 +31,11 @@ import Text.FDF (FDF, parse, serialize)  import Paths_canadian_income_tax (getDataDir)-import Tax.Canada (completeForms, completeRelevantForms, formFileNames)-import Tax.Canada.Federal (loadInputForms)+import Tax.Canada (completeAndFilterForms, allFormKeys, relevantFormKeys, formFileNames)+import Tax.Canada.Federal qualified as Federal import Tax.Canada.FormKey (FormKey) import Tax.Canada.FormKey qualified as FormKey+import Tax.Canada.Shared (messageText) import Tax.PDFtk (fdf2pdf, pdf2fdf)  main :: IO ()@@ -100,7 +102,7 @@ process :: Options -> IO () process Options{province, t1InputPath, t4InputPaths, p428InputPath, p479InputPath,                 schedule6InputPath, schedule7InputPath, schedule8InputPath, schedule9InputPath, schedule11InputPath,-                outputPath, onlyGivenForms, keepIrrelevantForms} = do+                outputPath, onlyGivenForms, keepIrrelevantForms, verbose} = do    dataDir <- getDataDir    let inputFiles :: [(FormKey, FilePath)]        inputFiles = List.sortOn fst $@@ -134,12 +136,12 @@                    else ByteString.writeFile outputPath content'        fdfs = getCompose <$> traverse (parse . Lazy.toStrict . snd) (Compose inputs) :: Either String [(FormKey, FDF)]    case do (inputFDFs, ioFDFs) <- List.partition ((FormKey.T4 ==) . fst) <$> fdfs-           inputForms <- loadInputForms inputFDFs-           let complete = if keepIrrelevantForms then completeForms else completeRelevantForms-           complete province inputForms (Map.fromAscList ioFDFs)+           inputForms <- Federal.loadInputForms inputFDFs+           let formKeys = if keepIrrelevantForms then allFormKeys else relevantFormKeys+           completeAndFilterForms formKeys province inputForms (Map.fromAscList ioFDFs)      of       Left err -> error err-      Right fixedFDFs -> do+      Right (msgs, fixedFDFs) -> do          let bytesMap' = serialize <$> fixedFDFs              tarEntries = Map.traverseWithKey fdfEntry bytesMap'              fdfEntry key content@@ -155,3 +157,4 @@                     if isDir                        then void $ Map.traverseWithKey writeFrom bytesMap'                        else ByteString.writeFile outputPath tarFile+         when verbose $ for_ msgs $ Text.IO.putStrLn . messageText
canadian-income-tax.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               canadian-income-tax-version:            2025.0+version:            2025.1  synopsis: Canadian income tax calculation
src/Tax/Canada.hs view
@@ -4,75 +4,76 @@ {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} -module Tax.Canada (completeForms, completeRelevantForms, formFileNames) where+module Tax.Canada (completeAndFilterForms, completeForms, completeRelevantForms, Federal.examine,+                   allFormKeys, relevantFormKeys, formFileNames) where  import Data.CAProvinceCodes qualified as Province import Data.Map (Map) import Data.Map qualified as Map+import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text) import Rank2 qualified  import Tax.Canada.Federal qualified as Federal-import Tax.Canada.Federal (fixFederalForms, relevantFormKeys) import Tax.Canada.FormKey qualified as FormKey import Tax.Canada.FormKey (FormKey) import Tax.Canada.Province.AB qualified as AB import Tax.Canada.Province.BC qualified as BC import Tax.Canada.Province.MB qualified as MB import Tax.Canada.Province.ON qualified as ON+import Tax.Canada.Shared (Message) import Tax.Canada.T1 as T1 (T1, fileNameForProvince) import Tax.FDF (FDFs) import Tax.FDF qualified as FDF  -- | Complete all FDF forms in the given map, keyed by 'FormKey'. The inter-form field references are resolved as -- well.-completeForms :: Province.Code -> Federal.InputForms Maybe -> FDFs FormKey -> Either String (FDFs FormKey)-completeForms Province.AB = FDF.mapForms AB.returnFields . AB.fixReturns-completeForms Province.BC = FDF.mapForms BC.returnFields . BC.fixReturns-completeForms Province.MB = FDF.mapForms MB.returnFields . MB.fixReturns-completeForms Province.ON = FDF.mapForms ON.returnFields . ON.fixReturns-completeForms p = FDF.mapForms (Federal.formFieldsForProvince p) . fixFederalForms p---- | Complete the FDF forms in the given map, keyed by identifiers (@T1@, @428@, @Schedule9@, etc). The inter-form--- field references are resolved as well. Only the relevant forms that affect T1 are kept.-completeRelevantForms :: Province.Code -> Federal.InputForms Maybe -> FDFs FormKey -> Either String (FDFs FormKey)-completeRelevantForms Province.AB =-  fmap (uncurry filterRelevant <$>)-  . mapFormsWithT1 AB.returnFields ((.t1) . Rank2.fst :: Rank2.Product Federal.Forms AB.AB428 Maybe -> T1 Maybe)-  . AB.fixReturns-completeRelevantForms Province.BC =-  fmap (uncurry filterRelevant <$>)-  . mapFormsWithT1 BC.returnFields ((.federal.t1) :: BC.Returns Maybe -> T1 Maybe)-  . BC.fixReturns-completeRelevantForms Province.MB =-  fmap (uncurry filterRelevant <$>)-  . mapFormsWithT1 MB.returnFields ((.t1) . Rank2.fst :: Rank2.Product Federal.Forms MB.MB428 Maybe -> T1 Maybe)-  . MB.fixReturns-completeRelevantForms Province.ON =-  fmap (uncurry filterRelevant <$>)-  . mapFormsWithT1 ON.returnFields ((.federal.t1) :: ON.Returns Maybe -> T1 Maybe)-  . ON.fixReturns-completeRelevantForms p =-  fmap (uncurry filterRelevant <$>)-  . mapFormsWithT1 (Federal.formFieldsForProvince p) (.t1)-  . fixFederalForms p+completeForms :: Province.Code -> Federal.InputForms Maybe -> FDFs FormKey+              -> Either String ([Message], FDFs FormKey)+completeForms p = completeAndFilterForms allFormKeys p --- | Trim down the 'FDFs' to contain only the forms that have some effect on the given 'T1' form. The 'T1' itself is--- also kept, as well as any provincial forms.-filterRelevant :: T1 Maybe -> FDFs FormKey -> FDFs FormKey-filterRelevant t1 = flip Map.restrictKeys (relevantFormKeys t1 <> alwaysRelevant)+allFormKeys, relevantFormKeys :: T1 Maybe -> FDFs FormKey -> Set FormKey+allFormKeys = const $ Map.keysSet+relevantFormKeys t1 _ = Federal.relevantFormKeys t1 <> alwaysRelevant   where alwaysRelevant = Set.fromList [FormKey.Provincial428, FormKey.Provincial479, FormKey.T1] --- | Like 'mapForms', but also returns the T1 form by itself.+-- | Complete the FDF forms in the given map, keyed by 'FormKey'. The inter-form field references are resolved as+-- well. Only the relevant forms that affect T1 are kept.+completeRelevantForms :: Province.Code -> Federal.InputForms Maybe -> FDFs FormKey+                      -> Either String ([Message], FDFs FormKey)+completeRelevantForms p = completeAndFilterForms relevantFormKeys p++-- | Complete the FDF forms in the given map, keyed by 'FormKey', then filter them to the 'FormKey' subset calculated+-- by the given first argument function: typically 'allFormKeys' or 'relevantFormKeys'.+completeAndFilterForms+  :: (T1 Maybe -> FDFs FormKey -> Set FormKey) -- ^ keys of completed forms to keep+  -> Province.Code+  -> Federal.InputForms Maybe                  -- ^ input-only forms like 'Tax.Canada.T4.T4'+  -> FDFs FormKey                              -- ^ forms to complete+  -> Either String ([Message], FDFs FormKey)+completeAndFilterForms keysToKeep Province.AB = mapFormsWithT1 keysToKeep AB.returnFields Rank2.fst . AB.fixReturns+completeAndFilterForms keysToKeep Province.BC = mapFormsWithT1 keysToKeep BC.returnFields (.federal) . BC.fixReturns+completeAndFilterForms keysToKeep Province.MB = mapFormsWithT1 keysToKeep MB.returnFields Rank2.fst . MB.fixReturns+completeAndFilterForms keysToKeep Province.ON = mapFormsWithT1 keysToKeep ON.returnFields (.federal) . ON.fixReturns+completeAndFilterForms keysToKeep p =+  mapFormsWithT1 keysToKeep (Federal.formFieldsForProvince p) id . Federal.fixFederalForms p++-- | Like 'mapForms', but filters the result using the first argument function mapFormsWithT1 :: (Rank2.Apply form, Rank2.Traversable form)-               => form FDF.FieldConst -> (form Maybe -> T1 Maybe) -> (form Maybe -> form Maybe) -> FDFs FormKey-               -> Either String (T1 Maybe, FDFs FormKey)-mapFormsWithT1 fields getT1 f fdfs = do+               => (T1 Maybe -> FDFs FormKey -> Set FormKey)+               -> form FDF.FieldConst+               -> (form Maybe -> Federal.Forms Maybe)+               -> (form Maybe -> form Maybe)+               -> FDFs FormKey+               -> Either String ([Message], FDFs FormKey)+mapFormsWithT1 keysToKeep fields getFederal f fdfs = do   forms <- FDF.loadAll fields fdfs   let forms' = f forms-      t1' = getT1 forms'-  (,) t1' <$> FDF.storeAll fields fdfs forms'+      fed' = getFederal forms'+      msgs = Federal.examine (getFederal forms) fed'+      fdfs' = FDF.storeAll fields fdfs forms'+  (\x-> (msgs, Map.restrictKeys x $ keysToKeep fed'.t1 x)) <$> fdfs'  -- | A map of standard file paths of all supported forms for the given province, without the common file suffix and -- extension.
src/Tax/Canada/Federal.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoFieldSelectors #-}@@ -15,7 +14,7 @@  -- | The federal income tax forms -module Tax.Canada.Federal (InputForms, Forms(..), loadInputForms, fixFederalForms,+module Tax.Canada.Federal (InputForms, Forms(..), loadInputForms, fixFederalForms, examine,                            formFieldsForProvince, formFileNames, relevantFormKeys) where  import Control.Applicative ((<|>))@@ -39,7 +38,7 @@  import Tax.Canada.Federal.Schedule6 qualified as Schedule6 import Tax.Canada.Federal.Schedule6 (Schedule6, fixSchedule6, schedule6Fields)-import Tax.Canada.Federal.Schedule7 qualified+import Tax.Canada.Federal.Schedule7 qualified as Schedule7 import Tax.Canada.Federal.Schedule7 (Schedule7, fixSchedule7, schedule7Fields) import Tax.Canada.Federal.Schedule8 qualified as Schedule8 import Tax.Canada.Federal.Schedule8 (Schedule8(page4, page5, page6, page7, page9, page10, page11),@@ -55,6 +54,7 @@ import Tax.Canada.Federal.Schedule11 (Schedule11(page1), Page1(line5_trainingClaim, line17_sum), fixSchedule11, schedule11Fields) import Tax.Canada.FormKey (FormKey) import Tax.Canada.FormKey qualified as FormKey+import Tax.Canada.T1 qualified as T1 import Tax.Canada.T1 (fixT1, t1FieldsForProvince) import Tax.Canada.T1.Types (T1(page3, page4, page5, page6, page7, page8),                             Page3(line_10100_EmploymentIncome, line_10120_Commissions, line_12200_PartnershipIncome,@@ -73,7 +73,7 @@                             LanguageOfCorrespondence, MaritalStatus) import Tax.Canada.T4 (T4, T4Slip(box16_employeeCPP, box26_pensionableEarnings)) import Tax.Canada.T4 qualified as T4-import Tax.Canada.Shared (SubCalculation(result))+import Tax.Canada.Shared (Message, SubCalculation(result)) import Tax.FDF (FieldConst, load, within) import Tax.Util (fixEq, totalOf) @@ -186,6 +186,14 @@                                                        t1.page3.line29_sum.result]}}},    schedule9 = fixSchedule9 t1 schedule9,    schedule11 = fixSchedule11 t1 schedule11}++-- | Given the original and filled-in federal forms, return a list of observations for the user+examine :: Forms Maybe -> Forms Maybe -> [Message]+examine initial filled =+  T1.examine initial.t1 filled.t1+  <> Schedule6.examine initial.schedule6 filled.schedule6+  <> Schedule7.examine initial.schedule7 filled.schedule7+  <> Schedule8.examine initial.schedule8 filled.schedule8  -- | The paths of all the fields in all federal forms, with the form key added as the head of every field path. formFieldsForProvince :: Province.Code -> Forms FieldConst
src/Tax/Canada/Federal/Schedule11.hs view
@@ -87,7 +87,7 @@       line8_sum = totalOf [line6_difference, line_32001_eligible],       line10_sum = totalOf [line9_pastUnused, line8_sum],       line11_copy = if taxableIncomeUnderThreshold then Nothing else t1.page7.partC_NetFederalTax.tax_copy,-      line11_numerator = if taxableIncomeUnderThreshold then taxableIncome else (/ 0.15) <$> line11_copy,+      line11_numerator = if taxableIncomeUnderThreshold then taxableIncome else (/ 0.145) <$> line11_copy,       line12_copy = t1.page6.line107_sum,       line13_difference = nonNegativeDifference line11_numerator line12_copy,       line14_minUnused = fixSubCalculation id $ minimum [line9_pastUnused, line13_difference],
src/Tax/Canada/Federal/Schedule6.hs view
@@ -17,13 +17,15 @@  module Tax.Canada.Federal.Schedule6 where +import Data.Foldable (toList) import Data.Fixed (Centi) import Language.Haskell.TH qualified as TH import Rank2 qualified import Rank2.TH qualified import Transformation.Shallow.TH qualified -import Tax.Canada.Shared (SubCalculation(result), fixSubCalculation, subCalculationFields)+import Tax.Canada.FormKey qualified as FormKey+import Tax.Canada.Shared (Message, SubCalculation(result), fixSubCalculation, subCalculationFields, overLimitMessage) import Tax.Canada.T1.Types (T1) import Tax.Canada.T1.Types qualified as T1 import Tax.FDF (Entry (Amount, Constant, Percent, Switch'), FieldConst (Field), within)@@ -125,6 +127,10 @@        Transformation.Shallow.TH.deriveAll t])    [''Schedule6, ''Page2, ''Page3, ''Page4, ''Page5, ''Questions, ''PartAColumn, ''PartBColumn, ''Step2, ''Step3]) +examine :: Schedule6 Maybe -> Schedule6 Maybe -> [Message]+examine _initial filled =+  toList $ overLimitMessage 16_386 filled.page3.line14_least "14" FormKey.Schedule6 "Secondary earner exemption"+ fixSchedule6 :: Maybe (T1 Maybe) -> T1 Maybe -> Schedule6 Maybe -> Schedule6 Maybe fixSchedule6 t1spouse t1  =    fixEq $ \Schedule6{page2, page3, page4=Page4{step2, step3}, page5} ->@@ -138,7 +144,7 @@       partB_self = fixPartBColumn t1 partB_self,       partB_spouse = maybe id fixPartBColumn t1spouse partB_spouse,       line13_sum = totalOf [partB_self.line_38110_difference, partB_spouse.line_38110_difference],-      line14_least = min 15_955 <$>+      line14_least = min 16_386 <$>                      if or ((<) <$> page2.partA_self.line_38108_sum <*> page2.partA_spouse.line_38108_sum)                      then min page2.partA_self.line_38108_sum partB_self.line_38110_difference                      else min page2.partA_spouse.line_38108_sum partB_spouse.line_38110_difference,@@ -148,10 +154,10 @@          line16_copy = page2.line6_sum,          line18_difference = nonNegativeDifference line16_copy line17_threshold,          line20_fraction = line19_rate `fractionOf` line18_difference,-         line21_ceiling = if eitherEligible then Just 2_739 else Just 1_590,+         line21_ceiling = if eitherEligible then Just 2_813 else Just 1_633,          line22_least = min line20_fraction line21_ceiling,          line23_copy = page3.line15_difference,-         line24_threshold = if eitherEligible then Just 29_833 else Just 26_149,+         line24_threshold = if eitherEligible then Just 30_639 else Just 26_855,          line25_difference = nonNegativeDifference line23_copy line24_threshold,          line27_fraction = fixSubCalculation id $ line26_rate `fractionOf` line25_difference,          line28_difference = nonNegativeDifference line22_least line27_fraction.result},@@ -159,9 +165,9 @@          line29_copy = page2.partA_self.line_38108_sum,          line31_difference = nonNegativeDifference line29_copy line30_threshold,          line33_fraction = line32_rate `fractionOf` line31_difference,-         line34_capped = min 821 <$> line33_fraction,+         line34_capped = min 843 <$> line33_fraction,          line35_copy = page3.line15_difference,-         line36_threshold = if eitherEligible then Just 48_091 else Just 36_748,+         line36_threshold = if eitherEligible then Just 49_389 else Just 37_740,          line37_difference = nonNegativeDifference line35_copy line36_threshold,          line38_rate = if or page2.questions.line_38104 then Just 0.075 else Just 0.15,          line39_fraction = fixSubCalculation id $ line38_rate `fractionOf` line37_difference,
src/Tax/Canada/Federal/Schedule7.hs view
@@ -18,13 +18,18 @@ module Tax.Canada.Federal.Schedule7 where  import Control.Applicative ((<|>))+import Control.Monad (guard) import Data.Fixed (Centi)+import Data.Maybe (catMaybes, isNothing)+import Data.Text qualified as Text import Language.Haskell.TH qualified as TH import Rank2 qualified import Rank2.TH qualified import Transformation.Shallow.TH qualified -import Tax.Canada.Shared (SubCalculation(result), fixSubCalculation, subCalculationFields)+import Tax.Canada.FormKey qualified as FormKey+import Tax.Canada.Shared (Message(..), Severity(Error, Notice), SubCalculation(result),+                          fixSubCalculation, subCalculationFields) import Tax.Canada.T1.Types (T1) import Tax.Canada.T1.Types qualified as T1 import Tax.FDF (Entry (Amount, Checkbox), FieldConst (Field), within)@@ -93,12 +98,13 @@    [''Schedule7, ''Page2, ''Page3, ''Page4, ''PartB, ''PartC, ''PartD, ''PartE])  fixSchedule7 :: T1 Maybe -> Schedule7 Maybe -> Schedule7 Maybe-fixSchedule7 t1  = fixEq $ \Schedule7{page2, page3, page4} -> Schedule7{-   page2 = let Page2{..} = page2 in page2{+fixSchedule7 t1 = fixEq defaultSchedule7 . fixEq calculateSchedule7 where+  calculateSchedule7 Schedule7{page2, page3, page4} = Schedule7{+    page2 = let Page2{..} = page2 in page2{       line_24500_contributions_sum =          fixSubCalculation id $ totalOf [line2_pastYearContributions, line3_thisYearContributions],       line5_sum = totalOf [line1_pastUnused, line_24500_contributions_sum.result]},-   page3 = let Page3{partB = partB@PartB{..}, partC = partC@PartC{..}} = page3 in Page3{+    page3 = let Page3{partB = partB@PartB{..}, partC = partC@PartC{..}} = page3 in Page3{       partB = partB{          line6_contributions_copy = page2.line5_sum,          line9_repayments_sum = fixSubCalculation id $ totalOf [line_24600_hbp, line_24620_llp],@@ -110,14 +116,38 @@          line15_cont = line_24640_transfers,          line16_difference = difference line14_copy line15_cont,          line17_lesser = min line13_difference line16_difference,-         line18_deducting = line18_deducting <|> line17_lesser,          line19_sum = totalOf [line15_cont, line18_deducting],          line20_deduction = min line10_difference line19_sum}},-   page4 = page4{+    page4 = page4{       partD = let PartD{line21_copy, line22_copy} = page4.partD in PartD{          line21_copy = page3.partB.line10_difference,          line22_copy = page3.partC.line20_deduction,          line23_difference = difference line21_copy line22_copy}}}+  defaultSchedule7 s7@Schedule7{page3 = page3@Page3{partC = partC@PartC{..}}} = calculateSchedule7 s7{+    page3 = page3{+      partC = partC{+         line18_deducting = line18_deducting <|> line17_lesser}}}++examine :: Schedule7 Maybe -> Schedule7 Maybe -> [Message]+examine initial filled = catMaybes [+  guard (initial.page3.partC.line18_deducting > filled.page3.partC.line17_lesser)+  *> Just Message{+    severity = Error,+    line = "18",+    form = FormKey.Schedule7,+    explanation= "You cannot deduct on line 18 more than "+      <> foldMap Text.show filled.page3.partC.line17_lesser <> " available on line 17."},+  guard (isNothing initial.page3.partC.line18_deducting && filled.page3.partC.line17_lesser > Just 0)+  *> Just Message{+    severity = Notice,+    line = "18",+    form = FormKey.Schedule7,+    explanation= "The amount to deduct on line 18 has been defaulted to be equal to "+      <> foldMap Text.show filled.page3.partC.line17_lesser+      <> ", all available contributions from line 17. "+      <> "If you wish to deduct less and carry forward the rest, enter the amount manually."}+    ]+    schedule7Fields :: Schedule7 FieldConst schedule7Fields = within "form1" Rank2.<$> Schedule7{
src/Tax/Canada/Federal/Schedule8.hs view
@@ -18,15 +18,19 @@  module Tax.Canada.Federal.Schedule8 where +import Control.Monad (guard) import Control.Applicative ((<|>)) import Data.Fixed (Centi)+import Data.Maybe (catMaybes, isNothing) import Data.Time.Calendar (MonthOfYear) import Language.Haskell.TH qualified as TH import Rank2 qualified import Rank2.TH qualified import Transformation.Shallow.TH qualified -import Tax.Canada.Shared (SubCalculation(calculation, result), fixSubCalculation, subCalculationFields)+import Tax.Canada.FormKey qualified as FormKey+import Tax.Canada.Shared (Message(..), Severity(..), SubCalculation(calculation, result),+                          fixSubCalculation, overLimitMessage, subCalculationFields) import Tax.FDF (Entry (Amount, Count, Month), FieldConst (Field), within) import Tax.Util (fixEq, difference, nonNegativeDifference, totalOf) @@ -279,6 +283,28 @@     ''Page7, ''Page7Part4, ''Page7Part5, ''Page7Cond1, ''Page7Cond2,     ''Page8, ''Page8Cond1, ''Page8Cond2,     ''Page9, ''Page10, ''Page11])++examine :: Schedule8 Maybe -> Schedule8 Maybe -> [Message]+examine initial filled = catMaybes [+  guard (isNothing initial.page3.lineA_months)+  *> Just Message{+    severity = Notice,+    line = "A",+    form = FormKey.Schedule8,+    explanation= "You have not entered the number of months that CPP applied, it will default to 12."},+  overLimitMessage 71_300 filled.page3.lineB_maxPensionableEarnings "B" FormKey.Schedule8+    "Maximum pensionable earnings",+  overLimitMessage 9_900 filled.page3.lineC_maxSubjectToSecondAdditionalContributions "C" FormKey.Schedule8+    "Maximum amount subject to second additional contributions",+  overLimitMessage 81_200 filled.page3.lineD_additionalMaxPensionableEarnings "D" FormKey.Schedule8+    "Additional maximum pensionable earnings",+  overLimitMessage 3_500 filled.page3.lineE_maxBasicExemption "E" FormKey.Schedule8 "Maximum basic exemption",+  overLimitMessage 81_200 filled.page4.line_50339_totalPensionableEarnings "50339" FormKey.Schedule8+    "Total CPP pensionable earnings",+  overLimitMessage 396 filled.page4.line22_fraction.result "22" FormKey.Schedule8+    "Required second additional contributions on CPP pensionable earnings",+  overLimitMessage 67_800 filled.page6.part4.line9_difference "9" FormKey.Schedule8+    "Earnings subject to base and first additional contributions"]  fixSchedule8 :: Schedule8 Maybe -> Schedule8 Maybe fixSchedule8 = fixEq $ \Schedule8{page2, page3, page4, page5, page6, page7, page8, page9, page10, page11}-> Schedule8{
src/Tax/Canada/Federal/Schedule9.hs view
@@ -113,7 +113,7 @@    line21_difference = difference lineE_copy line20_min,    line21_fraction = (0.29 *) <$> line21_difference,    line22_copy = page1.line13_min,-   line22_fraction = (0.15 *) <$> line22_copy,+   line22_fraction = (0.145 *) <$> line22_copy,    line23_sum = totalOf [line20_fraction, line21_fraction, line22_fraction],    line4_least = minimum [line2_dispositionProceeds, line3_capitalCost],    line5_least = minimum [line1_depreciation, line4_least],
src/Tax/Canada/FormKey.hs view
@@ -1,6 +1,7 @@+{-# LANGUAGE NoFieldSelectors #-}+ module Tax.Canada.FormKey where  -- | The type of form keys to use as the parameter of 'Tax.FDF.FDFs' data FormKey = T1 | T4 | Schedule6 | Schedule7 | Schedule8 | Schedule9 | Schedule11 | Provincial428 | Provincial479              deriving (Eq, Ord, Read, Show)-
src/Tax/Canada/Province/BC.hs view
@@ -16,7 +16,9 @@ module Tax.Canada.Province.BC (Returns(..), BC428, bc428Fields, bc479Fields, formFileNames,                                fixBC428, fixBC479, fixReturns, returnFields, t1Fields) where +import Control.Applicative ((<|>)) import Data.CAProvinceCodes (Code(BC))+import Data.Maybe (isNothing) import Data.Map (Map, fromList) import Data.Text (Text) import Rank2 qualified@@ -104,11 +106,13 @@                                                BCC.line1_netIncome_spouse = t1.page1.spouse.line_23600,                                                BCC.line4_uccb_rdsp_income_self = totalOf [t1.page3.line_11700_UCCB,                                                                                           t1.page3.line_12500_RDSP],-                                               BCC.line7_threshold = if t1.page1.identification.maritalStatus-                                                                        `elem` [Just T1.Married,-                                                                                Just T1.LivingCommonLaw]-                                                                     then Just 18_000-                                                                     else 15_000 <$ t1.page1.identification.maritalStatus}}}+                                               BCC.line7_threshold = if isNothing t1.page1.identification.maritalStatus+                                                                     then bc479.page1.line7_threshold <|> Just 15_000+                                                                     else if t1.page1.identification.maritalStatus+                                                                             `elem` [Just T1.Married,+                                                                                     Just T1.LivingCommonLaw]+                                                                          then Just 18_000+                                                                          else Just 15_000}}}  returnFields :: Returns FieldConst returnFields = Returns{
src/Tax/Canada/Shared.hs view
@@ -4,8 +4,10 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoFieldSelectors #-} {-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}@@ -19,15 +21,28 @@ import Control.Monad (guard, mfilter) import Data.Fixed (Centi) import Data.Text (Text)+import Data.Text qualified as Text import Language.Haskell.TH qualified as TH import Rank2.TH qualified import Transformation.Shallow.TH qualified  import Tax.FDF (FieldConst(Field), Entry(Amount))+import Tax.Canada.FormKey (FormKey) import Tax.Util (fixEq, fractionOf, nonNegativeDifference)  import Prelude hiding (floor, ceiling) +-- | Message for the user about a potential issue discovered in the return by the function 'examine'+data Message = Message{+  severity :: Severity,+  form :: FormKey,+  line :: Text,+  explanation :: Text}+  deriving (Eq, Show)++-- | 'Message' severity+data Severity = Notice | Summary | Warning | Error deriving (Eq, Ord, Show)+ data TaxIncomeBracket line = TaxIncomeBracket {    income :: line Centi,    threshold :: line Centi,@@ -69,6 +84,21 @@        Rank2.TH.deriveAll t,        Transformation.Shallow.TH.deriveAll t])    [''BaseCredit, ''MedicalExpenses, ''SubCalculation, ''TaxIncomeBracket])++messageText :: Message -> Text+messageText Message{form, line, explanation} =+  "At line " <> line <> " of " <> Text.pack (show form) <> ": " <> explanation++-- | Given the limit, the line value, the line number, the form, and the value name, construct the error message+-- if the value is above the limit.+overLimitMessage :: Centi -> Maybe Centi -> Text -> FormKey -> Text -> Maybe Message+overLimitMessage limit value line form name =+  guard (value > Just limit)+  *> Just Message{+    severity = Error,+    line,+    form,+    explanation= name <> " can't be larger then " <> Text.show limit}  fixTaxIncomeBracket :: Maybe Centi -> Maybe (TaxIncomeBracket Maybe) -> TaxIncomeBracket Maybe -> TaxIncomeBracket Maybe fixTaxIncomeBracket theIncome nextBracket = fixEq $ \bracket@TaxIncomeBracket{..} -> bracket{
src/Tax/Canada/T1.hs view
@@ -1,18 +1,26 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoFieldSelectors #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-}  -- | The T1 forms look similar, but there are subtle differences between different provinces and -- territories. Therefore they share the same 'T1' form type and the same 'fixT1' completion function, but field -- paths are separately provided by 't1FieldsForProvince'.-module Tax.Canada.T1 (fixT1, fileNameForProvince, formPrefixForProvince, t1FieldsForProvince,+module Tax.Canada.T1 (examine, fixT1, fileNameForProvince, formPrefixForProvince, t1FieldsForProvince,                       module Tax.Canada.T1.Types) where  import Data.CAProvinceCodes qualified as Province+import Control.Monad (guard) import Data.Enum.Memo (memoize)+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing) import Data.Text (Text)+import Data.Text qualified as Text  import Tax.FDF (FieldConst)+import Tax.Canada.FormKey qualified as FormKey+import Tax.Canada.Shared(Message(..), Severity(..), overLimitMessage) import Tax.Canada.T1.Types import Tax.Canada.T1.Fix (fixT1) import Tax.Canada.T1.FieldNames.AB qualified as AB@@ -24,6 +32,61 @@ import Tax.Canada.T1.FieldNames.ON qualified as ON import Tax.Canada.T1.FieldNames.QC qualified as QC import Tax.Canada.T1.FieldNames.YT qualified as YT++-- | Reports summary and potential problems from input and output T1 forms+-- | Given the original and filled-in federal forms, return a list of observations for the user+examine :: T1 Maybe -> T1 Maybe -> [Message]+examine inputs outputs = catMaybes [+  guard (isNothing inputs.page1.identification.dateBirth)+  *> Just Message{+    severity = Notice,+    line = "Date of birth",+    form = FormKey.T1,+    explanation= "You have not entered your date of birth. I'll assume you were under 65 years old."},+  guard (isNothing inputs.page1.identification.maritalStatus)+  *> Just Message{+    severity = Notice,+    line = "Marital status",+    form = FormKey.T1,+    explanation= "You have not entered your marital status.\+                 \ I'll assume you were single, with no spouse or common-law partner credits."},+  guard (isNothing outputs.page3.line_15000_TotalIncome)+  *> Just Message{+    severity = Warning,+    line = "15000",+    form = FormKey.T1,+    explanation= "You've reported no income to tax in Step 2 of the T1 form."},+  guard (isJust outputs.page3.line_10100_EmploymentIncome)+  *> guard (isNothing outputs.page6.line_30800 || isNothing outputs.page6.line_31200)+  *> Just Message{+    severity = Warning,+    line = if isNothing outputs.page6.line_30800 then "30800" else "31200",+    form = FormKey.T1,+    explanation= "You have reported employment income on line 15000 but no "+      <> if isNothing outputs.page6.line_30800 then "CPP contributions on line 30800"+         else "EI contributions on line 31200"},+  overLimitMessage 1074 outputs.page4.line_22215_DeductionCPP_QPP "22215" FormKey.T1+    "Deduction for CPP or QPP enhanced contributions on employment income",+  overLimitMessage 16_129 outputs.page5.partB_FederalTaxCredits.line_30000 "30000" FormKey.T1 "Basic personal amount",+  overLimitMessage 9028 outputs.page5.partB_FederalTaxCredits.line_30100 "30100" FormKey.T1 "Age amount",+  overLimitMessage 1077.48 outputs.page6.line_31200 "31200" FormKey.T1 "EI contributions",+  overLimitMessage 10_000 outputs.page6.line_31270 "31270" FormKey.T1 "Home buyers' amount",+  overLimitMessage 20_000 outputs.page6.line_31285 "31285" FormKey.T1 "Home accessibility expenses",+  overLimitMessage 2000 outputs.page6.line_31400 "31400" FormKey.T1 "Pension income amount",+  overLimitMessage 650 outputs.page7.partC_NetFederalTax.line_41000 "41000" FormKey.T1+    "Federal political contribution tax credit",+  overLimitMessage 1000 outputs.page8.step6_RefundOrBalanceOwing.line_46900 "46900" FormKey.T1+    "School supplies expenses",+  Just Message{+      severity = Summary,+      line = if isJust outputs.page8.line_48400_Refund then "48400"+             else if isJust outputs.page8.line_48500_BalanceOwing then "48500"+             else "167",+      form = FormKey.T1,+      explanation = "You " <> (if isJust outputs.page8.line_48400_Refund then "have refund" else "owe balance")+        <> " of "+        <> Text.show (abs $ fromMaybe 0 outputs.page8.step6_RefundOrBalanceOwing.line164_Refund_or_BalanceOwing)+        <> " dollars"}]  fileNameForProvince :: Province.Code -> Text fileNameForProvince p = formPrefixForProvince p <> "-r-fill-24e"
web/Main.hs view
@@ -10,7 +10,7 @@ import Control.Category ((>>>)) import Control.Monad (forM) import Control.Monad.IO.Class (liftIO)-import Data.Aeson (decode)+import Data.Aeson (decode, encode, object, (.=)) import Data.Bifunctor (first) import Data.ByteString (ByteString) import Data.ByteString qualified as ByteString@@ -29,6 +29,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Lazy qualified as Text.Lazy+import Data.Text.Lazy.Encoding (decodeUtf8) import Network.HTTP.Types.Status (statusCode, ok200, internalServerError500,                                   notFound404, unsupportedMediaType415, unprocessableEntity422) import Network.Wai.Middleware.RequestLogger@@ -49,6 +50,7 @@ import Tax.Canada.Federal qualified as Federal import Tax.Canada.FormKey (FormKey) import Tax.Canada.FormKey qualified as FormKey+import Tax.Canada.Shared (Message(..), messageText) import Tax.PDFtk (fdf2pdf, pdfFile2fdf)  import Prelude hiding (log)@@ -134,9 +136,12 @@         of Left (code, err) ->              log ("Error " <> toLogStr code.statusCode <> ": " <> toLogStr err)              >> status code >> text (fromString err)-           Right fdfs' -> do+           Right (msgs, fdfs') -> do              log ("Completed " <> toLogStr provinceCode <> ": " <> toLogStr (show (Map.keys fdfs')))              let fdfBytes' = Lazy.fromStrict . FDF.serialize <$> fdfs'+                 msgsJson = decodeUtf8 $ encode+                              $ map (\msg-> object ["severity" .= show msg.severity,+                                                    "text"     .= messageText msg]) msgs                  replaceContent :: FormKey -> Lazy.ByteString                                 -> IO (Either String (FilePath, Lazy.ByteString))                  replaceContent key content = case List.lookup key allPdfFiles of@@ -152,6 +157,7 @@                  setHeader "Content-Type" "application/pdf"                  setHeader "Content-Disposition" ("attachment; filename=\"" <> Text.Lazy.pack name                                                   <> "\"; filename*=\"" <> Text.Lazy.pack name <> "\"")+                 setHeader "X-Tax-Messages" msgsJson                  raw pdf                Right pdfFiles'' -> do                  now <- liftIO $ round . nominalDiffTimeToSeconds <$> getPOSIXTime@@ -159,6 +165,7 @@                      addPDF (name, c) = addEntryToArchive (toEntry name now c)                  status ok200                  setHeader "Content-Type" "application/zip"+                 setHeader "X-Tax-Messages" msgsJson                  raw (fromArchive pdfArchive)       liftIO $ removeDirectoryRecursive dir    middleware $ staticPolicy (noDots >-> addBase "web/client/build")