This article walks you through the Maître d' kata done in F#.

In a previous article, I presented the Maître d' kata and promised to publish a walkthrough. Here it is.

Preparation #

I used test-driven development and F# for both unit tests and implementation. As usual, my test framework was xUnit.net (2.4.0) with Unquote (5.0.0) as the assertion library.

I could have done the exercise with a property-based testing framework like FsCheck or Hedgehog, but I chose instead to take my own medicine. In the kata description, I suggested some test cases, so I wanted to try and see if they made sense.

The entire code base is available on GitHub.

Boutique restaurant #

I wrote the first suggested test case this way:

[<Fact>]
let ``Boutique restaurant`` () =
    test <@ canAccept 12 [] { Quantity = 1 } @>

This uses Unquote's test function to verify that a Boolean expression is true. The expression is a function call to canAccept with the capacity 12, no existing reservations, and a reservation with Quantity = 1.

The simplest thing that could possibly work was this:

type Reservation = { Quantity : int }
 
let canAccept _ _ _ = true

The Reservation type was required to make the test compile, but the canAccept function didn't have to consider its arguments. It could simply return true.

Parametrisation #

The next test case made me turn the test function into a parametrised test:

[<Theory>]
[<InlineData( 1,  true)>]
[<InlineData(13, false)>]
let ``Boutique restaurant`` quantity expected =
    expected =! canAccept 12 [] { Quantity = quantity }

So far, the only test parameters were quantity and the expected result. I could no longer use test to verify the result of calling canAccept, since I added variation to the expected result. I changed test into Unquote's =! (must equal) operator.

The simplest passing implementation I could think of was:

let canAccept _ _ { Quantity = q } = q = 1

It ignored the capacity and instead checked whether q is 1. That passed both tests.

Test data API #

Before adding another test case, I decided to refactor my test code a bit. When working with a real domain model, you often have to furnish test data in order to make code compile - even if that data isn't relevant to the test. I wanted to demonstrate how to deal with this issue. My first step was to introduce an 'arbitrary' Reservation value in the spirit of Test data without Builders.

let aReservation = { Quantity = 1 }

This enabled me to rewrite the test:

[<Theory>]
[<InlineData( 1,  true)>]
[<InlineData(13, false)>]
let ``Boutique restaurant`` quantity expected =
    expected =! canAccept 12 [] { aReservation with Quantity = quantity }

This doesn't look like an immediate improvement, but it made it possible to make the Reservation record type more realistic without damage to the test:

type Reservation = {
    Date : DateTime
    Name : string
    Email : string
    Quantity : int }

I added some fields that a real-world reservation would have. The Quantity field will be useful later on, but the Name and Email fields are irrelevant in the context of the kata.

This is the type of API change that often gives people grief. To create a Reservation value, you must supply all four fields. This often adds noise to tests.

Not here, though, because the only concession I had to make was to change aReservation:

let aReservation =
    {
        Date = DateTime (2019, 11, 29, 12, 0, 0)
        Name = ""
        Email = ""
        Quantity = 1
    }

The test code remained unaltered.

With that in place, I could add the third test case:

[<Theory>]
[<InlineData( 1,  true)>]
[<InlineData(13, false)>]
[<InlineData(12,  true)>]
let ``Boutique restaurant`` quantity expected =
    expected =! canAccept 12 [] { aReservation with Quantity = quantity }

The simplest passing implementation I could think of was:

let canAccept _ _ { Quantity = q } = q <> 13

This implementation still ignored the restaurant's capacity and simply checked that q was different from 13. That was enough to pass all three tests.

Refactor test case code #

Adding the next suggested test case proved to be a problem. I wanted to write a single [<Theory>]-driven test function fed by all the Boutique restaurant test data. To do that, I'd have to supply arrays of test input, but unfortunately, that wasn't possible in F#.

Instead I decided to refactor the test case code to use ClassData-driven test cases.

type BoutiqueTestCases () as this =
    inherit TheoryData<int, bool> ()
    do this.Add ( 1,  true)
       this.Add (13, false)
       this.Add (12,  true)
 
[<Theory; ClassData(typeof<BoutiqueTestCases>)>]
let ``Boutique restaurant`` quantity expected =
    expected =! canAccept 12 [] { aReservation with Quantity = quantity }

These are the same test cases as before, but now expressed by a class inheriting from TheoryData<int, bool>. The implementing code remains the same.

Existing reservation #

The next suggested test case includes an existing reservation. To support that, I changed the test case base class to TheoryData<int, int list, int, bool>, and passed empty lists for the first three test cases. For the new, fourth test case, I supplied a number of seats.

type BoutiqueTestCases () as this =
    inherit TheoryData<int, int list, int, bool> ()
    do this.Add (12,  [],  1,  true)
       this.Add (12,  [], 13, false)
       this.Add (12,  [], 12,  true)
       this.Add ( 4, [2],  3, false)
 
[<Theory; ClassData(typeof<BoutiqueTestCases>)>]
let ``Boutique restaurant`` capacity reservatedSeats quantity expected =
    let rs = List.map (fun s -> { aReservation with Quantity = s }) reservatedSeats
    let actual = canAccept capacity rs { aReservation with Quantity = quantity }
    expected =! actual

This also forced me to to change the body of the test function. At this stage, it could be prettier, but it got the job done. I soon after improved it.

My implementation, as usual, was the simplest thing that could possibly work.

let canAccept _ reservations { Quantity = q } =
    q <> 13 && Seq.isEmpty reservations

Notice that although the fourth test case varied the capacity, I still managed to pass all tests without looking at it.

Accept despite existing reservation #

The next test case introduced another existing reservation, but this time with enough capacity to accept a new reservation.

type BoutiqueTestCases () as this =
    inherit TheoryData<int, int list, int, bool> ()
    do this.Add (12,  [],  1,  true)
       this.Add (12,  [], 13, false)
       this.Add (12,  [], 12,  true)
       this.Add ( 4, [2],  3, false)
       this.Add (10, [2],  3,  true)

The test function remained unchanged.

In the spirit of the Devil's advocate technique, I actively sought to avoid a correct implementation. I came up with this:

let canAccept capacity reservations { Quantity = q } =
    let reservedSeats =
        match Seq.tryHead reservations with
        | Some r -> r.Quantity
        | None -> 0
    reservedSeats + q <= capacity

Since all test cases supplied at most one existing reservation, it was enough to consider the first reservation, if present.

To many people, it may seem strange to actively seek out incorrect implementations like this. An incorrect implementation that passes all tests does, however, demonstrate the need for more tests.

The sum of all reservations #

I then added another test case, this time with three existing reservations:

type BoutiqueTestCases () as this =
    inherit TheoryData<int, int list, int, bool> ()
    do this.Add (12,      [],  1,  true)
       this.Add (12,      [], 13, false)
       this.Add (12,      [], 12,  true)
       this.Add ( 4,     [2],  3, false)
       this.Add (10,     [2],  3,  true)
       this.Add (10, [3;2;3],  3, false)

Again, I left the test function untouched.

On the side of the implementation, I couldn't think of more hoops to jump through, so I finally gave in and provided a 'proper' implementation:

let canAccept capacity reservations { Quantity = q } =
    let reservedSeats = Seq.sumBy (fun r -> r.Quantity) reservations
    reservedSeats + q <= capacity

Not only does it look simpler that before, but I also felt that the implementation was warranted.

“As the tests get more specific, the code gets more generic.”

Although I'd only tested canAccept with lists, I decided to implement it with Seq. This was a decision I later regretted.

Another date #

The last Boutique restaurant test case was to supply an existing reservation on another date. The canAccept function should only consider existing reservations on the date in question.

First, I decided to model the two separate dates as two values:

let d1 = DateTime (2023, 9, 14)
let d2 = DateTime (2023, 9, 15)

I hoped that it would make my test cases more readable, because the dates would have a denser representation.

type BoutiqueTestCases () as this =
    inherit TheoryData<int, (int * DateTime) list, (int * DateTime), bool> ()
    do this.Add (12,                        [], ( 1, d1),  true)
       this.Add (12,                        [], (13, d1), false)
       this.Add (12,                        [], (12, d1),  true)
       this.Add ( 4,                 [(2, d1)], ( 3, d1), false)
       this.Add (10,                 [(2, d1)], ( 3, d1),  true)
       this.Add (10, [(3, d1);(2, d1);(3, d1)], ( 3, d1), false)
       this.Add ( 4,                 [(2, d2)], ( 3, d1),  true)

I changed the representation of a reservation from just an int to a tuple of a number and a date. I also got tired of looking at that noisy unit test, so I introduced a test-specific helper function:

let reserve (q, d) = { aReservation with Quantity = q; Date = d }

Since it takes a tuple of a number and a date, I could use it to simplify the test function:

[<Theory; ClassData(typeof<BoutiqueTestCases>)>]
let ``Boutique restaurant`` (capacity, rs, r, expected) =
    let reservations = List.map reserve rs
    let actual = canAccept capacity reservations (reserve r)
    expected =! actual

The canAccept function now had to filter the reservations on Date:

let canAccept capacity reservations { Quantity = q; Date = d } =
    let relevantReservations = Seq.filter (fun r -> r.Date = d) reservations
    let reservedSeats = Seq.sumBy (fun r -> r.Quantity) relevantReservations
    reservedSeats + q <= capacity

This implementation specifically compared dates, though, so while it passed all tests, it'd behave incorrectly if the dates were as much as nanosecond off. That implied that another test case was required.

Same date, different time #

The final test case for the Boutique restaurant, then, was to use two DateTime values on the same date, but with different times.

type BoutiqueTestCases () as this =
    inherit TheoryData<int, (int * DateTime) list, (int * DateTime), bool> ()
    do this.Add (12,                        [], ( 1, d1            ),  true)
       this.Add (12,                        [], (13, d1            ), false)
       this.Add (12,                        [], (12, d1            ),  true)
       this.Add ( 4,                 [(2, d1)], ( 3, d1            ), false)
       this.Add (10,                 [(2, d1)], ( 3, d1            ),  true)
       this.Add (10, [(3, d1);(2, d1);(3, d1)], ( 3, d1            ), false)
       this.Add ( 4,                 [(2, d2)], ( 3, d1            ),  true)
       this.Add ( 4,                 [(2, d1)], ( 3, d1.AddHours 1.), false)

I just added a new test case as a new line and lined up the data. The test function, again, didn't change.

To address the new test case, I generalised the first filter.

let canAccept capacity reservations { Quantity = q; Date = d } =
    let relevantReservations = Seq.filter (fun r -> r.Date.Date = d.Date) reservations
    let reservedSeats = Seq.sumBy (fun r -> r.Quantity) relevantReservations
    reservedSeats + q <= capacity

An expression like r.Date.Date looks a little odd. DateTime values have a Date property that represents its date part. The first Date is the Reservation field, and the second is the date part.

I was now content with the Boutique restaurant implementation.

Haute cuisine #

In the next phase of the kata, I now had to deal with a configuration of more than one table, so I introduced a type:

type Table = { Seats : int }

It's really only a glorified wrapper around an int, but with a real domain model in place, I could make its constructor private and instead afford a smart constructor that only accepts positive integers.

I changed the canAccept function to take a list of tables, instead of capacity. This also required me to change the existing test function to take a singleton list of tables:

let actual = canAccept [table capacity] reservations (reserve r)

where table is a test-specific helper function:

let table s = { Seats = s }

I also added a new test function and a single test case:

let d3 = DateTime (2024, 6,  7)
 
type HauteCuisineTestCases () as this =
    inherit TheoryData<int list, (int * DateTime) list, (int * DateTime), bool> ()
    do this.Add ([2;2;4;4], [], (4, d3), true)
 
[<Theory; ClassData(typeof<HauteCuisineTestCases>)>]
let ``Haute cuisine`` (tableSeats, rs, r, expected) =
    let tables = List.map table tableSeats
    let reservations = List.map reserve rs
 
    let actual = canAccept tables reservations (reserve r)
 
    expected =! actual

The change to canAccept is modest:

let canAccept tables reservations { Quantity = q; Date = d } =
    let capacity = Seq.sumBy (fun t -> t.Seats) tables
    let relevantReservations =
        Seq.filter (fun r -> r.Date.Date = d.Date) reservations
    let reservedSeats = Seq.sumBy (fun r -> r.Quantity) relevantReservations
    reservedSeats + q <= capacity

It still works by looking at a total capacity as if there was just a single communal table. Now it just calculates capacity from the sequence of tables.

Reject reservation that doesn't fit largest table #

Then I added the next test case to the new test function:

type HauteCuisineTestCases () as this =
    inherit TheoryData<int list, (int * DateTime) list, (int * DateTime), bool> ()
    do this.Add ([2;2;4;4], [], (4, d3),  true)
       this.Add ([2;2;4;4], [], (5, d3), false)

This one attempts to make a reservation for five people. The largest table only fits four people, so this reservation should be rejected. The current implementation just considered the total capacity of all tables, to it accepted the reservation, and thereby failed the test.

This change to canAccept passes all tests:

let canAccept tables reservations { Quantity = q; Date = d } =
    let capacity = tables |> Seq.map (fun t -> t.Seats) |> Seq.max
    let relevantReservations =
        Seq.filter (fun r -> r.Date.Date = d.Date) reservations
    let reservedSeats = Seq.sumBy (fun r -> r.Quantity) relevantReservations
    reservedSeats + q <= capacity

The function now only considered the largest table in the restaurant. While it's incorrect to ignore all other tables, all tests passed.

Accept when there's still a remaining table #

Only considering the largest table is obviously wrong, so I added another test case where there's an existing reservation.

type HauteCuisineTestCases () as this =
    inherit TheoryData<int list, (int * DateTime) list, (int * DateTime), bool> ()
    do this.Add ([2;2;4;4],        [], (4, d3),  true)
       this.Add ([2;2;4;4],        [], (5, d3), false)
       this.Add (  [2;2;4], [(2, d3)], (4, d3),  true)

While canAccept should accept the reservation, it didn't when I added the test case. In a variation of the Devil's Advocate technique, I came up with this implementation to pass all tests:

let canAccept tables reservations { Quantity = q; Date = d } =
    let largestTable = tables |> Seq.map (fun t -> t.Seats) |> Seq.max
    let capacity = tables |> Seq.sumBy (fun t -> t.Seats)
    let relevantReservations =
        Seq.filter (fun r -> r.Date.Date = d.Date) reservations
    let reservedSeats = Seq.sumBy (fun r -> r.Quantity) relevantReservations
    q <= largestTable && reservedSeats + q <= capacity

This still wasn't the correct implementation. It represented a return to looking at the total capacity of all tables, with the extra rule that you couldn't make a reservation larger than the largest table. At least one more test case was needed.

Accept when remaining table is available #

I added another test case to the haute cuisine test cases. This one came with one existing reservation for three people, effectively reserving the four-person table. While the remaining tables have an aggregate capacity of four, it's two separate tables. Therefore, a reservation for four people should be rejected.

type HauteCuisineTestCases () as this =
    inherit TheoryData<int list, (int * DateTime) list, (int * DateTime), bool> ()
    do this.Add ([2;2;4;4],        [], (4, d3),  true)
       this.Add ([2;2;4;4],        [], (5, d3), false)
       this.Add (  [2;2;4], [(2, d3)], (4, d3),  true)
       this.Add (  [2;2;4], [(3, d3)], (4, d3), false)

It then dawned on me that I had to explicitly distinguish between a communal table configuration, and individual tables that aren't communal, regardless of size. This triggered quite a refactoring.

I defined a new type to distinguish between these two types of table layout:

type TableConfiguration = Communal of int | Tables of Table list

I also had to change the existing test functions, including the boutique restaurant test

[<Theory; ClassData(typeof<BoutiqueTestCases>)>]
let ``Boutique restaurant`` (capacity, rs, r, expected) =
    let reservations = List.map reserve rs
    let actual = canAccept (Communal capacity) reservations (reserve r)
    expected =! actual

and the haute cuisine test

[<Theory; ClassData(typeof<HauteCuisineTestCases>)>]
let ``Haute cuisine`` (tableSeats, rs, r, expected) =
    let tables = List.map table tableSeats
    let reservations = List.map reserve rs
 
    let actual = canAccept (Tables tables) reservations (reserve r)
 
    expected =! actual

In both cases I had to change the call to canAccept to pass either a Communal or a Tables value.

Delete first #

I'd previously done the kata in Haskell and was able to solve this phase of the kata using the built-in deleteFirstsBy function. This function doesn't exist in the F# core library, so I decided to add it. I created a new module named Seq and first defined a function that deletes the first element that satisfies a predicate:

// ('a -> bool) -> seq<'a> -> seq<'a>
let deleteFirstBy pred (xs : _ seq) = seq {
    let mutable found = false
    use e = xs.GetEnumerator ()
    while e.MoveNext () do
        if found
        then yield e.Current
        else if pred e.Current
            then found <- true
            else yield e.Current
    }

It moves over a sequence of elements and looks for an element that satisfies pred. If such an element is found, it's omitted from the output sequence. The function only deletes the first occurrence from the sequence, so any other elements that satisfy the predicate are still included.

This function corresponds to Haskell's deleteBy function and can be used to implement deleteFirstsBy:

// ('a -> 'b -> bool) -> seq<'b> -> seq<'a> -> seq<'b>
let deleteFirstsBy pred = Seq.fold (fun xs x -> deleteFirstBy (pred x) xs)

As the Haskell documentation explains, the "deleteFirstsBy function takes a predicate and two lists and returns the first list with the first occurrence of each element of the second list removed." My F# function does the same, but works on sequences instead of linked lists.

I could use it to find and remove tables that were already reserved.

Find remaining tables #

I first defined a little helper function to determine whether a table can accommodate a reservation:

// Reservation -> Table -> bool
let private fits r t = r.Quantity <= t.Seats

The rule is simply that the table's number of Seats must be greater than or equal to the reservation's Quantity. I could use this function for the predicate for Seq.deleteFirstsBy:

let canAccept config reservations ({ Quantity = q; Date = d } as r) =
    let contemporaneousReservations =
        Seq.filter (fun r -> r.Date.Date = d.Date) reservations
    match config with
    | Communal capacity ->
        let reservedSeats =
            Seq.sumBy (fun r -> r.Quantity) contemporaneousReservations
        reservedSeats + q <= capacity
    | Tables tables ->
        let rs = Seq.sort contemporaneousReservations
        let remainingTables = Seq.deleteFirstsBy fits (Seq.sort tables) rs
        Seq.exists (fits r) remainingTables

The canAccept function now branched on Communal versus Tables configurations. In the Communal configuration, it simply compared the reservedSeats and reservation quantity to the communal table's capacity.

In the Tables case, the function used Seq.deleteFirstsBy fits to remove all the tables that are already reserved. The result is the remainingTables. If there exists a remaining table that fits the reservation, then the function accepts the reservation.

This seemed to me an appropriate implementation of the haute cuisine phase of the kata.

Second seatings #

Now it was time to take seating duration into account. While I could have written my test cases directly against the TimeSpan API, I didn't want to write TimeSpan.FromHours 2.5, TimeSpan.FromDays 1., and so on. I found that it made my test cases harder to read, so I added some literal extensions:

type Int32 with
    member x.hours = TimeSpan.FromHours (float x)
    member x.days = TimeSpan.FromDays (float x)

This enabled me to write expressions like 1 .days and 2 .hours, as shown in the first test case:

let d4 = DateTime (2023, 10, 22, 18, 0, 0)
 
type SecondSeatingsTestCases () as this =
    inherit TheoryData<TimeSpan, int list, (int * DateTime) list, (int * DateTime), bool> ()
    do this.Add (2 .hours, [2;2;4], [(4, d4)], (3, d4.Add (2 .hours)), true)

I used this initial parametrised test case for a new test function:

[<Theory; ClassData(typeof<SecondSeatingsTestCases>)>]
let ``Second seatings`` (dur, tableSeats, rs, r, expected) =
    let tables = List.map table tableSeats
    let reservations = List.map reserve rs
 
    let actual = canAccept dur (Tables tables) reservations (reserve r)
 
    expected =! actual

My motivation for this test case was mostly to introduce an API change to canAccept. I didn't want to rock the boat too much, so I picked a test case that wouldn't trigger a big change to the implementation. I prefer incremental changes. The only change is the introduction of the seatingDur argument:

let canAccept (seatingDur : TimeSpan) config reservations ({ Date = d } as r) =
    let contemporaneousReservations =
        Seq.filter (fun x -> x.Date.Subtract seatingDur < d.Date) reservations
    match config with
    | Communal capacity ->
        let reservedSeats =
            Seq.sumBy (fun r -> r.Quantity) contemporaneousReservations
        reservedSeats + r.Quantity <= capacity
    | Tables tables ->
        let rs = Seq.sort contemporaneousReservations
        let remainingTables = Seq.deleteFirstsBy fits (Seq.sort tables) rs
        Seq.exists (fits r) remainingTables

While the function already considered seatingDur, the way it filtered reservation wasn't entirely correct. It passed all tests, though.

Filter reservations based on seating duration #

The next test case I added made me write what I consider the right implementation, but I subsequently decided to add two more test cases just for confidence. Here's all of them:

type SecondSeatingsTestCases () as this =
    inherit TheoryData<TimeSpan, int list, (int * DateTime) list, (int * DateTime), bool> ()
    do this.Add (
        2 .hours,
        [2;2;4],
        [(4, d4)],
        (3, d4.Add (2 .hours)),
        true)
       this.Add (
        2.5 .hours,
        [2;4;4],
        [(2, d4);(1, d4.AddMinutes 15.);(2, d4.Subtract (15 .minutes))],
        (3, d4.AddHours 2.),
        false)
       this.Add (
        2.5 .hours,
        [2;4;4],
        [(2, d4);(2, d4.Subtract (15 .minutes))],
        (3, d4.AddHours 2.),
        true)
       this.Add (
        2.5 .hours,
        [2;4;4],
        [(2, d4);(1, d4.AddMinutes 15.);(2, d4.Subtract (15 .minutes))],
        (3, d4.AddHours 2.25),
        true)

The new test cases use some more literal extensions:

type Int32 with
    member x.minutes = TimeSpan.FromMinutes (float x)
    member x.hours = TimeSpan.FromHours (float x)
    member x.days = TimeSpan.FromDays (float x)
 
type Double with
    member x.hours = TimeSpan.FromHours x

I added a private isContemporaneous function to the code base and used it to filter the reservation to pass the tests:

let private isContemporaneous
    (seatingDur : TimeSpan)
    (candidate : Reservation)
    (existing : Reservation) =
    let aSeatingBefore = candidate.Date.Subtract seatingDur
    let aSeatingAfter = candidate.Date.Add seatingDur
    aSeatingBefore < existing.Date && existing.Date < aSeatingAfter
 
let canAccept (seatingDur : TimeSpan) config reservations r =
    let contemporaneousReservations =
        Seq.filter (isContemporaneous seatingDur r) reservations
    match config with
    | Communal capacity ->
        let reservedSeats =
            Seq.sumBy (fun r -> r.Quantity) contemporaneousReservations
        reservedSeats + r.Quantity <= capacity
    | Tables tables ->
        let rs = Seq.sort contemporaneousReservations
        let remainingTables = Seq.deleteFirstsBy fits (Seq.sort tables) rs
        Seq.exists (fits r) remainingTables

I could have left the functionality of isContemporaneous inside of canAccept, but I found it just hard enough to get my head around that I preferred to put it in a named helper function. Checking that a value is in a range is in itself trivial, but for some reason, figuring out the limits of the range didn't come naturally to me.

This version of canAccept only considered existing reservations if they in any way overlapped with the reservation in question. It passed all tests. It also seemed to me to be a satisfactory implementation of the second seatings scenario.

Alternative table configurations #

This state of the kata introduces groups of tables that can be reserved individually, or combined. To support that, I changed the definition of Table:

type Table = Discrete of int | Group of int list

A Table is now either a Discrete table that can't be combined, or a Group of tables that can either be reserved individually, or combined.

I had to change the test-specific table function to behave like before.

let table s = Discrete s

Before this change to the Table type, all tables were implicitly Discrete tables.

This enabled me to add the first test case:

type AlternativeTableConfigurationTestCases () as this =
    inherit TheoryData<Table list, int list, int, bool> ()
    do this.Add (
        [Discrete 4; Discrete 1; Discrete 2; Group [2;2;2]],
        [3;1;2],
        2,
        true)
 
[<Theory; ClassData(typeof<AlternativeTableConfigurationTestCases>)>]
let ``Alternative table configurations`` (tables, rs, r, expected) =
    let res i = reserve (i, d4)
    let reservations = List.map res rs
 
    let actual = canAccept (1 .days) (Tables tables) reservations (res r)
 
    expected =! actual

Like I did when I introduced the seatingDur argument, I deliberately chose a test case that didn't otherwise rock the boat too much. The same was the case now, so the only other change I had to make to pass all tests was to adjust the fits function:

// Reservation -> Table -> bool
let private fits r = function
    | Discrete seats -> r.Quantity <= seats
    | Group _ -> true

It's clearly not correct to return true for any Group, but it passed all tests.

Accept based on sum of table group #

I wanted to edge a little closer to correctly handling the Group case, so I added a test case:

type AlternativeTableConfigurationTestCases () as this =
    inherit TheoryData<Table list, int list, int, bool> ()
    do this.Add (
        [Discrete 4; Discrete 1; Discrete 2; Group [2;2;2]],
        [3;1;2],
        2,
        true)
       this.Add (
        [Discrete 4; Discrete 1; Discrete 2; Group [2;2;2]],
        [3;1;2],
        7,
        false)

A restaurant with this table configuration can't accept a reservation for seven people, but because fits returned true for any Group, canAccept would return true. Since the test expected the result to be false, this caused the test to fail.

Edging closer to correct behaviour, I adjusted fits again:

// Reservation -> Table -> bool
let private fits r = function
    | Discrete seats -> r.Quantity <= seats
    | Group tables -> r.Quantity <= List.sum tables

This was still not correct, because it removed an entire group of tables when fits returned true, but it passed all tests so far.

Accept reservation by combining two tables #

I added another failing test:

type AlternativeTableConfigurationTestCases () as this =
    inherit TheoryData<Table list, int list, int, bool> ()
    do this.Add (
        [Discrete 4; Discrete 1; Discrete 2; Group [2;2;2]],
        [3;1;2],
        2,
        true)
       this.Add (
        [Discrete 4; Discrete 1; Discrete 2; Group [2;2;2]],
        [3;1;2],
        7,
        false)
       this.Add (
        [Discrete 4; Discrete 1; Discrete 2; Group [2;2;2]],
        [3;1;2;1],
        4,
        true)

The last test case failed because the existing reservations should only have reserved one of the tables in the group, but because of the way fits worked, the entire group was deleted by Seq.deleteFirstsBy fits. This made canAccept reject the four-person reservation.

To be honest, this step was difficult for me. I should probably have found out how to make a smaller step.

I wanted a function that would compare a Reservation to a Table, but unlike Fits return None if it decided to 'use' the table, or a Some value if it decided that it didn't need to use the entire table. This would enable me to pick only some of the tables from a Group, but still return a Some value with the rest of tables.

I couldn't figure out an elegant way to do this with the existing Seq functionality, so I started to play around with something more specific. The implementation came accidentally as I was struggling to come up with something more general. As I was experimenting, all of a sudden, all tests passed!

// Reservation -> Table -> Table option
let private allot r = function
    | Discrete seats ->
        if r.Quantity <= seats
        then None
        else Some (Discrete seats)
    | Group tables -> Some (Group tables)
 
// seq<Table> -> Reservation -> seq<Table>
let private allocate (tables : Table seq) r = seq {
    let mutable found = false
    use e = tables.GetEnumerator ()
    while e.MoveNext () do
        if found
        then yield e.Current
        else
            match allot r e.Current with
            | None ->
                found <- true
            | Some t -> yield t
    }
 
let canAccept (seatingDur : TimeSpan) config reservations r =
    let contemporaneousReservations =
        Seq.filter (isContemporaneous seatingDur r) reservations
    match config with
    | Communal capacity ->
        let reservedSeats =
            Seq.sumBy (fun r -> r.Quantity) contemporaneousReservations
        reservedSeats + r.Quantity <= capacity
    | Tables tables ->
        let rs = Seq.sort contemporaneousReservations
        let remainingTables = Seq.fold allocate (Seq.sort tables) rs
        Seq.exists (fits r) remainingTables

I wasn't too happy with the implementation, which I found (and still find) too complicated. This was, however, the first time I've done this part of the kata (in any language), so I wasn't sure where this was going.

The allocate function finds and allocates one of its input tables to a reservation. It does that by not yielding the first table it finds that can accommodate the reservation. Don't hurt your head too much with the code in this version, because there's plenty of cases that it incorrectly handles. It's full of bugs. Still, it passed all tests.

Reject when group has been reduced #

The implementation was wrong because the allot function would just keep returning a Group without consuming it. This would imply that canAccept would use it more than once, which was wrong, so I added a test case:

type AlternativeTableConfigurationTestCases () as this =
    inherit TheoryData<Table list, int list, int, bool> ()
    do this.Add (
        [Discrete 4; Discrete 1; Discrete 2; Group [2;2;2]],
        [3;1;2],
        2,
        true)
       this.Add (
        [Discrete 4; Discrete 1; Discrete 2; Group [2;2;2]],
        [3;1;2],
        7,
        false)
       this.Add (
        [Discrete 4; Discrete 1; Discrete 2; Group [2;2;2]],
        [3;1;2;1],
        4,
        true)
       this.Add (
        [Discrete 4; Discrete 1; Discrete 2; Group [2;2;2]],
        [3;1;2;1;4],
        3,
        false)

Given the existing reservations, this restaurant is effectively sold out that day. All the Discrete tables are reserved, and the last two reservations for one and four effectively consumes the Group. The latest test case expected canAccept to return false, but it returned true. Since I was following test-driven development, I expected that.

Consume #

I needed a function that would consume from a Group of tables and return the remaining tables from that group; that is, the tables not consumed. I've already discussed this function in a different context.

// int -> seq<int> -> seq<int>
let consume quantity =
    let go (acc, xs) x =
        if quantity <= acc
        then (acc, Seq.append xs (Seq.singleton x))
        else (acc + x, xs)
    Seq.fold go (0, Seq.empty) >> snd

I put this function in my own Seq module. It consumes values from the left until the sum is greater than or equal to the desired quantity. It then returns the rest of the sequence:

> consume 1 [1;2;3];;
val it : seq<int> = seq [2; 3]

> consume 2 [1;2;3];;
val it : seq<int> = seq [3]

> consume 3 [1;2;3];;
val it : seq<int> = seq [3]

> consume 4 [1;2;3];;
val it : seq<int> = seq []

The first example consumes only the leading 1, while both the second and the third example consumes both 1 and 2 because the sum of those values is 3, and the requested quantity is 2 and 3, respectively. The fourth example consumes all elements because the requested quantity is 4, and you need both 1, 2, and 3 before the sum is large enough. You have to pick strictly from the left, so you can't decide to just take the elements 1 and 3.

Consuming tables from a group #

I could now use my Seq.consume function to improve allot:

// Reservation -> Table -> Table option
let private allot r = function
    | Discrete seats ->
        if r.Quantity <= seats
        then None
        else Some (Discrete seats)
    | Group tables ->
        tables |> Seq.consume r.Quantity |> Seq.toList |> Group |> Some

It handles the Group case by consuming the reservation Quantity and then returning a Some Group with the remaining tables.

It also turned out that sorting the reservations wasn't appropriate, mainly because it's not entirely clear how to sort a list with elements of a discriminated union. My final implementation of canAccept was this:

// TimeSpan -> TableConfiguration -> seq<Reservation> -> Reservation -> bool
let canAccept seatingDur config reservations r =
    let contemporaneousReservations =
        Seq.filter (isContemporaneous seatingDur r) reservations
    match config with
    | Communal capacity ->
        let reservedSeats =
            Seq.sumBy (fun r -> r.Quantity) contemporaneousReservations
        reservedSeats + r.Quantity <= capacity
    | Tables tables ->
        let remainingTables =
            Seq.fold allocate (Seq.ofList tables) contemporaneousReservations
        Seq.exists (fits r) remainingTables

Nothing much has changed - only that neither reservations nor tables are now sorted. It passes all tests.

Retrospective #

I must admit that I ran out of steam towards the end. It's possible that there's some edge cases I didn't think of. I'd probably feel more confident of the final implementation if I'd used property-based testing instead of Example-Guided Development.

I also took some unfortunate turns along the way. Early in the kata, I could easily implement canAccept with functionality from the Seq module. This meant that the function could take a seq<Reservation> as an input argument. I'm always inclined to follow Postel's law and be liberal with what I accept. I thought that being able to accept any seq<Reservation> was a good design decision. It might have been if I'd been publishing a reusable library, but it made things more awkward.

I'm also not sure that I chose to model the table layouts in the best way. For example, I currently can't handle a scenario with both bar seating and individual tables. I think I should have made Communal a case of Table. This would have enabled me to model layouts with several communal tables combined with discrete tables, and even groups of tables.

In general, my solution seems too complicated, but I don't see an easy fix. Often, if I work some more with the problem, insight arrives. It usually arrives when you least need it, so I thought it better to let the problem rest for a while. I can always return to it when I feel that I have a fresh approach.

Summary #

This article walks you through my first F# attempt at the Maître d' kata. The repository is available on GitHub.

I'm not entirely happy with how it turned out, but I don't consider it an utter failure either.


Comments

Ghillie Dhu #

You could leverage library functions and avoid mutability like so:

// ('a -> bool) -> seq<'a> -> seq<'a>
let deleteFirstBy pred (xs : _ seq) =
    match Seq.tryFindIndex pred xs with
    | None -> xs
    | Some n -> Seq.concat (Seq.take (n-1) xs) (Seq.skip n xs)

2020-04-28 19:02 UTC

Ghillie, thank you for writing. It looks like you're on the right track, but I think you have to write the function like this:

let deleteFirstBy pred (xs : _ seq) =
    match Seq.tryFindIndex pred xs with
    | None -> xs
    | Some n -> Seq.append (Seq.take (n-1) xs) (Seq.skip n xs)

2020-04-28 19:21 UTC


Wish to comment?

You can add a comment to this post by sending me a pull request. Alternatively, you can discuss this post on Twitter or somewhere else with a permalink. Ping me with the link, and I may respond.

Published

Monday, 27 April 2020 14:41:00 UTC

Tags



"Our team wholeheartedly endorses Mark. His expert service provides tremendous value."
Hire me!
Published: Monday, 27 April 2020 14:41:00 UTC