Tax.hs

-- This has dependencies on other code so won't compile, but at least shows the logic.
-- Money "GBP" is just an Int counting the number of pence.

module Records.Tax where

import Money
import Schedule.Variable

import Control.DeepSeq
import Data.Serialize
import GHC.Stack
import Safe

newtype TaxYear = TY Int
  deriving stock (Eq, Ord, Show, Read)
  deriving newtype NFData
  deriving newtype Serialize

instance Variable TaxYear where
  type ImplicitFor TaxYear = (?taxYear :: TaxYear)
  getVariable = ?taxYear

data TaxYearInfo =
  TaxYearInfo
  { personalAllowance :: Money "GBP"
  , higherRateThreshold :: Money "GBP" -- after taking off personal allowance
  , additionalRateThreshold :: Money "GBP" -- after taking off personal allowance (non-existent anyway)
  , niPrimaryThreshold :: Money "GBP"
  , niUpperEarningsLimit :: Money "GBP"
  , niEmployerThreshold :: Money "GBP"
  }

taxYearInfos :: [(Int, TaxYearInfo)]
taxYearInfos =
 [ (2011, TaxYearInfo (Money 747500)  (Money 3500000) (Money 15000000) nierror nierror nierror)
 , (2012, TaxYearInfo (Money 810500)  (Money 3437000) (Money 15000000) nierror nierror nierror)
 , (2013, TaxYearInfo (Money 944000)  (Money 3201000) (Money 15000000) nierror nierror nierror)
 , (2014, TaxYearInfo (Money 1000000) (Money 3186500) (Money 15000000) nierror nierror nierror)
 , (2015, TaxYearInfo (Money 1060000) (Money 3178500) (Money 15000000) (Money  806000) (Money 4238000) nierror)
 , (2016, TaxYearInfo (Money 1100000) (Money 3200000) (Money 15000000) (Money  806000) (Money 4300000) nierror)
 , (2017, TaxYearInfo (Money 1150000) (Money 3350000) (Money 15000000) (Money  816400) (Money 4500000) nierror)
 , (2018, TaxYearInfo (Money 1185000) (Money 3450000) (Money 15000000) (Money  842400) (Money 4635000) nierror)
 , (2019, TaxYearInfo (Money 1250000) (Money 3750000) (Money 15000000) (Money  863200) (Money 5000000) nierror)
 , (2020, TaxYearInfo (Money 1250000) (Money 3750000) (Money 15000000) (Money  950000) (Money 5000000) nierror)
 , (2021, TaxYearInfo (Money 1257000) (Money 3770000) (Money 15000000) (Money  956800) (Money 5027000) (Money 884000))
 , (2022, TaxYearInfo (Money 1257000) (Money 3770000) (Money 15000000) (Money  956800) (Money 5027000) (Money 884000))
 , (2023, TaxYearInfo (Money 1257000) (Money 3770000) (Money 15000000) (Money  956800) (Money 5027000) (Money 884000))
 , (2024, TaxYearInfo (Money 1257000) (Money 3770000) (Money 15000000) (Money  956800) (Money 5027000) (Money 884000))
 , (2025, TaxYearInfo (Money 1257000) (Money 3770000) (Money 15000000) (Money  956800) (Money 5027000) (Money 884000))
 -- TODO check this, in theory should start going up with CPI
 , (2026, TaxYearInfo (Money 1257000) (Money 3770000) (Money 15000000) (Money  956800) (Money 5027000) (Money 884000))
 ]
 where nierror = error "NI information ont filled in yet"

cumTax :: HasCallStack => Int -> Int -> String -> Money "GBP" -> Money "GBP"
cumTax taxYear taxMonth taxCode (Money cumPay) =
  Money (slabIncomeTax [(20, higherSoFar), (40, additionalSoFar-higherSoFar)] 45 (roundToPound (cumPay + adjustment)))
  where
    TaxYearInfo _ (Money higher) (Money additional) _ _ _ =
       fromJustNote ("No info for tax year " ++ show taxYear) (lookup taxYear taxYearInfos)
    adjustment = unMoney (taxCodeToAdjustment taxCode taxMonth)
    higherSoFar = higher * taxMonth `div` 12
    additionalSoFar = additional * taxMonth `div` 12

-- calculate incurred tax "precisely", i.e. ignoring the HMRC rounding
-- this behaves better for calculating incremental tax impact
-- it also omits the tax code as the "correct" tax for a year is independent of that
-- returns results with *4* dp to allow for more stable rounding
-- TODO: actually handle the annual allowance+withdrawal at £100K
cumTaxPrecise :: HasCallStack => Int -> Int -> Money "GBP" -> Int
cumTaxPrecise taxYear taxMonth (Money cumPay) =
  slabTaxEx id [(20, higherSoFar), (40, additionalSoFar-higherSoFar)] 45 cumPay
  where
    TaxYearInfo _ (Money higher) (Money additional) _ _ _ =
       fromJustNote ("No info for tax year " ++ show taxYear) (lookup taxYear taxYearInfos)
    higherSoFar = higher * taxMonth `div` 12
    additionalSoFar = additional * taxMonth `div` 12

roundTo :: Integral a => a -> a -> a
roundTo k n = k * (n `div` k)

roundToPound :: Integral a => a -> a
roundToPound = roundTo 100

roundToPoundNearest :: Integral a => a -> a
roundToPoundNearest = roundToPound . (+50)

roundToPoundUp :: Integral a => a -> a
roundToPoundUp = roundToPound . (+99)

data IncomeTaxSlab =
  IncomeTaxSlab
  { slabRate :: Int
  , slabThreshold :: Int
   -- Thresholds are rounded up to the next £1, so tax is undercharged at the top of the slab.
   -- So if we fill up the slab, this is the correct amount of tax for the whole slab.
  , slabFullTax :: Int
  }

-- This adjusts the "notionally correct" slabs to take account of the
-- rounded up variants HMRC uses: see e.g. this for the 2021-22 tax year:
-- https://assets.publishing.service.gov.uk/government/uploads/system/uploads/attachment_data/file/969367/Tax-Tables-B-D_04-21.pdf
mkIncomeTaxSlabs :: [(Int, Int)] -> Int -> [IncomeTaxSlab]
mkIncomeTaxSlabs [] _remainder = []
mkIncomeTaxSlabs ((rate, threshold):slabs) remainder =
  let
    theNextRate =
      case slabs of
        [] -> remainder
        (nextRate, _):_ -> nextRate
    -- Since we widen the current slab, we need to narrow the next slab.
    -- Alternatively we could redefine slabs to have absolute thresholds rather than
    -- be relative to the previous slab, but that would complicate other things.
    fixedupNextSlabs =
      case slabs of
        [] -> []
        (nextRate, nextThreshold):nextSlabs -> (nextRate, nextThreshold - thresholdAdjustment):nextSlabs
    roundedThreshold = roundToPoundUp threshold
    thresholdAdjustment = roundedThreshold - threshold
  in
    IncomeTaxSlab rate roundedThreshold ((threshold * rate + thresholdAdjustment * theNextRate) `div` 100):
    mkIncomeTaxSlabs fixedupNextSlabs remainder

applyIncomeTaxSlab :: [IncomeTaxSlab] -> Int -> Int -> Int
applyIncomeTaxSlab [] remainder amount = amount * remainder `div` 100
applyIncomeTaxSlab (slab:slabs) remainder amount
  | amount < slabThreshold slab = amount * slabRate slab `div` 100
  | otherwise = slabFullTax slab + applyIncomeTaxSlab slabs remainder (amount - slabThreshold slab)

slabIncomeTax :: [(Int, Int)] -> Int -> Int -> Int
slabIncomeTax slabs remainder amount = applyIncomeTaxSlab (mkIncomeTaxSlabs slabs remainder) remainder amount

slabTax :: [(Int, Int)] -> Int -> Int -> Int
slabTax = slabTaxEx (`div` 100)

slabTaxEx :: (Int -> Int) -> [(Int, Int)] -> Int -> Int -> Int
slabTaxEx scale [] remainder amount = scale (amount * remainder)
slabTaxEx scale ((rate, limit):slabs) remainder amount =
  if amount <= limit then scale (amount * rate)
  else scale (limit * rate) + slabTaxEx scale slabs remainder (amount - limit)

taxCodeToAdjustment :: String -> Int -> Money "GBP"
taxCodeToAdjustment (reverse -> 'T':rest) = (mempty `mminus`) . tablesAMonthlyAdjustment (read (reverse rest))
taxCodeToAdjustment (reverse -> 'L':rest) = (mempty `mminus`) . tablesAMonthlyAdjustment (read (reverse rest))
taxCodeToAdjustment ('K':rest) = tablesAMonthlyAdjustment (read rest)
taxCodeToAdjustment t = error $ "Couldn't parse tax code: " ++ t

taxForMonth :: (String, String) -> (Int, Int) -> (Money "GBP", Money "GBP") -> Money "GBP" -> Money "GBP"
taxForMonth (taxCode, "M1") (taxYear, _taxMonth) _ payThisMonth =
  cumTax taxYear 1 taxCode payThisMonth
taxForMonth (taxCode, "") (taxYear, taxMonth) (Money previousTaxable, Money previousTax) (Money payThisMonth) =
  Money (min (payThisMonth `div` 2) (newTax - previousTax))
  where
    newTaxable = previousTaxable + payThisMonth
    Money newTax = cumTax taxYear taxMonth taxCode (Money newTaxable)
taxForMonth (_, taxBasis) _ _ _ = error $ "Couldn't parse tax basis: " ++ taxBasis

-- 4dp and no rounding, like with cumTaxPrecise
niForMonthPrecise :: Int -> Money "GBP" -> Int
niForMonthPrecise taxYear (Money n) =
   slabTaxEx
     id
     [(0, primaryThresholdForMonth), (12, upperEarningsLimitForMonth - primaryThresholdForMonth)]
     2
     n
  where
    TaxYearInfo _ _ _ (Money primaryThreshold) (Money upperEarningsLimit) _ =
      fromJustNote ("No info for tax year " ++ show taxYear) (lookup taxYear taxYearInfos)
    primaryThresholdForMonth = roundToPoundNearest (primaryThreshold `div` 12)
    upperEarningsLimitForMonth = roundToPoundNearest (upperEarningsLimit `div` 12)

employerNiForMonth :: Int -> Money "GBP" -> Money "GBP"
employerNiForMonth taxYear (Money n) =
  -- the 'n+5' calculation is arbitrary to make a calculation work,
  -- probably needs to be tweaked.
  Money $ slabTaxEx (`div` 1000) [(0, employerThresholdForMonth)] 138 (n+5)
  where
    TaxYearInfo _ _ _ _ _ (Money employerThreshold) =
      fromJustNote ("No info for tax year " ++ show taxYear) (lookup taxYear taxYearInfos)
    employerThresholdForMonth = roundToPoundNearest (employerThreshold `div` 12)

niForMonth :: Int -> Money "GBP" -> Money "GBP"
niForMonth taxYear (Money n) =
  Money $
   slabTax
     [(0, primaryThresholdForMonth), (12, upperEarningsLimitForMonth - primaryThresholdForMonth)]
     2
     -- according to https://assets.publishing.service.gov.uk/government/uploads/system/uploads/attachment_data/file/780791/2019_to_2020_-_National_Insurance_contributions_Tables_A__H__J__M_and_Z.pdf
     -- we should just round down to a whole pound, but experimenting with http://nicecalculator.hmrc.gov.uk/Class1NICs2.aspx
     -- comes up with thresholds at 30p and 80p.
     (roundTo 50 (n+20))
  where
    TaxYearInfo _ _ _ (Money primaryThreshold) (Money upperEarningsLimit) _ =
      fromJustNote ("No info for tax year " ++ show taxYear) (lookup taxYear taxYearInfos)
    primaryThresholdForMonth = roundToPoundNearest (primaryThreshold `div` 12)
    upperEarningsLimitForMonth = roundToPoundNearest (upperEarningsLimit `div` 12)

-- https://assets.publishing.service.gov.uk/government/uploads/system/uploads/attachment_data/file/783933/Tables_A_Pay_adjustment.pdf
tablesAMonthlyAdjustment
  :: Int             -- ^tax code number
  -> Int             -- ^month number
  -> Money "GBP"
tablesAMonthlyAdjustment 0 _ = Money 0 -- special case
tablesAMonthlyAdjustment code month =
  let (q, r) = code `divMod` 3
  in Money $ q * month * 250 + tablesARaw r month

tablesARaw :: Int -> Int -> Int
tablesARaw 0 month = 75 * month -- this is the figure for 3, projected back to 0
tablesARaw 1 month = (75+84) * month
tablesARaw 2 month = (75+84+83) * month
tablesARaw _ _ = error "internal error: tablesARaw called with remainder that wasn't 0,1,2"