Skip to content

Instantly share code, notes, and snippets.

@mengwong
Created June 12, 2020 17:38
Show Gist options
  • Save mengwong/54858e314ee487ff620e006e684d915d to your computer and use it in GitHub Desktop.
Save mengwong/54858e314ee487ff620e006e684d915d to your computer and use it in GitHub Desktop.
tax Credits using numbers closer to reality
#!stack
-- stack --resolver lts-15.12 script
{-# LANGUAGE MultiWayIf #-}
import Data.List (isPrefixOf)
data Person = Person { pname :: String, children :: [Person], income :: Float }
a = Person "Alice" [] 8000
b = Person "Bob" [] 2000
c = Person "Carol" [a, b] 10000
taxCreditA = taxCredit_ { tcname = "Tax Credit A"
, rateDefault = 0.15 }
taxCreditB = "Tax Credit B" `isJustLike` taxCreditA
`butAdding_RateTransformer` \person -> (/ 2) `onlyWhen` (person `has` 2 $ children)
taxCreditC = "Tax Credit C" `isJustLike` taxCreditB
`butReplacing_RateTransformerWith` \person -> (+ 0.2) `onlyWhen` (person `has` 2 $ children)
taxCreditD = "Tax Credit D" `isJustLike` taxCreditC
`butAdding_RateTransformer` \person -> if
| "Al" `isPrefixOf` pname person -> (+ 0.1)
| "Bo" `isPrefixOf` pname person -> (subtract 0.1)
| otherwise -> noChange
main = do
mapM_ putStrLn [ unwords [ pname p ++ ":\t", tcname tc, "=", show (round $ creditAmount p tc) ]
| tc <- [taxCreditA, taxCreditB, taxCreditC, taxCreditD]
, p <- [a, b, c] ]
{-
20200613-01:37:13 mengwong@venice4:~/tmp/python/taxc% stack ./taxc2.hs
Alice: Tax Credit A = 1200
Bob: Tax Credit A = 300
Carol: Tax Credit A = 1500
Alice: Tax Credit B = 1200
Bob: Tax Credit B = 300
Carol: Tax Credit B = 750
Alice: Tax Credit C = 1200
Bob: Tax Credit C = 300
Carol: Tax Credit C = 3500
Alice: Tax Credit D = 2000
Bob: Tax Credit D = 100
Carol: Tax Credit D = 3500
-}
isJustLike :: String -> TaxCredit -> TaxCredit
isJustLike newname prototype = prototype { tcname = newname }
butAdding_RateTransformer :: TaxCredit -> RateTransformer -> TaxCredit
butAdding_RateTransformer template newRT = template { rateTrans = rateTrans template <> [newRT] }
butAdding_RateTransformers :: TaxCredit -> [RateTransformer] -> TaxCredit
butAdding_RateTransformers template newRTs = template { rateTrans = rateTrans template <> newRTs }
butReplacing_RateTransformerWith :: TaxCredit -> RateTransformer -> TaxCredit
butReplacing_RateTransformerWith template newRT = template { rateTrans = [newRT] }
butReplacing_RateTransformersWith :: TaxCredit -> [RateTransformer] -> TaxCredit
butReplacing_RateTransformersWith template newRTs = template { rateTrans = newRTs }
onlyWhen :: (a -> a) -> Bool -> (a -> a)
onlyWhen x True = x
onlyWhen x False = id
noChange = id
type RateTransformer = Person -> Float -> Float
data TaxCredit = TaxCredit { tcname :: String
, rateDefault :: Float
, rateTrans :: [RateTransformer]
}
creditAmount :: Person -> TaxCredit -> Float -- apply all the rate transformers, starting with the default
creditAmount p tc = income p * foldl (flip (.)) id (rateTrans tc <*> [p]) (rateDefault tc)
taxCredit_ = TaxCredit { tcname = "default"
, rateDefault = 0
, rateTrans = []
}
has :: Person -> Int -> (Person -> [Person]) -> Bool
has p n c = length (c p) == n
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment