diff --git a/src/Data/Tax.hs b/src/Data/Tax.hs --- a/src/Data/Tax.hs +++ b/src/Data/Tax.hs @@ -14,12 +14,50 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + {-| This library provides combinators for constructing taxes. It is based on the library. +-} +module Data.Tax + ( + -- * Overview + -- $doc + + -- * API + Tax(..) + , MoneyTax + , lump + , flat + , threshold + , threshold' + , thresholds + , above + , above' + , marginal + , lesserOf + , greaterOf + , limit + , effective + + -- * Re-exports + , module Data.Money + , Semigroup(..) + , Monoid(..) + , Profunctor(..) + ) where + +import Data.Profunctor (Profunctor(..)) +import Data.Semigroup (Semigroup(..)) + +import Data.Money + +{- $doc + The most basic tax is a flat rate tax: @ @@ -29,31 +67,41 @@ To compute the tax, use 'getTax': @ -λ> 'getTax' businessTax (review money 1000000) +λ> 'getTax' businessTax (Money 1000000) $300000.0 @ Taxes form a semigroup (sum of tax outputs) and monoid: @ -λ> getTax (flat 0.1 <> flat 0.2) (review money 10) +λ> getTax (flat 0.1 <> flat 0.2) (Money 10) $3.0 -λ> getTax mempty (review money 10) +λ> getTax mempty (Money 10) $0 @ -Marginal tax rates can be constructed using the 'above' combinator, +Progressive taxes can be constructed using the 'above' combinator, which taxes the amount above a given threshold at a flat rate. @ 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) + 'above' (Money 18200 ) (0.19 - 0 ) + <> 'above' (Money 45000 ) (0.325 - 0.19 ) + <> 'above' (Money 120000) (0.37 - 0.325 ) + <> 'above' (Money 180000) (0.45 - 0.37 ) @ -Taxes can be negative. For exmaple, the 'lump', 'above' and 'limit' +The 'marginal' function provides a shorthand for the above. + +@ +individualIncomeTax = 'marginal' + [ ( Money 18200, 0.19 - 0 ) + , ( Money 45000, 0.325 - 0.19 ) + , ( Money 120000, 0.37 - 0.325 ) + , ( Money 180000, 0.45 - 0.37 ) ] +@ + +Taxes can be negative. For example, 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: @@ -61,21 +109,28 @@ @ lowIncomeTaxOffset = 'limit' mempty - ('lump' (review money (-445)) <> 'above' (review money 37000) 0.015) + ('lump' (Money (-445)) <> 'above' (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: +if it exceeds the threshold. @ -medicareLevy = - 'threshold'' l ('lesserOf' ('above' l 0.1) ('flat' 0.02)) - where l = review money 21656 +medicareLevySurcharge = + 'threshold' (review money 90000 ) 0.0100 + <> 'threshold' (review money 105000) 0.0025 + <> 'threshold' (review money 140000) 0.0025 @ +Some taxes have "shade-in" where the amount above some threshold is +taxed at a higher rate to "catch up" to some lower flat rate. The +'above' and 'lesserOf' combinators can be used to construct this +tax: + +@ +medicareLevy l = 'lesserOf' ('above' l 0.1) ('flat' 0.02) +@ + Although some of the combinators deal directory with 'Money', a 'Tax' can be defined for other types. For example, you can tax a person a certain number of days labour, based on their age. @@ -95,40 +150,8 @@ -} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Data.Tax - ( - -- * Constructing taxes - Tax(..) - , MoneyTax - , lump - , flat - , threshold - , threshold' - , thresholds - , above - , above' - , marginal - , lesserOf - , greaterOf - , limit - , effective - - -- * Miscellanea - , Semigroup(..) - , Monoid(..) - , Profunctor(..) - , module Data.Money - ) where - -import Data.Monoid (Monoid(..)) -import Data.Profunctor (Profunctor(..)) -import Data.Semigroup (Semigroup(..)) - -import Data.Money - --- | A function from gross income to tax payable. +-- | A function from an amount or value subject to taxation, to +-- the amount or value of tax due. -- -- Taxes form a semigroup where the tax payable is the -- sum of tax payable of consituent taxes. @@ -154,15 +177,15 @@ above' :: (Num b, Ord b) => Money b -> Tax (Money b) a -> Tax (Money b) a above' l = lmap (\x -> max (x $-$ l) mempty) --- | Convert a @[(threshold, rate)]@ into a marginal tax. +-- | Convert a @[(threshold, rate)]@ into a progressive tax. -- The rates are /cumulative/, i.e. the top marginal rate is the -- sum of the rates that apply for a given input. -- -marginal :: (Fractional a, Ord a) => [(Money a, a)] -> Tax (Money a) (Money a) +marginal :: (Num a, Ord a) => [(Money a, a)] -> Tax (Money a) (Money a) marginal = foldMap (uncurry above) --- | A lump-sum tax; a fixed value, not affected by the size of the input +-- | A lump-sum tax; a fixed value (ignores input). -- lump :: a -> Tax b a lump = Tax . const @@ -186,10 +209,10 @@ -- extra 10% at 50000: -- -- @ --- tax = thresholds [(30000, .2), (50000, .1)] +-- tax = thresholds [(30000, 0.2), (50000, 0.1)] -- @ -- -thresholds :: (Fractional a, Ord a) => [(Money a, a)] -> Tax (Money a) (Money a) +thresholds :: (Num a, Ord a) => [(Money a, a)] -> Tax (Money a) (Money a) thresholds = foldMap (uncurry threshold) -- | Levy the lesser of two taxes @@ -202,8 +225,8 @@ -- | 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 +-- This could be used e.g. to limit a compulsory loan +-- repayment to the balance of the loan, or ensure a -- (negative) tax offset does not become a (positive) tax. -- limit :: (Ord a) => a -> Tax b a -> Tax b a diff --git a/tax.cabal b/tax.cabal --- a/tax.cabal +++ b/tax.cabal @@ -1,19 +1,19 @@ +cabal-version: 2.2 name: tax -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Types and combinators for taxes description: This library provides combinators for constructing taxes. It is based on the library. -license: AGPL-3 +license: AGPL-3.0-or-later license-file: LICENSE author: Fraser Tweedale maintainer: frase@frase.id.au copyright: Copyright (C) 2018 Fraser Tweedale category: Finance build-type: Simple -cabal-version: >=1.10 tested-with: - GHC==7.10.3, GHC==8.0.2, GHC==8.2.1, GHC==8.4.3 + GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.2 || ==9.12.2 homepage: https://github.com/frasertweedale/hs-tax bug-reports: https://github.com/frasertweedale/hs-tax/issues @@ -21,16 +21,43 @@ type: git location: https://github.com/frasertweedale/hs-tax.git +common common + default-language: Haskell2010 + ghc-options: + -Wall + -Wcompat + -Werror=missing-methods + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wnoncanonical-monad-instances + -Wpartial-fields + -Wredundant-constraints + -Wunused-packages + -fhide-source-paths + if impl(ghc >= 9.0) + ghc-options: + -Winvalid-haddock + -Werror=unicode-bidirectional-format-characters + if impl(ghc >= 9.2) + ghc-options: + -Wimplicit-lift + -Woperator-whitespace + -Wredundant-bang-patterns + if impl(ghc >= 9.4) + ghc-options: + -Wredundant-strictness-flags + build-depends: + base >= 4.14 && < 5 + library + import: common exposed-modules: Data.Tax -- other-modules: -- other-extensions: build-depends: - base >= 4.8 && < 5 , dollaridoos >= 0.1 , profunctors >= 5.1 - , semigroups >= 0.16 hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall