TL;DR;

Source code at khanhhua/promocode

Promotion as a DSL

At the core of the promotion system is a DSL which prescribes under which condition a transaction should be eligible for one or more promotions. A promotion should be parameterized and varies according to each transaction.

Design

The backbone of our Promotion processing is a function named runPromotion :: Promotion -> Transaction -> Offer.

Promotion is a transformation from Transaction to Offer without changing the prescribed promotion nor the inputted transaction. The Reader monad must be the best candidate in this situation: it has the following signature:

Reader Transaction Offer :: ReaderT Transaction Identity Offer

Condition is a transformation from Transaction to Bool, which is true only when the transaction meets the criteria for a promotion.

Reader Transaction Bool :: ReaderT Transaction Identity Bool

Given the building blocks we can introduce the concept of conditional promotion:

conditionalPromotion :: Condition -> Action Offer -> Promotion Offer

where:

  • Offer describes the exact item which customer received, eg. a Present or a monetary discount,
  • Action Offer is a parameter for yet another transformation from Transaction to Offer

in other words, conditionalPromotion is a series of three transformations, all of which take a transaction as their parameter.

┌─────────────┐       ┌──────────────┐       ┌─────────────┐
│<<Condition>>│       │  <<Action>>  │       │<<Promotion>>│
│             │       │              │       │             │
│ Transaction │       │ Transaction  │       │ Transaction │
│      │      │       │      │       │       │      │      │
│      │      ├──────►│      │       ├──────►│      │      │
│      ▼      │       │      ▼       │       │      ▼      │
│    Bool     │       │ Action Offer │       │    Offer    │
│             │       │              │       │             │
└─────────────┘       └──────────────┘       └─────────────┘

Implementation

First step

For each of the parametric blocks above, we implement a corresponding function, namely doTxCondition and doTxAction. The resultant block Promotion is computed by function conditionalPromotion. This transformation is the expected parameter for function runPromotion.

type Promotion a = Reader Transaction (Maybe a)

runPromotion :: PromotionT a -> Transaction -> Maybe a
runPromotion = runReader


doTxCondition :: Condition -> Promotion Bool
doTxCondition condition@(Product _ _) = do
  (Transaction items) <- ask
  pure . Just $ any (matchProductItem condition) items

doTxCondition condition@(Sum minTotal) = do
  tx <- ask
  pure . Just $ total tx >= minTotal


doTxAction :: TxAction Offer
doTxAction (GiveOffer offer) = pure . Just $ offer
doTxAction (TransactionDiscount rate) = do
  tx <- ask
  pure . Just $ Discount (T.total tx * rate)
doTxAction (ConcreteDiscount amount) = do
  tx <- ask
  pure . Just $ Discount (max (T.total tx) amount)


conditionalPromotion :: Condition -> Action Offer -> Promotion Offer
conditionalPromotion condition action = do
  maybeBool <- doTxCondition condition
  case maybeBool of
    Just True -> doTxAction action
    _ -> pure Nothing

Extension by composition

Since Promotion is the data type of the first parameter of runPromotion, it should be fairly straight forward to compose other kinds of promotion. We could introduce another function called bestPromotion

bestPromotion :: [Promotion Offer] -> Promotion Offer
bestPromotion = foldM f Nothing
  where
    f acc m = do
      offer <- m
      if isNothing offer then
        pure acc
      else
        pure $ max acc offer

Notice the beauty in the above implementation?!

There is no mention of Transaction anywhere? We are only interested in Offer when figuring out which one is the best Promotion.

We could have another function called betterPromotion

betterPromotion a b = bestPromotion [a, b]

Customization with generics

I would take the existing application to the next level of abstraction by separating the code into two distinguishable parts:

  • The Promotion calculation part consisting of DSL and its interpretation (aka, the app)
  • and the Offer part, which implementing applications differ from one another

DSL now goes as follows:

data Promotion a = Promotion Condition (Action a)
-- assuming Promotion Offer
Promotion (Sum 498) (TransactionDiscount 0.01)
Promotion (Product "TV" 1) (GiveOffer $ Present "Cleaner")
Promotion (Product "RADIO" 30) (TransactionDiscount 0.05)

App has the following structure:

data App a = App
  { handleAction :: TxAction a
  , promotions :: [Promotion a]
  }

Then runApp :: App a -> Transaction -> Maybe a is simply a delegation to runPromotion just like before

runApp (App doTxAction promotions) =
  let conditionalPromotions = map (makeConditionalPromotion doTxAction) promotions
  in runPromotion (bestPromotion conditionalPromotions)

where makeConditionalPromotion does the work of transforming DSL records into PromotionT a :: Reader Transaction (Maybe a) reader monads. Because we introduce record type Promotion, we have renamed the reader monad to PromotionT a.

Consumers of this library can now freely implement their own variation of custom Offer data type.