-- 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
  ) 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 -- ^ Over 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

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 -> forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1
  BenefitCode
BenefitCode31 -> forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2
  BenefitCode
BenefitCode35 -> forall s t a b. Field3 s t a b => Lens s t a b
_3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1
  BenefitCode
BenefitCode36 -> forall s t a b. Field3 s t a b => Lens s t a b
_3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2
  BenefitCode
BenefitCode40 -> forall s t a b. Field4 s t a b => Lens s t a b
_4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1
  BenefitCode
BenefitCode41 -> forall s t a b. Field4 s t a b => Lens s t a b
_4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(a, (a, a), (a, a), (a, a))
line -> Money a
income forall a. Ord a => a -> a -> Bool
<= forall num. num -> Money num
Money (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t a b. Field1 s t a b => Lens s t a b
_1 (a, (a, a), (a, a), (a, a))
line)) PrivateHealthInsuranceRebateRates a
rates of
    Maybe (a, (a, a), (a, a), (a, a))
Nothing -> forall a. Monoid a => a
mempty
    Just (a, (a, a), (a, a), (a, a))
rec -> forall a. Num a => a -> Tax (Money a) (Money a)
flat forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (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 =
  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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (if Integer
dependents forall a. Ord a => a -> a -> Bool
> Integer
0 then a
2 else a
1) (forall a b. a -> b -> a
const a
2) Maybe (Money a)
spouseIncome
  increase :: a
increase = a
1500 forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
max a
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
dependents forall a. Num a => a -> a -> a
- a
1)
  preppedRates :: PrivateHealthInsuranceRebateRates a
preppedRates = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1) ((forall a. Num a => a -> a -> a
+ a
increase) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* a
factor)) PrivateHealthInsuranceRebateRates a
rates

  preppedIncome :: Money a
preppedIncome = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Money a
income (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 = 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 forall a. Num a => Money a -> Money a -> Money a
$-$ forall a b. Tax a b -> a -> b
getTax (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. RealFrac a => Money a -> Money a
roundCents Tax (Money a) (Money a)
rate) Money a
eligible