-- This file is part of hs-tax
-- Copyright (C) 2018 Fraser Tweedale
--
-- hs-tax 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 .
{-|
This library provides combinators for constructing taxes. It is
based on the
library.
The most basic tax is a flat rate tax:
@
businessTax = 'flat' 0.3
@
To compute the tax, use 'getTax':
@
λ> 'getTax' businessTax (review money 1000000)
$300000.0
@
Taxes form a semigroup (sum of tax outputs) and monoid:
@
λ> getTax (flat 0.1 <> flat 0.2) (review money 10)
$3.0
λ> getTax mempty (review money 10)
$0
@
Marginal tax rates can be constructed using the 'above' combinator,
which taxes the amount above a given threshold at a flat rate.
@
individualIncomeTax :: (Fractional a, Ord a) => Tax a
individualIncomeTax =
'above' (review money 18200) 0.19
<> 'above' (review money 37000) (0.325 - 0.19)
<> 'above' (review money 87000) (0.37 - 0.325)
<> 'above' (review money 180000) (0.45 - 0.37)
@
Taxes can be negative. For exmaple, the 'lump', 'above' and 'limit'
combinators can be used to construct a low-income tax offset that
starts at $445 and reduces at a rate of 1.5c per dollar earned over
$37000:
@
lowIncomeTaxOffset =
'limit' mempty
('lump' (review money (-445)) <> 'above' (review money 37000) 0.015)
@
The 'threshold' combinator applies a tax to the full input amount,
if it exceeds the threshold. Some taxes have "shade-in" where the
amount above the threshold is taxed at a higher rate to "catch up"
to some lower flat rate. The 'threshold'' and 'lesserOf'
combinators can be used to construct this tax:
@
medicareLevy :: (Fractional a, Ord a) => Tax a
medicareLevy = 'threshold'' l ('lesserOf' ('above' l 0.1) ('flat' 0.02))
where l = review money 21656
@
-}
module Data.Tax
(
-- * Constructing taxes
Tax(..)
, lump
, flat
, threshold
, threshold'
, above
, above'
, lesserOf
, greaterOf
, limit
, adjust
, effective
-- * Miscellanea
, Semigroup(..)
, Monoid(..)
, module Data.Money
) where
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.Money
-- | A function from gross income to tax payable.
--
-- Taxes form a semigroup where the tax payable is the
-- sum of tax payable of consituent taxes.
--
-- Taxes form a monoid where the identity is a tax of 0%
--
newtype Tax a = Tax { getTax :: Money a -> Money a }
instance Num a => Semigroup (Tax a) where
Tax f <> Tax g = Tax (\x -> f x <> g x)
instance Num a => Monoid (Tax a) where
mempty = lump mempty
mappend = (<>)
-- | Tax the amount exceeding the threshold at a flat rate.
--
-- You can use @above@ to construct marginal taxes:
--
-- @
-- marginal =
-- above 18200 0.19
-- <> above 37000 (0.325 - 0.19)
-- <> above 87000 (0.37 - 0.325)
-- <> above 180000 (0.45 - 0.37)
-- @
--
above :: (Num a, Ord a) => Money a -> a -> Tax a
above l = above' l . flat
-- | Tax the amount exceeding the threshold
above' :: (Num a, Ord a) => Money a -> Tax a -> Tax a
above' l tax = Tax (\x -> getTax tax (max (x $-$ l) mempty))
-- | A lump-sum tax; a fixed amount, not affected by the size of the input
--
lump :: Money a -> Tax a
lump = Tax . const
-- | Construct a flat rate tax with no threshold
flat :: (Num a) => a -> Tax a
flat = Tax . (*$)
-- | Tax full amount at flat rate if input >= threshold
threshold :: (Num a, Ord a) => Money a -> a -> Tax a
threshold l = threshold' l . flat
-- | Levy the tax if input >= threshold, otherwise don't
threshold' :: (Num a, Ord a) => Money a -> Tax a -> Tax a
threshold' l tax = Tax (\x -> if x >= l then getTax tax x else mempty)
-- | Levy the lesser of two taxes
lesserOf :: (Ord a) => Tax a -> Tax a -> Tax a
lesserOf t1 t2 = Tax (\x -> min (getTax t1 x) (getTax t2 x))
-- | Levy the greater of two taxes
greaterOf :: (Ord a) => Tax a -> Tax a -> Tax a
greaterOf t1 t2 = Tax (\x -> max (getTax t1 x) (getTax t2 x))
-- | Limit the tax payable to the given amount
--
-- This could be used e.g. for limiting a compulsory loan
-- repayment to the balance of the loan, or ensuring a
-- (negative) tax offset does not become a (positive) tax.
--
limit :: (Ord a) => Money a -> Tax a -> Tax a
limit = lesserOf . lump
-- | Multiply a tax by the given ratio
adjust :: (Num a) => a -> Tax a -> Tax a
adjust r tax = Tax (\x -> r *$ getTax tax x)
-- | Given a tax and an amount construct the effective flat tax rate
--
effective :: (Fractional a) => Money a -> Tax a -> Tax a
effective x tax = flat (getTax tax x $/$ x)