Return total balance from unsorted purchase items that may have specials

  Item   Unit      Special
         Price     Price
  --------------------------
    A     50       3 for 130
    B     30       2 for 45
    C     20
    D     15

module Checkout

(*Types*)
type Type = A | B | C | D
type Total = { UnitPrice:int ; Qty:int }
             member x.Price() = x.UnitPrice * x.Qty

type Special =
    | None
    | ThreeForOneThirty
    | TwoForFourtyFive

type Item = 
    { Type:Type
      Total:Total
      Special:Special } 

      member x.Price() =
        match x.Special with
        | ThreeForOneThirty -> 
            if x.Total.Qty / 3 > 0
            then (x.Total.Qty / 3) * 130
            else x.Total.Price()

        | TwoForFourtyFive ->
            if x.Total.Qty / 2 > 0
            then (x.Total.Qty / 2) * 45
            else x.Total.Price()

        | None -> x.Total.Price()

(*Private Functions*)
let private getTypeQty itemsOfType = 
    itemsOfType |> Seq.sumBy(fun x -> x.Total.Qty)

let private consolidate group acc =

    let first = group |> Seq.head
    { Type    =  first.Type; 
      Total   = { Qty=group |> getTypeQty; UnitPrice=first.Total.UnitPrice }
      Special = first.Special; } :: acc 

(*Tests*)
open FsUnit
open NUnit.Framework

[<Test>]
let ``buying (2) A units, (1) B unit, (1) A unit = $160`` () =

    // Setup
    let a2 = { Type=A; Total={UnitPrice=50; Qty=2}; Special=ThreeForOneThirty }
    let b =  { Type=B; Total={UnitPrice=30; Qty=1}; Special=TwoForFourtyFive  }
    let a =  { Type=A; Total={UnitPrice=50; Qty=1}; Special=ThreeForOneThirty }

    seq [a2; b; a] |> Seq.groupBy (fun item -> item.Type)
                   |> Seq.map snd
                   |> Seq.fold(fun consolidated group -> consolidate group consolidated) []
                   |> Seq.sumBy (fun item -> item.Price())
                   |> should equal 160

Paraphrasing Kent Beck (IIRC), I'd design my types so that concerns that change together are kept together, whereas concerns that change separately should be kept as separate as possible.

With that in mind, I'd start defining shopping basket items as simply as possible:

type Good = { SKU : string; Price : int }

This also enables you to define the price table, independently of the discount rules:

let prices = [
    { SKU = "A"; Price = 50 }
    { SKU = "B"; Price = 30 }
    { SKU = "C"; Price = 20 }
    { SKU = "D"; Price = 15 } ]

// string -> Good option
let scan sku = prices |> List.tryFind (fun x -> x.SKU = sku)

This code snippet also defines a simple scan function that can be used to look up a string in the price table in order to turn it into a Good value.

I don't think modelling the product as a discriminated union (e.g. A | B | C | D) is a good idea, because that's going to make it hard if you want to add an E product, or if you want to remove the C product.

The same type of argument goes for price rules. List prices change according to business decisions, and the same goes for discounts, but at different rates. Discriminated unions define a finite set of options, but I don't think a set of discounts ought to be a finite set of hard-coded options. You should be able to add or remove discount rules according to business decisions.

Instead, I'd be inclined to define a discount with the type Good list -> int * Good list. The idea here is that you input a list of Good values, and you get back a price (int) and the remaining Good values where a price has yet to be calculated.

You can, for example, implement the rule about the A products like this:

// Good list -> int * Good list
let aRule items =
    let xs, others = List.partition (fun x -> x.SKU = "A") items
    let hits, rest =
        xs |> List.chunkBySize 3 |> List.partition (fun l -> l.Length = 3)
    let xTotal = hits.Length * 130
    xTotal, rest |> List.concat |> List.append others

This looks, perhaps, a bit complicated, but it works like this:

1. First, it partitions all items into A items (xs) and all other items (others).
2. It then divides xs into chunks of 3. This produces a list of lists, where most of the lists have the length 3. There may, however, be a residual list with one or two items, so these are partitioned into the rest value.
3. The total for all the hits is calculated. Each hit is a list of three A items, which has the special discount price 130. You may have three, six, nine, etc. A items, so the special price 130 is multiplied with the length of hits, which is a list of lists.
4. Finally, xTotal is returned, together with all the items that didn't trigger the discount. These include all non-A items, but also residual A items.

Likewise, the discount for B items can be defined in the same way:

// Good list -> int * Good list
let bRule items =
    let xs, others = List.partition (fun x -> x.SKU = "B") items
    let hits, rest =
        xs |> List.chunkBySize 2 |> List.partition (fun l -> l.Length = 2)
    let xTotal = hits.Length * 45
    xTotal, rest |> List.concat |> List.append others

This function is almost identical to aRule, so is a candidate for some refactoring. Here, however, I decided to apply the rule of three, so I left them as is.

Apart from these discount rules, you'll also need a 'default' price calculation rule:

// Good list -> int * 'a list
let defaultRule items = List.sumBy (fun x -> x.Price) items, []

Notice how Good list -> int * 'a list also fits the desired type of Good list -> int * Good list. This enables you to define a set of rules as a list:

// (Good list -> int * Good list) list
let rules = [aRule; bRule; defaultRule]

Calculating a total price is now easy:

// ('a -> int * 'a) list -> 'a -> int
let total rules items = 
    let acc (tot, rest) f =
        let tot', rest' = f rest
        tot + tot', rest'
    rules |> List.fold acc (0, items) |> fst

This function performs a left fold over rules, while accumulating the total so far, and the rest of the items.

Tests

This implementation passes all the tests in the original kata formulation:

open Xunit
open Swensen.Unquote

[<Theory>]
[<InlineData("", 0)>]
[<InlineData("A", 50)>]
[<InlineData("AB", 80)>]
[<InlineData("CDBA", 115)>]

[<InlineData("AA", 100)>]
[<InlineData("AAA", 130)>]
[<InlineData("AAAA", 180)>]
[<InlineData("AAAAA", 230)>]
[<InlineData("AAAAAA", 260)>]

[<InlineData("AAAB", 160)>]
[<InlineData("AAABB", 175)>]
[<InlineData("AAABBD", 190)>]
[<InlineData("DABABA", 190)>]

// Incremental
[<InlineData("A", 50)>]
[<InlineData("AB", 80)>]
[<InlineData("ABA", 130)>]
[<InlineData("ABAA", 160)>]
[<InlineData("ABAAB", 175)>]
let ``total returns correct result`` (items : string) expected =
    let actual =
        items |> Seq.choose (string >> scan) |> Seq.toList |> total rules
    expected =! actual

Flexibility

Is this the simplest possible implementation? Most likely not, but it's fairly flexible.

Imagine, for example, that you're being asked to implement a new 'bundle' discount where you get A, B, and C for 85 if you buy them together. You can implement this without changing any of the existing code:

// f:('a -> bool) -> ('a list -> 'a option * 'a list)
let tryFindFirst f =
    let acc (found, others) x =
        match found with
        | Some hit -> Some hit, x :: others
        | None -> if f x then Some x, others else None, x :: others
    List.fold acc (None, []) >> (fun (found, others) -> found, List.rev others)

// Good list -> int * Good list
let bundleRule items =
    let aOpt, rest = tryFindFirst (fun x -> x.SKU = "A") items
    let bOpt, rest = tryFindFirst (fun x -> x.SKU = "B") rest
    let cOpt, rest = tryFindFirst (fun x -> x.SKU = "C") rest
    match aOpt, bOpt, cOpt with
    | Some a, Some b, Some c -> 85, rest
    | _ -> 0, items

As you can see, bundleRule has the desired type, so can be used together with the other pricing rules:

[<Theory>]
[<InlineData("ABC", 85)>]
[<InlineData("BAC", 85)>]
[<InlineData("ABBA", 145)>]
[<InlineData("ABCAA", 185)>]
let ``bundle rule is applied correctly when having high priority``
    (items : string)
    expected =

    let actual =
        items
        |> Seq.choose (string >> scan)
        |> Seq.toList
        |> total (bundleRule :: rules)
    expected =! actual

Notice the test case for ABCAA. This combination fits both the bundle discount, and the triple-A discount. Since bundleRule comes first, however, it wins, and removes ABC from further calculation, thereby correctly preventing the triple-A rule from being applied.

If your business experts ask you to prioritise the triple-A rule over the bundle rule, that's possible as well:

[<Theory>]
[<InlineData("ABC", 85)>]
[<InlineData("BAC", 85)>]
[<InlineData("ABBA", 145)>]
[<InlineData("ABCAA", 180)>]
let ``bundle rule is applied correctly when having low priority``
    (items : string)
    expected =

    let actual =
        items
        |> Seq.choose (string >> scan)
        |> Seq.toList
        |> total [aRule; bRule; bundleRule; defaultRule]
    expected =! actual

In this test, notice that the order of the rules is different. This causes aRule to trigger before bundleRule, and for that reason, the ABCAA test case has a different outcome.

State

Did I just come up with all of this myself? Not quite, I was leveraging my knowledge of functional programming 'design patterns'.

Functions with the type 's -> 'a * 's are part of the State monad. All the price functions have the type Good list -> int * Good list, which make them State 'instances'.

In fact, you can make use of the state monad easier by introducing the standard monadic functions like return, bind, map, and so on. In F#, you can further sprinkle on syntactic sugar by implementing a state computation expression. Here are some notes on doing that.

Sometimes, it helps to define a type alias for the monadic type in question:

type State<'a, 's> = ('s -> 'a * 's)

This isn't strictly necessary, but I think it makes is a bit easier to reason about some of the following code.

Next, you can define a module to implement the most important functions:

module State =
    // 'a -> State<'b,'a> -> 'b * 'a
    let run state (f : State<_, _>) = f state

    // 'a -> 'b -> 'a * 'b
    let lift x state = x, state

    // ('a -> 'b) -> State<'a,'c> -> 'c -> 'b * 'c
    let map f x state =
        let x', newState = run state x
        f x', newState

    // ('a -> State<'b,'s>) -> State<'a,'s> -> 's -> 'b * 's    
    let bind (f : 'a -> State<'b, 's>) (x : State<'a, 's>) state =
        let x', newState = run state x
        run newState (f x')

    // 'a -> 'a * 'a    
    let get state = state, state

    // 'a -> 'b -> unit * 'a
    let put newState _ = (), newState

    // ('a -> 'a) -> ('a -> unit * 'a)
    let modify f = get |> map f |> bind put

You can define more, but here, I only added the functions I'll need in the coming examples.

The most important functions are lift and bind. Often, in other languages, the lift function is called return, or pure, but both of these are reserved keywords in F#. These two functions define the monad. The rest are useful extra functions (apart from the map function, which could be used to define State as a Functor in Haskell).

Computation expression

Using the functions in the State module, you can implement a computation expression builder for the State monad. Again, I only add the absolute minimum required in order to make the examples below compile:

type StateBuilder () =
    // State<'c,'d> * ('c -> State<'e,'d>) -> ('d -> 'e * 'd)
    member this.Bind (s, f) = State.bind f s
    // 'a -> ('b -> 'a * 'b)
    member this.Return x = State.lift x

As you can see, the Bind and Return methods simply delegate to the State module's functions.

Refactored price functions

With these new tools, you can now refactor the above price functions.

First, I decided to implement a single function that you can use to define n for x discounts:

// int -> int * string -> (Good list -> int * Good list)
let forOnly price (n, sku) = state {
    let! xs = List.partition (fun x -> x.SKU = sku)
    let hits, residual =
        xs |> List.chunkBySize n |> List.partition (fun l -> l.Length = n)
    do! State.modify (residual |> List.concat |> List.append)
    return hits.Length * price }

If you keep in mind the definition of the State type, you can also view this function as having the type int -> int * string -> State<int, Good list>. It can be used like this to define a price rule:

// Good list -> int * Good list  .. or, alternatively:
// State<int, Good list>
(3, "A") |> forOnly 130

Notice that it's possible to use the existing, built-in function List.partition with a let! binding. This is possible because the type of List.partition is ('a -> bool) -> 'a list -> 'a list * 'a list. Notice how 'a list -> 'a list * 'a list can also be viewed as State<'a list, 'a list>. This means that the first let! expression binds xs to the items that satisfy the predicate passed to List.partition, while the items that don't match are being threaded through the computation expression as the underlying state.

Once you've found any residual, you'll need to put it back into the underlying state. You can do this with do! State.modify. Finally, you return the result of the price calculation.

The same sort of refactoring can be done for bundleRule:

// Good list -> int * Good list
let bundleRule = state {
    let! originalItems = State.get
    let! aOpt = tryFindFirst (fun x -> x.SKU = "A")
    let! bOpt = tryFindFirst (fun x -> x.SKU = "B")
    let! cOpt = tryFindFirst (fun x -> x.SKU = "C")
    match aOpt, bOpt, cOpt with
    | Some a, Some b, Some c -> return 85
    | _ ->
        do! State.put originalItems
        return 0 }

Compared to the previous incarnation of bundleRule, this implementation is actually a bit longer, but IMO more readable. Again, the underlying state is implicitly threaded through the computation, but as you can tell, you can retrieve it with State.get and 'write' it with State.put.

I find this version more readable because I don't have to declare intermediary state values (rest) and pass them around. In the previous version, if I forgot to pass them around in the correct manner, the calculation would be incorrect.

It's almost as though the State-based implementation looks more imperative. The same would be the case in Haskell, and there's a saying that Haskell is the best imperative language that exists. Here we see that F# is no slouch either.