-- This file is part of hs-tax-ato
-- Copyright (C) 2021  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 RankNTypes #-}

{- |

Types and functions for the Private Health Insurance Rebate.

-}
module Data.Tax.ATO.PrivateHealthInsuranceRebate
  (
    PrivateHealthInsuranceRebateRates
  , PrivateHealthInsurancePolicyDetail(..)
  , BenefitCode(..)
  , assessExcessPrivateHealthRebate
  , HealthInsurerID
  , MembershipNumber
  ) where

import Data.List (find)

import Control.Lens
import Data.Tax
import Data.Tax.ATO.Rounding

type HealthInsurerID = String
type MembershipNumber = String

data BenefitCode
  = BenefitCode30 -- ^ Under 65, 1 July to 31 March
  | BenefitCode31 -- ^ Under 65, 1 April to 30 June
  | BenefitCode35 -- ^ 65 to 69, 1 July to 31 March
  | BenefitCode36 -- ^ 65 to 69, 1 April to 30 June
  | BenefitCode40 -- ^ 70 or over, 1 July to 31 March
  | BenefitCode41 -- ^ 70 or over, 1 April to 30 June

-- | Include these data in your tax return via the
-- 'Data.Tax.ATO.privateHealthInsurancePolicyDetails' field.
data PrivateHealthInsurancePolicyDetail a =
  PrivateHealthInsurancePolicyDetail
    HealthInsurerID
    MembershipNumber
    (Money a) -- ^ premiums eligible for rebate
    (Money a) -- ^ rebate received
    BenefitCode

-- | A line of rebate rates.
--
-- The first field is the upper income threshold for single persons
-- (inclusive) for the given rate.  Thresholds must be given in
-- increasing order.
--
-- The second, third and fourth fields are the rebate rates for when
-- the oldest person on the policy is aged, respectively: under 65;
-- 65 to 69; 70 or older.  Each of these values is a pair.
--
-- The first subfield is the rebate for 1 July to 31 March.
--
-- The second subfield is the rebate for 1 April to 30 June.
--
-- An income that exceeds the highest threshold implicitly gets a
-- rebate of 0%.
--
type PrivateHealthInsuranceRebateRatesLine a
  = (a, (a, a), (a, a), (a, a))
type PrivateHealthInsuranceRebateRates a
  = [PrivateHealthInsuranceRebateRatesLine a]

byBenefitCode
  :: BenefitCode
  -> Lens' (PrivateHealthInsuranceRebateRatesLine a) a
byBenefitCode :: forall a.
BenefitCode -> Lens' (PrivateHealthInsuranceRebateRatesLine a) a
byBenefitCode BenefitCode
code = case BenefitCode
code of
  BenefitCode
BenefitCode30 -> ((a, a) -> f (a, a))
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (PrivateHealthInsuranceRebateRatesLine a)
  (PrivateHealthInsuranceRebateRatesLine a)
  (a, a)
  (a, a)
_2 (((a, a) -> f (a, a))
 -> PrivateHealthInsuranceRebateRatesLine a
 -> f (PrivateHealthInsuranceRebateRatesLine a))
-> ((a -> f a) -> (a, a) -> f (a, a))
-> (a -> f a)
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> (a, a) -> f (a, a)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (a, a) (a, a) a a
_1
  BenefitCode
BenefitCode31 -> ((a, a) -> f (a, a))
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (PrivateHealthInsuranceRebateRatesLine a)
  (PrivateHealthInsuranceRebateRatesLine a)
  (a, a)
  (a, a)
_2 (((a, a) -> f (a, a))
 -> PrivateHealthInsuranceRebateRatesLine a
 -> f (PrivateHealthInsuranceRebateRatesLine a))
-> ((a -> f a) -> (a, a) -> f (a, a))
-> (a -> f a)
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> (a, a) -> f (a, a)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (a, a) (a, a) a a
_2
  BenefitCode
BenefitCode35 -> ((a, a) -> f (a, a))
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (PrivateHealthInsuranceRebateRatesLine a)
  (PrivateHealthInsuranceRebateRatesLine a)
  (a, a)
  (a, a)
_3 (((a, a) -> f (a, a))
 -> PrivateHealthInsuranceRebateRatesLine a
 -> f (PrivateHealthInsuranceRebateRatesLine a))
-> ((a -> f a) -> (a, a) -> f (a, a))
-> (a -> f a)
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> (a, a) -> f (a, a)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (a, a) (a, a) a a
_1
  BenefitCode
BenefitCode36 -> ((a, a) -> f (a, a))
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (PrivateHealthInsuranceRebateRatesLine a)
  (PrivateHealthInsuranceRebateRatesLine a)
  (a, a)
  (a, a)
_3 (((a, a) -> f (a, a))
 -> PrivateHealthInsuranceRebateRatesLine a
 -> f (PrivateHealthInsuranceRebateRatesLine a))
-> ((a -> f a) -> (a, a) -> f (a, a))
-> (a -> f a)
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> (a, a) -> f (a, a)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (a, a) (a, a) a a
_2
  BenefitCode
BenefitCode40 -> ((a, a) -> f (a, a))
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall s t a b. Field4 s t a b => Lens s t a b
Lens
  (PrivateHealthInsuranceRebateRatesLine a)
  (PrivateHealthInsuranceRebateRatesLine a)
  (a, a)
  (a, a)
_4 (((a, a) -> f (a, a))
 -> PrivateHealthInsuranceRebateRatesLine a
 -> f (PrivateHealthInsuranceRebateRatesLine a))
-> ((a -> f a) -> (a, a) -> f (a, a))
-> (a -> f a)
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> (a, a) -> f (a, a)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (a, a) (a, a) a a
_1
  BenefitCode
BenefitCode41 -> ((a, a) -> f (a, a))
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall s t a b. Field4 s t a b => Lens s t a b
Lens
  (PrivateHealthInsuranceRebateRatesLine a)
  (PrivateHealthInsuranceRebateRatesLine a)
  (a, a)
  (a, a)
_4 (((a, a) -> f (a, a))
 -> PrivateHealthInsuranceRebateRatesLine a
 -> f (PrivateHealthInsuranceRebateRatesLine a))
-> ((a -> f a) -> (a, a) -> f (a, a))
-> (a -> f a)
-> PrivateHealthInsuranceRebateRatesLine a
-> f (PrivateHealthInsuranceRebateRatesLine a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> (a, a) -> f (a, a)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (a, a) (a, a) a a
_2

getRebateRate
  :: (Ord a, Num a)
  => Money a
  -> BenefitCode
  -> PrivateHealthInsuranceRebateRates a
  -> Tax (Money a) (Money a)
getRebateRate :: forall a.
(Ord a, Num a) =>
Money a
-> BenefitCode
-> PrivateHealthInsuranceRebateRates a
-> Tax (Money a) (Money a)
getRebateRate Money a
income BenefitCode
code PrivateHealthInsuranceRebateRates a
rates =
  case ((a, (a, a), (a, a), (a, a)) -> Bool)
-> PrivateHealthInsuranceRebateRates a
-> Maybe (a, (a, a), (a, a), (a, a))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(a, (a, a), (a, a), (a, a))
line -> Money a
income Money a -> Money a -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Money a
forall num. num -> Money num
Money (Getting a (a, (a, a), (a, a), (a, a)) a
-> (a, (a, a), (a, a), (a, a)) -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a (a, (a, a), (a, a), (a, a)) a
forall s t a b. Field1 s t a b => Lens s t a b
Lens (a, (a, a), (a, a), (a, a)) (a, (a, a), (a, a), (a, a)) a a
_1 (a, (a, a), (a, a), (a, a))
line)) PrivateHealthInsuranceRebateRates a
rates of
    Maybe (a, (a, a), (a, a), (a, a))
Nothing -> Tax (Money a) (Money a)
forall a. Monoid a => a
mempty
    Just (a, (a, a), (a, a), (a, a))
rec -> a -> Tax (Money a) (Money a)
forall a. Num a => a -> Tax (Money a) (Money a)
flat (a -> Tax (Money a) (Money a)) -> a -> Tax (Money a) (Money a)
forall a b. (a -> b) -> a -> b
$ Getting a (a, (a, a), (a, a), (a, a)) a
-> (a, (a, a), (a, a), (a, a)) -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (BenefitCode
-> Lens (a, (a, a), (a, a), (a, a)) (a, (a, a), (a, a), (a, a)) a a
forall a.
BenefitCode -> Lens' (PrivateHealthInsuranceRebateRatesLine a) a
byBenefitCode BenefitCode
code) (a, (a, a), (a, a), (a, a))
rec

-- | Compute rebates received minus rebate entitlements.
-- Therefore a positive result is tax DUE, and a
-- negative result is a tax CREDIT.
--
assessExcessPrivateHealthRebate
  :: (RealFrac a)
  => Money a          -- ^ income for MLS purposes
  -> Maybe (Money a)  -- ^ spouse income for MLS purposes
  -> Integer          -- ^ number of dependents
  -> PrivateHealthInsuranceRebateRates a
  -> [PrivateHealthInsurancePolicyDetail a]
  -> Money a
assessExcessPrivateHealthRebate :: forall a.
RealFrac a =>
Money a
-> Maybe (Money a)
-> Integer
-> PrivateHealthInsuranceRebateRates a
-> [PrivateHealthInsurancePolicyDetail a]
-> Money a
assessExcessPrivateHealthRebate Money a
income Maybe (Money a)
spouseIncome Integer
dependents PrivateHealthInsuranceRebateRates a
rates =
  (PrivateHealthInsurancePolicyDetail a -> Money a)
-> [PrivateHealthInsurancePolicyDetail a] -> Money a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PrivateHealthInsurancePolicyDetail a -> Money a
f
  where

  -- The family income threshold is double the single threshold,
  -- increased by $1,500 for each Medicare levy surcharge dependent
  -- child after the first child.
  factor :: a
factor = a -> (Money a -> a) -> Maybe (Money a) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (if Integer
dependents Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then a
2 else a
1) (a -> Money a -> a
forall a b. a -> b -> a
const a
2) Maybe (Money a)
spouseIncome
  increase :: a
increase = a
1500 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a -> a
forall a. Ord a => a -> a -> a
max a
0 (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
dependents a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
  preppedRates :: PrivateHealthInsuranceRebateRates a
preppedRates = ASetter
  (PrivateHealthInsuranceRebateRates a)
  (PrivateHealthInsuranceRebateRates a)
  a
  a
-> (a -> a)
-> PrivateHealthInsuranceRebateRates a
-> PrivateHealthInsuranceRebateRates a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((PrivateHealthInsuranceRebateRatesLine a
 -> Identity (PrivateHealthInsuranceRebateRatesLine a))
-> PrivateHealthInsuranceRebateRates a
-> Identity (PrivateHealthInsuranceRebateRates a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((PrivateHealthInsuranceRebateRatesLine a
  -> Identity (PrivateHealthInsuranceRebateRatesLine a))
 -> PrivateHealthInsuranceRebateRates a
 -> Identity (PrivateHealthInsuranceRebateRates a))
-> ((a -> Identity a)
    -> PrivateHealthInsuranceRebateRatesLine a
    -> Identity (PrivateHealthInsuranceRebateRatesLine a))
-> ASetter
     (PrivateHealthInsuranceRebateRates a)
     (PrivateHealthInsuranceRebateRates a)
     a
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity a)
-> PrivateHealthInsuranceRebateRatesLine a
-> Identity (PrivateHealthInsuranceRebateRatesLine a)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (PrivateHealthInsuranceRebateRatesLine a)
  (PrivateHealthInsuranceRebateRatesLine a)
  a
  a
_1) ((a -> a -> a
forall a. Num a => a -> a -> a
+ a
increase) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Num a => a -> a -> a
* a
factor)) PrivateHealthInsuranceRebateRates a
rates

  preppedIncome :: Money a
preppedIncome = Money a -> (Money a -> Money a) -> Maybe (Money a) -> Money a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Money a
income (Money a -> Money a -> Money a
forall a. Semigroup a => a -> a -> a
<> Money a
income) Maybe (Money a)
spouseIncome

  f :: PrivateHealthInsurancePolicyDetail a -> Money a
f (PrivateHealthInsurancePolicyDetail HealthInsurerID
_ HealthInsurerID
_ Money a
eligible Money a
received BenefitCode
code) =
    let rate :: Tax (Money a) (Money a)
rate = Money a
-> BenefitCode
-> PrivateHealthInsuranceRebateRates a
-> Tax (Money a) (Money a)
forall a.
(Ord a, Num a) =>
Money a
-> BenefitCode
-> PrivateHealthInsuranceRebateRates a
-> Tax (Money a) (Money a)
getRebateRate Money a
preppedIncome BenefitCode
code PrivateHealthInsuranceRebateRates a
preppedRates
    in Money a
received Money a -> Money a -> Money a
forall a. Num a => Money a -> Money a -> Money a
$-$ Tax (Money a) (Money a) -> Money a -> Money a
forall a b. Tax a b -> a -> b
getTax ((Money a -> Money a)
-> Tax (Money a) (Money a) -> Tax (Money a) (Money a)
forall a b. (a -> b) -> Tax (Money a) a -> Tax (Money a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Money a -> Money a
forall a. RealFrac a => Money a -> Money a
roundCents Tax (Money a) (Money a)
rate) Money a
eligible