Skip to content

Instantly share code, notes, and snippets.

@mengwong
Last active June 12, 2020 16:07
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mengwong/7ce70ad8b09c43f56ae7eeaa5b049961 to your computer and use it in GitHub Desktop.
Save mengwong/7ce70ad8b09c43f56ae7eeaa5b049961 to your computer and use it in GitHub Desktop.
tax Credit A, B, and C, via a chain of transformers of the default inherited value
#!stack
-- stack --resolver lts-15.12 script
data Person = Person { pname :: String, children :: [Person] }
a = Person "Alice" []
b = Person "Bob" []
c = Person "Carol" [a, b]
data TaxCredit = TaxCredit { tcname :: String
, rateDefault :: Int
, rateTrans :: [Person -> Int -> Int]
, rate :: Person -> TaxCredit -> Int
}
taxCredit_ = TaxCredit { tcname = "default"
, rateDefault = 100
, rateTrans = []
, rate = \person tc -> foldl (flip (.)) id (rateTrans tc <*> [person]) (rateDefault tc)
-- apply all the rate transformers, starting with the default
}
taxCreditB = taxCredit_ { tcname = "Tax Credit B" }
taxCreditA = taxCreditB { tcname = "Tax Credit A"
, rateTrans = (rateTrans taxCreditB) <>
[\person -> if length (children person) == 2
then (`div` 2)
else id ]
}
taxCreditC = taxCreditA { tcname = "Tax Credit C"
, rateTrans = (rateTrans taxCreditA) <> [\person -> (+23)]
}
main = do
mapM_ putStrLn [ unwords [ pname p ++ ":\t", tcname tc, "=", show ((rate tc) p tc) ]
| tc <- [taxCreditB, taxCreditA, taxCreditC]
, p <- [a, b, c] ]
{-
20200612-23:53:49 mengwong@venice4:~/tmp/python/taxc% stack taxc2.hs
Alice: Tax Credit B = 100
Bob: Tax Credit B = 100
Carol: Tax Credit B = 100
Alice: Tax Credit A = 100
Bob: Tax Credit A = 100
Carol: Tax Credit A = 50
Alice: Tax Credit C = 123
Bob: Tax Credit C = 123
Carol: Tax Credit C = 73
-}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment