No Free Monad for old men

Update!

Clarifications from Seemann et al. showed me that Free Monads are used not just for keeping code pure but also as the equivalent of an interface in OOP. For that reason I added a mechanism for dependency injection.

What is better than Free Monad? Async Monad!

I have been reading with great interest a series of posts by Mark Seemann about dependency injection (and 'rejection') using F#. His very pedagogical style together with the fact that he, like me, has gone from OOP to FP made it especially relevant and eye-opening for me. In those posts, he uses the Free Monad as a functional alternative for dependency injection. They are a must read:

Seemann's posts work with very didactic examples of a restaurant reservation study case. I wanted to write my own take on the same study case basically copying his code and rewriting it in my own style and doing some variations to help me understand it better.

I myself had analyzed the Free Monad before in another post. That post, very much like this one, was intended mainly for my own consumption. In it, I concluded that two types: the DSL Functor and the Free Monad could be fused into one, thus reducing boilerplate. I wanted to try the same approach with Seamann's case study where he combines two Free Monads (by stacking them and/or adding them as suggested by a commenter) to see if my conclusion still held true.

A funny thing happened.

I could not finish. As is logical, my mock HTTP Client functions return Async<> and so I wrote my interpreter with type ReservationsApi<'a> -> Async<'a>.

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8:

// interpreterReservationsApi: ReservationsApi<'a> -> Async<'a>
let rec interpreterReservationsApi resApi = 
    match resApi with
    | ReturnRA         x         -> async { return x }
    | GetSlots        (d, fNext) -> async { let!     slots = getSlotsHttp d 
                                            return!  fNext slots |> interpreterReservationsApi }
    | PostReservation (r,  next) -> async { do!       postReservationHttp r
                                            return!   next       |> interpreterReservationsApi }

The interpreter was going from a Monad to another Monad. Hmmm! That led me to the realization that the interpreter written that way was a pure function because all the functions it was calling were also pure. Those functions return Async<> values, which makes them pure too. That made me question the whole exercise. In order to make the code pure, all I needed to do was wrap the impure functions with Async<>. What could be easier?

No DSL, no Free Monad, no builder types, no interpreters were needed. Async.RunSynchronously was the interpreter.

So I rewrote the exercise using Asyncs instead:

1.- Command-line wizard:

Taken from here.

The console api functions are defined in a module with a dummy definition, but they are mutable:

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8:

module CliInjection =
    let mutable private       readLine  : unit   -> string = fun () -> ""
    let mutable private       writeLine : string -> unit   = ignore
    let inject(read, write) = readLine  <- read
                              writeLine <- write

    let WriteLine s         = async {        writeLine s  }
    let ReadLine            = async { return readLine  () }

The inject function provides the mechanism for injecting the implementation. The public functions WriteLine ReadLine use the Async<> monad to make them pure.

Some derived Console API functions

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16:

let rec promptFor test prompt reject = async {
    do!         CliInjection.WriteLine prompt
    let!   v =  CliInjection.ReadLine
    match  v |> test with
    | Some r -> return  r
    | None   -> do!     CliInjection.WriteLine             reject
                return! promptFor test prompt reject
}

type Net.Mail.MailAddress with
    static member TryParse s = try Net.Mail.MailAddress s |> Some with e -> None

let promptForString = promptFor (fun (s:string) ->  s.Trim()   |> function ""      -> None   | r -> Some r)
let promptForEMail  = promptFor (Net.Mail.MailAddress.TryParse                                            )
let promptForNumber = promptFor (Int32               .TryParse >> function true, r -> Some r | _ -> None  )
let promptForDate   = promptFor (DateTime            .TryParse >> function true, r -> Some r | _ -> None  )

The reservation record:

1: 
2: 
3: 
4: 
5: 
6:

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

A wizard to read the reservation:

1: 
2: 
3: 
4: 
5: 
6: 
7:

let readReservationRequest = async {
    let! count = promptForNumber "Please enter number of diners:"   "Not a valid integer."
    let! date  = promptForDate   "Please enter your desired date:"  "Not a valid date."
    let! name  = promptForString "Please enter your name:"          "Not a valid name."
    let! email = promptForEMail  "Please enter your email address:" "Not a valid email."
    return { Date = date; Name = name; Email = email.Address; Quantity = count } 
  }

To execute the monad we inject the desired implementation and call Async.RunSynchronously

1: 
2: 
3: 
4: 
5:

let getReservation cli =
    CliInjection.inject cli
    readReservationRequest
    |> Async.RunSynchronously
    |> printfn "%A"

Now lets define a MockConsole for testing:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25:

module MockConsole =
    let readLines (txt:string) = 
        let current = txt.Split '\n' |> Array.map (fun s -> s.Trim()) |> Array.filter ((<>)"") |> ref
        fun () ->
            let head = Array.head !current
            current := (!current).[1..]
            printfn "%s" head
            head
    let input1 = "
        x
        5
        x
        11/11/11
        Abe
        x
        amieres@b.c
    "
    let input2 = "
        15
        12/31/1911
        Schroedinger's cat
        Schroedinger@dead.alive
    "
    let toInject1() = (readLines input1, printfn "%s"   )
    let toInject2() = (readLines input2, printfn ":: %s")

We run it passing the functions to be injected:

1:	`getReservation <\| MockConsole.toInject1()`

Please enter number of diners:
x
Not a valid integer.
Please enter number of diners:
5
Please enter your desired date:
x
Not a valid date.
Please enter your desired date:
11/11/11
Please enter your name:
Abe
Please enter your email address:
x
Not a valid email.
Please enter your email address:
amieres@b.c
{Date = 11/11/2011 12:00:00 AM;
 Name = "Abe";
 Email = "amieres@b.c";
 Quantity = 5;}

Another run with different functions. Notice the difference in the WriteLine output between the 2 outputs:

1:	`getReservation <\| MockConsole.toInject2()`

:: Please enter number of diners:
15
:: Please enter your desired date:
12/31/1911
:: Please enter your name:
Schroedinger's cat
:: Please enter your email address:
Schroedinger@dead.alive
{Date = 12/31/1911 12:00:00 AM;
 Name = "Schroedinger's cat";
 Email = "Schroedinger@dead.alive";
 Quantity = 15;}

To call it with the actual Console implementation:

1:	`let getReservationConsole() = getReservation <\| (Console.ReadLine, Console.WriteLine)`

2.- HTTP API client module

Taken from here.

The Slot type:

1:	`type Slot = { Date : DateTime; SeatsLeft : int }`

Lets define the api injection module this way, following the same recipe as above. The only difference is that we already expect the functions to return Async<>:

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9:

module ResApiInjection =
    let mutable private     getSlots       : DateTime    -> Async<Slot list> = fun _ -> async { return [] }
    let mutable private     postReservation: Reservation -> Async<unit>      = fun _ -> async { ()        }
    let inject(get, post) = getSlots        <- get
                            postReservation <- post
    
    let GetSlots        date = getSlots        date
    let PostReservation res  = postReservation res

A reservation wizard that queries the HTTP server and makes the reservation.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17:

let tryReserve          = async {
    let! count          = promptForNumber "Please enter number of diners:"   "Not a valid integer."
    let! date           = promptForDate   "Please enter your desired date:"  "Not a valid date."
    let! slots          = ResApiInjection.GetSlots date
    let  availableSeats = slots |> List.sumBy (fun slot -> slot.SeatsLeft)
    if availableSeats   < count
    then do! sprintf "****************    
Only %i remaining seats.
****************" availableSeats  |> CliInjection.WriteLine
    else let! name      = promptForString "Please enter your name:"          "Not a valid name."
         let! email     = promptForEMail  "Please enter your email address:" "Not a valid email."
         do! { Date     = date; Name = name; Email = email.Address; Quantity = count } 
                                  |> ResApiInjection.PostReservation
         do! sprintf "****************
%s party of %d, reserved for %A.
****************" name count date |> CliInjection.WriteLine
    }

To run it we pass both the Console api and the reservations api:

1: 
2: 
3: 
4: 
5:

let reserve cli resApi = 
    CliInjection   .inject cli
    ResApiInjection.inject resApi
    tryReserve 
    |> Async.RunSynchronously

Here is an implementation for the Reservations api that returns a random number of available seats:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11:

module RandomResApi =
    let random = lazy (System.Random DateTime.Now.Millisecond)
    
    let getSlotsHttp         date             = async { 
        do! Async.Sleep 1000
        return [ { Date = date ; SeatsLeft = random.Force().Next(20) } ] 
      }
    let postReservationHttp (res:Reservation) = async { 
        do! Async.Sleep 1500
      }
    let toInject() = (getSlotsHttp, postReservationHttp)

We call reserve passing both apis

1:	`reserve <\| MockConsole.toInject2() <\| RandomResApi.toInject()`

:: Please enter number of diners:
15
:: Please enter your desired date:
12/31/1911
:: ****************    
Only 6 remaining seats.
****************

As its name indicates the output is random.

For testing we can have another version with a fixed number of available seats:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12:

module MockReservationAPI =
    let mutable available = 18

    let getSlotsHttp         date             = async { 
        do! Async.Sleep 1000
        return [ { Date = date ; SeatsLeft = available } ] 
      }
    let postReservationHttp (res:Reservation) = async { 
        do! Async.Sleep 1500
        available <- available - res.Quantity 
      }
    let toInject() = (getSlotsHttp, postReservationHttp)

1:	`reserve <\| MockConsole.toInject2() <\| MockReservationAPI.toInject()`

:: Please enter number of diners:
15
:: Please enter your desired date:
12/31/1911
:: Please enter your name:
Schroedinger's cat
:: Please enter your email address:
Schroedinger@dead.alive
:: ****************
Schroedinger's cat party of 15, reserved for 12/31/1911 12:00:00 AM.
****************

Since originally there were 18 seats, reservation for 5 more will fail:

1:	`reserve <\| MockConsole.toInject1() <\| MockReservationAPI.toInject()`

Please enter number of diners:
x
Not a valid integer.
Please enter number of diners:
5
Please enter your desired date:
x
Not a valid date.
Please enter your desired date:
11/11/11
****************    
Only 3 remaining seats.
****************

Using async we accomplish the same objective and avoid a lot of boilerplate. True, this does not follow the DSL-interpreter pattern typical of the Free Monad and there may be other uses that are possible with the Free Monad, but this solution allows dependency injection, separation of pure and impure code, separation of concerns and composition, all in a very clean and powerful way.

Using the async Computational Expression has the added advantage of already having strong implementations for:

try-finally
try-with
use and use!
while
for

... and other computational expressions features that are not easy to implement and/or new ones that may be added in the future.

Journal