-- This file is part of hs-tax-ato
-- Copyright (C) 2018  Fraser Tweedale
--
-- hs-tax-ato is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE DataKinds #-}

-- | Tax tables for 2018–19 financial year.
module Data.Tax.ATO.FY.FY2019 (tables) where

import Control.Lens (review)

import Data.Tax
import Data.Tax.ATO.Common
import Data.Tax.ATO.PrivateHealthInsuranceRebate

-- | In FY2019 the 37% threshold was increased from $87,000 to $90,000.
individualIncomeTax :: (Fractional a, Ord a) => Tax (Money a) (Money a)
individualIncomeTax :: forall a. (Fractional a, Ord a) => Tax (Money a) (Money a)
individualIncomeTax = forall a.
(Fractional a, Ord a) =>
[(a, a)] -> Tax (Money a) (Money a)
marginal'
  [ (a
18200, a
0.19)
  , (a
37000, a
0.325 forall a. Num a => a -> a -> a
- a
0.19)
  , (a
90000, a
0.37 forall a. Num a => a -> a -> a
- a
0.325)
  , (a
180000, a
0.45 forall a. Num a => a -> a -> a
- a
0.37) ]

help, sfss :: (Fractional a, Ord a) => Tax (Money a) (Money a)
help :: forall a. (Fractional a, Ord a) => Tax (Money a) (Money a)
help = forall a.
(Fractional a, Ord a) =>
[(a, a)] -> Tax (Money a) (Money a)
thresholds'
  [ (a
51957, a
0.02),  (a
57730, a
0.02)
  , (a
64307, a
0.005), (a
70882, a
0.005),  (a
74608, a
0.005),  (a
80198, a
0.005)
  , (a
86856, a
0.005), (a
91426, a
0.005), (a
100614, a
0.005), (a
107214, a
0.005) ]
sfss :: forall a. (Fractional a, Ord a) => Tax (Money a) (Money a)
sfss = forall a.
(Fractional a, Ord a) =>
[(a, a)] -> Tax (Money a) (Money a)
thresholds' [(a
51957, a
0.02), (a
64307, a
0.01), (a
91426, a
0.01)]

-- | The 37% threshold was increased from $87,000 to $90,000.
--
-- The new /low and middle income tax offset (LAMITO)/ was
-- introduced, in addition to LITO.
--
tables :: (Ord a, Fractional a) => TaxTables 2019 a
tables :: forall a. (Ord a, Fractional a) => TaxTables 2019 a
tables = forall {k} (y :: k) a.
Tax (Money a) (Money a)
-> Tax (Money a) (Money a)
-> Tax (Money a) (Money a)
-> Tax (Money a) (Money a)
-> Tax (Money a) (Money a)
-> Tax (Money a) (Money a)
-> PrivateHealthInsuranceRebateRates a
-> TaxTables y a
TaxTables
  forall a. (Fractional a, Ord a) => Tax (Money a) (Money a)
individualIncomeTax
  (forall a.
(Fractional a, Ord a) =>
Money a -> Tax (Money a) (Money a)
medicareLevy (forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall a b. Iso (Money a) (Money b) a b
money a
22398))
  forall a. (Fractional a, Ord a) => Tax (Money a) (Money a)
medicareLevySurcharge
  forall a. (Fractional a, Ord a) => Tax (Money a) (Money a)
help
  forall a. (Fractional a, Ord a) => Tax (Money a) (Money a)
sfss
  (forall a. (Fractional a, Ord a) => Tax (Money a) (Money a)
lowIncomeTaxOffset forall a. Semigroup a => a -> a -> a
<> forall a. (Fractional a, Ord a) => Tax (Money a) (Money a)
lamito)
  forall a. Fractional a => PrivateHealthInsuranceRebateRates a
privateHealthInsuranceRebateRates

privateHealthInsuranceRebateRates
  :: (Fractional a) => PrivateHealthInsuranceRebateRates a
privateHealthInsuranceRebateRates :: forall a. Fractional a => PrivateHealthInsuranceRebateRates a
privateHealthInsuranceRebateRates =
  [ ( a
90000, (a
0.25415, a
0.25059), (a
0.29651, a
0.29236), (a
0.33887, a
0.33413) )
  , (a
105000, (a
0.16943, a
0.16706), (a
0.21180, a
0.20883), (a
0.25415, a
0.25059) )
  , (a
140000, (a
0.08471, a
0.08352), (a
0.12707, a
0.12529), (a
0.16943, a
0.16706) )
  ]