{-
   My solution to "The Supermarket Pricing Kata"
   http://blogs.pragprog.com/cgi-bin/pragdave.cgi/Practices/Kata/KataOne.rdoc

   Tom Moertel <tom@moertel.com>
   2006-04-27
-}

module SupermarketPricing where

import Control.Arrow ((&&&))
import Data.List (groupBy, sort)
import Test.HUnit


-- Some type synonyms to make later definitions clearer

type Portion  = Double      -- ^ portion 'x' of a continuous (bulk) good
type Count    = Portion     -- ^ count 'n' of discrete goods
type Price    = Double      -- ^ price 'p' in dollars
type Name     = String      -- ^ good name 'nm'


-- | A pricing rule assigns a price to a given quantity of goods

data PricingRule
    = Per Portion Price     -- ^ for continuous goods:  x per p
    | For Count Price Price -- ^ for discrete goods:
                            --     n for p, rest for p2 ea.
  deriving (Eq, Ord, Read, Show)


-- | A good is a named quantity and its pricing rule

data Good
    = G { name :: Name, quantity :: ! Portion, rule :: PricingRule }
  deriving (Eq, Ord, Read, Show)


-- The following shorthand constructor functions for goods make it
-- easy to construct goods having common pricing rules

per nm y x p  = G nm y (Per x p)     -- ^ portion 'y' at rate 'x' per 'p'
each nm p     = G nm 1 (For 1 p p)   -- ^ discrete good, unit price 'p' ea.
for nm n p    = G nm 1 (For n p p)   -- ^ 'n' for 'p', rest for 'p' each
bogo          = flip bngo 1          -- ^ buy 1 for 'p', get 1 free
btgo          = flip bngo 2          -- ^ buy 2 for 'p' each, get 1 free
bngo nm n p   = G nm 1 (For n' np p) -- ^ buy 'n' for 'p' each, get 1 free
                where (n', np) = (n + 1, p * n)


-- | Compute the total price for a collection of goods

checkout :: [Good] -> Price
checkout =
    checkoutBy $ sum . map price


-- | Compute subtotals for each kind of good

subtotal :: [Good] -> [((Portion, Name), Price)]
subtotal =
    checkoutBy $ map ((quantity &&& name) &&& price)


-- | Generalized checkout according to checkout-rule function 'f'

checkoutBy :: ([Good] -> a) -> [Good] -> a
checkoutBy f =
    f . map (foldl1 combine) . groupByName . sort
  where
    groupByName = groupBy (\g1 g2 -> name g1 == name g2)


-- | Compute a good's price (strict rule interpretation)

price :: Good -> Price
price (G nm y (Per x p))    =  y * p / x
price (G nm m (For n p p2)) = (m - r) * p / n + r * p2
  where
    r = fromIntegral $ round m `rem` round n


-- | Combine two goods into a single, equivalent composite good

combine :: Good -> Good -> Good
combine g1@(G nm x rule) g2@(G nm2 x2 rule2)
    | nm /= nm2 || rule /= rule2
    = error $ "can't combine incompatible goods " ++ show [g1, g2]
    | otherwise
    = G nm (x + x2) rule


{-
                      *** Unit tests ***

             *SupermarketPricing> runTestTT tests
             Cases: 16  Tried: 16  Errors: 0  Failures: 0
-}

tests = test
    [ {- Checkout tests -}

   -- test name               computed result           expected

      "1x e99"             ~: corep 1 e99           ~?=   0.99
    , "2x e99"             ~: corep 2 e99           ~?=   1.98
    , "e99 e100"           ~: co [e99, e100]        ~?=   1.99
    , "1x bogo99"          ~: corep 1 b99           ~?=   0.99
    , "2x bogo99"          ~: corep 2 b99           ~?=   0.99
    , "3x bogo99"          ~: corep 3 b99           ~?=   1.98
    , "2x bogo99, split"   ~: co [b99, e100, b99]   ~?=   1.99
    , "1x btgo33"          ~: corep 1 t33           ~?=   0.33
    , "2x btgo33"          ~: corep 2 t33           ~?=   0.66
    , "3x btgo33"          ~: corep 3 t33           ~?=   0.66
    , "4x btgo33"          ~: corep 4 t33           ~?=   0.99
    , "1.0 bulk"           ~: co [bulk 1]           ~?=   1.00
    , "1.5 bulk"           ~: co [bulk 1.5]         ~?=   1.50
    , "1.0 + 1.5 bulk"     ~: co [bulk 1, bulk 1.5] ~?=   2.50

      {- Subtotal tests -}

    , "sub(e99, 1.5 oats)" ~: subtotal [e99, bulk 1.5]
                                 ~?= [ ((1.0, "e99"),  0.99)
                                     , ((1.5, "oats"), 1.50) ]
    , "sub(1 oats, e99, 1.5 oats)"
                           ~: subtotal [bulk 1, e99, bulk 1.5]
                                 ~?= [ ((1.0, "e99"),  0.99)
                                     , ((2.5, "oats"), 2.50) ]
    ]
  where

    -- shorthand defs for functions used commonly in testing

    co       = checkout
    rep      = replicate
    corep n  = co . rep n

    -- goods used in testing

    e99      = each "e99" 0.99      -- an item priced at $0.99 ea.
    e100     = each "e100" 1.00     -- an item priced at $1.00 ea.
    b99      = bogo "bogo99" 0.99   -- a buy-1-get-1 item at $0.99 ea.
    t33      = btgo "btgo33" 0.33   -- a buy-2-get-1 item at $0.33 ea.
    bulk x   = per "oats" x 1 1.00  -- a bulk item at $1.00 per portion
                                    --   (inital quanity of 'x' portions)