tax 0.1.0.0 → 0.2.0.0

raw patch · 2 files changed

+74/−39 lines, 2 filesdep +profunctorsPVP ok

version bump matches the API change (PVP)

Dependencies added: profunctors

API changes (from Hackage documentation)

Files

• src/Data/Tax.hs +71/−38
• tax.cabal +3/−1

@@ -46,7 +46,6 @@ 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)@@ -72,35 +71,59 @@ 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+medicareLevy =+  'threshold'' l ('lesserOf' ('above' l 0.1) ('flat' 0.02))+    where l = review money 21656 @ +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.++@+data Sex = M | F+newtype Years = Years Int+newtype Days = Days Int+data Person = Person Years Sex++corvée :: Tax Person Days+corvée = Tax f+  where+  f (Person (Years age) sex) = Days $ if age >= 18 && age <= maxAge sex then 10 else 0+  maxAge sex = case sex of M -> 45 ; F -> 35+@+ -}++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module Data.Tax   (   -- * Constructing taxes     Tax(..)+  , MoneyTax   , lump   , flat   , threshold   , threshold'+  , thresholds   , above   , above'+  , marginal   , lesserOf   , greaterOf   , limit-  , adjust   , effective    -- * Miscellanea   , Semigroup(..)   , Monoid(..)+  , Profunctor(..)   , module Data.Money   ) where  import Data.Monoid (Monoid(..))+import Data.Profunctor (Profunctor(..)) import Data.Semigroup (Semigroup(..))  import Data.Money@@ -112,57 +135,69 @@ -- -- 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)+-- Taxes are a profunctor, making it trivial to perform simple+-- transformations of the input and/or output (e.g. rounding+-- down to whole dollars).+--+newtype Tax a b = Tax { getTax :: a -> b }+  deriving (Semigroup, Monoid, Functor, Profunctor) -instance Num a => Monoid (Tax a) where-  mempty = lump mempty-  mappend = (<>)+-- | Convenience synonym for working with 'Money'+type MoneyTax a = Tax (Money a) (Money a)  -- | 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 :: (Num a, Ord a) => Money a -> a -> Tax (Money a) (Money 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))+above' :: (Num b, Ord b) => Money b -> Tax (Money b) a -> Tax (Money b) a+above' l = lmap (\x -> max (x $-$ l) mempty) --- | A lump-sum tax; a fixed amount, not affected by the size of the input+-- | Convert a @[(threshold, rate)]@ into a marginal tax.+-- The rates are /cumulative/, i.e. the top marginal rate is the+-- sum of the rates that apply for a given input. ---lump :: Money a -> Tax a+marginal :: (Fractional 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+--+lump :: a -> Tax b a lump = Tax . const  -- | Construct a flat rate tax with no threshold-flat :: (Num a) => a -> Tax a+flat :: (Num a) => a -> Tax (Money a) (Money a) flat = Tax . (*$)  -- | Tax full amount at flat rate if input >= threshold-threshold :: (Num a, Ord a) => Money a -> a -> Tax a+threshold :: (Num a, Ord a) => Money a -> a -> Tax (Money a) (Money 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' :: (Ord b, Monoid a) => b -> Tax b a -> Tax b a threshold' l tax = Tax (\x -> if x >= l then getTax tax x else mempty) +-- | Convert a @[(threshold, rate)]@ into a flat tax whose rate is+-- the sum of the rates that apply for a given input.  The rates+-- are /cumulative/.  For example, if you want to tax people earning+-- >$30,000 20%, and people earning >$50,000 30%, you only tax an+-- extra 10% at 50000:+--+-- @+-- tax = thresholds [(30000, .2), (50000, .1)]+-- @+--+thresholds :: (Fractional a, Ord a) => [(Money a, a)] -> Tax (Money a) (Money a)+thresholds = foldMap (uncurry threshold)+ -- | Levy the lesser of two taxes-lesserOf :: (Ord a) => Tax a -> Tax a -> Tax a+lesserOf :: (Ord a) => Tax b a -> Tax b a -> Tax b 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 :: (Ord a) => Tax b a -> Tax b a -> Tax b a greaterOf t1 t2 = Tax (\x -> max (getTax t1 x) (getTax t2 x))  -- | Limit the tax payable to the given amount@@ -171,14 +206,12 @@ -- 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 :: (Ord a) => a -> Tax b a -> Tax b 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+  :: (Fractional a)+  => Money a -> Tax (Money a) (Money a) -> Tax (Money a) (Money a) effective x tax = flat (getTax tax x $/$ x)

@@ -1,5 +1,5 @@ name:                tax-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Types and combinators for taxes description:   This library provides combinators for constructing taxes.  It is based on@@ -29,6 +29,8 @@   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