Figure out which items on a receipt were taxed

FindTax.hs

#!/usr/bin/env runhaskell

module FindTax where

-- To use this program, change the following two values:

-- 1. amounts: This is the list of individual amounts, NOT including tax.
amounts :: [Double]
amounts = [22.09, 81.89, 16.24]

-- 2. totalAmount: This is the amount that was actually paid, and includes tax.
--    For example, it might be the amount that appears on your credit card
--    statement.
totalAmount :: Double
totalAmount = 124.13

-- Everything below does not need to be edited.

main :: IO ()
main = mapM_ print cleanedCandidates

-- (amount that the item cost pre-tax, tax multiplier); the tax multiplier is
-- expressed as the actual multiplicative value needed to calculate the total
-- cost, so a 10% tax would be 1.10.
type TaggedValue = (Double, Double)

-- (total sum up to now, [list of values that were added to reach the sum])
type TaggedHistory = (TaggedValue, [TaggedValue])

-- In my experience, at least when making purchases in Washington state, the
-- exact sales tax amount (while always roughly 10%) can change a little bit,
-- especially over the years, so trying a few different values is sometimes
-- necessary.
possibleTaxMultipliers :: [Double]
possibleTaxMultipliers = [1.100, 1.101, 1.102, 1.103]

tagWithMultiplier :: Double -> Double -> TaggedValue
tagWithMultiplier m v = (v, m)

tagAmount :: [Double] -> Double -> [TaggedValue]
tagAmount ms v = fmap tagWithMultiplier ms <*> [v]

fromTaggedValue :: TaggedValue -> TaggedHistory
fromTaggedValue x = (x, [x])

-- The outer list tracks the separate things you bought, and the inner list
-- tracks the possible tax multipliers.
amountsWithMultiplier :: Double -> [[TaggedHistory]]
amountsWithMultiplier m = fmap (fmap fromTaggedValue . tagAmount [1, m]) amounts

addHistories :: TaggedHistory -> TaggedHistory -> TaggedHistory
addHistories ((x, m), xs) ((y, m'), ys) = ((x*m + y*m', 1), xs ++ ys)

allPossibilitiesWithMultiplier :: Double -> [TaggedHistory]
allPossibilitiesWithMultiplier m = foldr1 (\xs ys -> addHistories <$> xs <*> ys) (amountsWithMultiplier m)

allPossibilities :: [TaggedHistory]
allPossibilities = concatMap allPossibilitiesWithMultiplier possibleTaxMultipliers

candidateHistories :: [TaggedHistory]
candidateHistories = filter (\((x, _), _) -> abs (x - totalAmount) < 0.01) allPossibilities

cleanHistory :: TaggedHistory -> [TaggedValue]
cleanHistory (_, xs) = filter (\(x, _) -> x /= 0) xs

cleanedCandidates :: [[TaggedValue]]
cleanedCandidates = fmap cleanHistory candidateHistories