Minimalist Shopping cart implementation in Haskell

shooping_cart.hs

import qualified Data.Map as DM
 
data Product = Product String Float deriving (Show)
type ProductMap = DM.Map String [Product]
type DiscountTimes = (ProductMap -> Int)
data Discount = Discount Float DiscountTimes
 
products :: [Product]
products = milk ++ marsBars
  where milk     = replicate 7 $ Product "milk" 1.30
        marsBars = replicate 2 $ Product "mars" 0.75
 
productMap :: ProductMap
productMap = DM.fromListWith (++) productTuples
  where productTuples = map (\p@(Product name _) -> (name, [p])) products
 
marsDiscountTimes :: ProductMap -> Int
marsDiscountTimes prodMap = case DM.lookup "mars" prodMap of
                                Just products -> length products
                                Nothing -> 0
 
milkDiscountTimes :: ProductMap -> Int
milkDiscountTimes prodMap = case DM.lookup "milk" prodMap of
                                Just products -> (length products) `div` 3
                                Nothing -> 0
 
discounts :: [Discount]
discounts = [marsDiscount, milkDiscount]
  where milkDiscount = Discount 1.30 milkDiscountTimes
        marsDiscount = Discount 0.15 marsDiscountTimes
 
applyDiscount :: ProductMap -> Discount -> Float
applyDiscount prodMap (Discount value times) =  value * fromIntegral (times prodMap)
 
checkout :: ProductMap -> [Discount] -> Float
checkout prodMap discounts = total - totalDiscounts
  where products = concat $ DM.elems prodMap
        total = sum $ map (\(Product _ price) -> price) $ products
        totalDiscounts = sum $ map (applyDiscount prodMap) discounts
 
main = do
  putStrLn $ show $ checkout productMap discounts

-- $ runhaskell shopping_cart.hs
-- => 7.700001