ploeh blog danish software design
Combining free monads in Haskell
An example on how to compose free monads in Haskell.
In the previous article in this series on pure interactions, you saw how to write a command-line wizard in F#, using a free monad to build an Abstract Syntax Tree (AST). The example collects information about a potential restaurant reservations you'd like to make. That example, however, didn't do more than that.
For a more complete experience, you'd like your command-line interface (CLI) to not only collect data about a reservation, but actually make the reservation, using the available HTTP API. This means that you'll also need to model interaction with the HTTP API as an AST, but a different AST. Then, you'll have to figure out how to compose these two APIs into a combined API.
In order to figure out how to do this in F#, I first had to do it in Haskell. In this article, you'll see how to do it in Haskell, and in the next article, you'll see how to translate this Haskell prototype to F#. This should ensure that you get a functional F# code base as well.
Command line API #
Let's make an easy start of it. In a previous article, you saw how to model command-line interactions as ASTs, complete with syntactic sugar provided by a computation expression. That took a fair amount of boilerplate code in F#, but in Haskell, it's declarative:
import Control.Monad.Trans.Free (Free, liftF) data CommandLineInstruction next = ReadLine (String -> next) | WriteLine String next deriving (Functor) type CommandLineProgram = Free CommandLineInstruction readLine :: CommandLineProgram String readLine = liftF (ReadLine id) writeLine :: String -> CommandLineProgram () writeLine s = liftF (WriteLine s ())
This is all the code required to define your AST and make it a monad in Haskell. Contrast that with all the code you have to write in F#!
The CommandLineInstruction type defines the instruction set, and makes use of a language extension called DeriveFunctor, which enables Haskell to automatically create a Functor instance from the type.
The type alias type CommandLineProgram = Free CommandLineInstruction creates a monad from CommandLineInstruction, since Free is a Monad when the underlying type is a Functor.
The readLine value and writeLine function are conveniences that lift the instructions from CommandLineInstruction into CommandLineProgram values. These were also one-liners in F#.
HTTP client API #
You can write a small wizard to collect restaurant reservation data with the CommandLineProgram API, but the new requirement is to make HTTP calls so that the CLI program actually makes the reservation against the back-end system. You could extend CommandLineProgram with more instructions, but that would be to mix concerns. It'd be more appropriate to define a new instruction set for making the required HTTP requests.
This API will send and receive more complex values than simple String values, so you can start by defining their types:
data Slot = Slot { slotDate :: ZonedTime, seatsLeft :: Int } deriving (Show) data Reservation = Reservation { reservationDate :: ZonedTime , reservationName :: String , reservationEmail :: String , reservationQuantity :: Int } deriving (Show)
The Slot type contains information about how many available seats are left on a particular date. The Reservation type contains the information required in order to make a reservation. It's similar to the Reservation F# record type you saw in the previous article.
The online restaurant reservation HTTP API may afford more functionality than you need, but there's no reason to model more instructions than required:
data ReservationsApiInstruction next = GetSlots ZonedTime ([Slot] -> next) | PostReservation Reservation next deriving (Functor)
This instruction set models two interactions. The GetSlots case models an instruction to request, from the HTTP API, the slots for a particular date. The PostReservation case models an instruction to make a POST HTTP request with a Reservation, thereby making a reservation.
Like the above CommandLineInstruction, this type is (automatically) a Functor, which means that we can create a Monad from it:
type ReservationsApiProgram = Free ReservationsApiInstruction
Once again, the monad is nothing but a type alias.
Finally, you're going to need the usual lifts:
getSlots :: ZonedTime -> ReservationsApiProgram [Slot] getSlots d = liftF (GetSlots d id) postReservation :: Reservation -> ReservationsApiProgram () postReservation r = liftF (PostReservation r ())
This is all you need to write a wizard that interleaves CommandLineProgram and ReservationsApiProgram instructions in order to create a more complex AST.
Wizard #
The wizard should do the following:
- Collect the number of diners, and the date for the reservation.
- Query the HTTP API about availability for the requested date. If insufficient seats are available, it should exit.
- If sufficient capacity remains, collect name and email.
- Make the reservation against the HTTP API.
readParse :: Read a => String -> String -> CommandLineProgram a readParse prompt errorMessage = do writeLine prompt l <- readLine case readMaybe l of Just dt -> return dt Nothing -> do writeLine errorMessage readParse prompt errorMessage
It first uses writeLine to write prompt to the command line - or rather, it creates an instruction to do so. The instruction is a pure value. No side-effects are involved until an interpreter evaluates the AST.
The next line uses readLine to read the user's input. While readLine is a CommandLineProgram String value, due to Haskell's do notation, l is a String value. You can now attempt to parse that String value with readMaybe, which returns a Maybe a value that you can handle with pattern matching. If readMaybe returns a Just value, then return the contained value; otherwise, write errorMessage and recursively call readParse again.
Like in the previous F# example, the only way to continue is to write something that readMaybe can parse. There's no other way to exit; there probably should be an option to quit, but it's not important for this demo purpose.
You may also have noticed that, contrary to the previous F# example, I here succumbed to the temptation to break the rule of three. It's easier to define a reusable function in Haskell, because you can leave it generic, with the proviso that the generic value must be an instance of the Read typeclass.
The readParse function returns a CommandLineProgram a value. It doesn't combine CommandLineProgram with ReservationsApiProgram. That's going to happen in another function, but before we look at that, you're also going to need another little helper:
readAnything :: String -> CommandLineProgram String readAnything prompt = do writeLine prompt readLine
The readAnything function simply writes a prompt, reads the user's input, and unconditionally returns it. You could also have written it as a one-liner like readAnything prompt = writeLine prompt >> readLine, but I find the above code more readable, even though it's slightly more verbose.
That's all you need to write the wizard:
tryReserve :: FreeT ReservationsApiProgram CommandLineProgram () tryReserve = do q <- lift $ readParse "Please enter number of diners:" "Not an Integer." d <- lift $ readParse "Please enter your desired date:" "Not a date." availableSeats <- liftF $ (sum . fmap seatsLeft) <$> getSlots d if availableSeats < q then lift $ writeLine $ "Only " ++ show availableSeats ++ " remaining seats." else do n <- lift $ readAnything "Please enter your name:" e <- lift $ readAnything "Please enter your email address:" liftF $ postReservation Reservation { reservationDate = d , reservationName = n , reservationEmail = e , reservationQuantity = q }
The tryReserve program first prompt the user for a number of diners and a date. Once it has the date d, it calls getSlots and calculates the sum of the remaining seats. availableSeats is an Int value like q, so you can compare those two values with each other. If the number of available seats is less than the desired quantity, the program writes that and exits.
This interaction demonstrates how to interleave CommandLineProgram and ReservationsApiProgram instructions. It would be a bad user experience if the program would ask the user to input all information, and only then discover that there's insufficient capacity.
If, on the other hand, there's enough remaining capacity, the program continues collecting information from the user, by prompting for the user's name and email address. Once all data is collected, it creates a new Reservation value and invokes postReservation.
Consider the type of tryReserve. It's a combination of CommandLineProgram and ReservationsApiProgram, contained within a type called FreeT. This type is also a Monad, which is the reason the do notation still works. This also begins to explain the various lift and liftF calls sprinkled over the code.
Whenever you use a <- arrow to 'pull the value out of the monad' within a do block, the right-hand side of the arrow must have the same type as the return type of the overall function (or value). In this case, the return type is FreeT ReservationsApiProgram CommandLineProgram (), whereas readParse returns a CommandLineProgram a value. As an example, lift turns CommandLineProgram Int into FreeT ReservationsApiProgram CommandLineProgram Int.
The way the type of tryReserve is declared, when you have a CommandLineProgram a value, you use lift, but when you have a ReservationsApiProgram a, you use liftF. This depends on the order of the monads contained within FreeT. If you swap CommandLineProgram and ReservationsApiProgram, you'll also need to use lift instead of liftF, and vice versa.
Interpreters #
tryReserve is a pure value. It's an Abstract Syntax Tree that combines two separate instruction sets to describe a complex interaction between user, command line, and an HTTP client. The program doesn't do anything until interpreted.
You can write an impure interpreter for each of the APIs, and a third one that uses the other two to interpret tryReserve.
Interpreting CommandLineProgram values is similar to the previous F# example:
interpretCommandLine :: CommandLineProgram a -> IO a interpretCommandLine program = case runFree program of Pure r -> return r Free (ReadLine next) -> do line <- getLine interpretCommandLine $ next line Free (WriteLine line next) -> do putStrLn line interpretCommandLine next
This interpreter is a recursive function that pattern-matches all the cases in any CommandLineProgram a. When it encounters a Pure case, it simply returns the contained value.
When it encounters a ReadLine value, it calls getLine, which returns an IO String value read from the command line, but thanks to the do block, line is a String value. The interpreter then calls next with line, and passes the return value of that recursively to itself.
A similar treatment is given to the WriteLine case. putStrLn line writes line to the command line, where after next is used as an input argument to interpretCommandLine.
Thanks to Haskell's type system, you can easily tell that interpretCommandLine is impure, because for every CommandLineProgram a it returns IO a. That was the intent all along.
Likewise, you can write an interpreter for ReservationsApiProgram values:
interpretReservationsApi :: ReservationsApiProgram a -> IO a interpretReservationsApi program = case runFree program of Pure x -> return x Free (GetSlots zt next) -> do slots <- HttpClient.getSlots zt interpretReservationsApi $ next slots Free (PostReservation r next) -> do HttpClient.postReservation r interpretReservationsApi next
The structure of interpretReservationsApi is similar to interpretCommandLine. It delegates its implementation to an HttpClient module that contains the impure interactions with the HTTP API. This module isn't shown in this article, but you can see it in the GitHub repository that accompanies this article.
From these two interpreters, you can create a combined interpreter:
interpret :: FreeT ReservationsApiProgram CommandLineProgram a -> IO a interpret program = do r <- interpretCommandLine $ runFreeT program case r of Pure x -> return x Free p -> do y <- interpretReservationsApi p interpret y
This function has the required type: it evaluates any FreeT ReservationsApiProgram CommandLineProgram a and returns an IO a. runFreeT returns the CommandLineProgram part of the combined program. Passing this value to interpretCommandLine, you get the underlying type - the a in CommandLineProgram a, if you will. In this case, however, the a is quite a complex type that I'm not going to write out here. Suffice it to say that, at the container level, it's a FreeF value, which can be either a Pure or a Free case that you can use for pattern matching.
In the Pure case, you're done, so you can simply return the underlying value.
In the Free case, the p contained inside is a ReservationsApiProgram value, which you can interpret with interpretReservationsApi. That returns an IO a value, and due to the do block, y is the a. In this case, however, a is FreeT ReservationsApiProgram CommandLineProgram a, but that means that the function can now recursively call itself with y in order to interpret the next instruction.
Execution #
Armed with both an AST and an interpreter, executing the program is trivial:
main :: IO () main = interpret tryReserve
When you run the program, you could produce an interaction like this:
Please enter number of diners:
4
Please enter your desired date:
2017-11-25 18-30-00Z
Not a date.
Please enter your desired date:
2017-11-25 18:30:00Z
Please enter your name:
Mark Seemann
Please enter your email address:
mark@example.org
Status {statusCode = 200, statusMessage = "OK"}
You'll notice that I initially made a mistake on the date format, which caused readParse to prompt me again.
If you want to run this code sample yourself, you're going to need an appropriate HTTP API with which you can interact. I hosted the API on my local machine, and afterwards verified that the record was, indeed, written in the reservations database.
Summary #
This proof of concept proves that it's possible to combine separate free monads. Now that we know that it works, and the overall outline of it, it should be possible to translate this to F#. You should, however, expect more boilerplate code.
Next: Combining free monads in F#.
A pure command-line wizard
An example of a small Abstract Syntax Tree written with F# syntactic sugar.
In the previous article, you got an introduction to a functional command-line API in F#. The example in that article, however, was too simple to highlight its composability. In this article, you'll see a fuller example.
Command-line wizard for on-line restaurant reservations #
In previous articles, you can see variations on an HTTP-based back-end for an on-line restaurant reservation system. In this article, on the other hand, you're going to see a first attempt at a command-line client for the API.
Normally, an on-line restaurant reservation system would have GUIs hosted in web pages or mobile apps, but with an open HTTP API, a self-respecting geek would prefer a command-line interface (CLI)... right?!
Please enter number of diners:
four
Not an integer.
Please enter number of diners:
4
Please enter your desired date:
My next birthday
Not a date.
Please enter your desired date:
2017-11-25
Please enter your name:
Mark Seemann
Please enter your email address:
mark@example.com
{Date = 25.11.2017 00:00:00 +01:00;
Name = "Mark Seemann";
Email = "mark@example.com";
Quantity = 4;}
In this incarnation, the CLI only collects information in order to dump a rendition of an F# record on the command-line. In a future article, you'll see how to combine this with an HTTP client in order to make a reservation with the back-end system.
Notice that the CLI is a wizard. It leads you through a series of questions. You have to give an appropriate answer to each question before you can move on to the next question. For instance, you must type an integer for the number of guests; if you don't, the wizard will repeatedly ask you for an integer until you do.
You can develop such an interface with the commandLine computation expression from the previous article.
Reading quantities #
There are four steps in the wizard. The first is to read the desired quantity from the command line:
// CommandLineProgram<int> let rec readQuantity = commandLine { do! CommandLine.writeLine "Please enter number of diners:" let! l = CommandLine.readLine match Int32.TryParse l with | true, dinerCount -> return dinerCount | _ -> do! CommandLine.writeLine "Not an integer." return! readQuantity }
This small piece of interaction is defined entirely within a commandLine expression. This enables you to use do! expressions and let! bindings to compose smaller CommandLineProgram values, such as CommandLine.writeLine and CommandLine.readLine (both shown in the previous article).
After prompting the user to enter a number, the program reads the user's input from the command line. While CommandLine.readLine is a CommandLineProgram<string> value, the let! binding turns l into a string value. If you can parse l as an integer, you return the integer; otherwise, you recursively return readQuantity.
The readQuantity program will continue to prompt the user for an integer. It gives you no option to cancel the wizard. This is a deliberate simplification I did in order to keep the example as simple as possible, but a real program should offer an option to abort the wizard.
The function returns a CommandLineProgram<int> value. This is a pure value containing an Abstract Syntax Tree (AST) that describes the interactions to perform. It doesn't do anything until interpreted. Contrary to designing with Dependency Injection and interfaces, however, you can immediately tell, from the type, that explicitly delimited impure interactions may take place within that part of your code base.
Reading dates #
When you've entered a proper number of diners, you proceed to enter a date. The program for that looks similar to readQuantity:
// CommandLineProgram<DateTimeOffset> let rec readDate = commandLine { do! CommandLine.writeLine "Please enter your desired date:" let! l = CommandLine.readLine match DateTimeOffset.TryParse l with | true, dt -> return dt | _ -> do! CommandLine.writeLine "Not a date." return! readDate }
The readDate value is so similar to readQuantity that you might be tempted to refactor both into a single, reusable function. In this case, however, I chose to stick to the rule of three.
Reading strings #
Reading the customer's name and email address from the command line is easy, as no parsing is required:
// CommandLineProgram<string> let readName = commandLine { do! CommandLine.writeLine "Please enter your name:" return! CommandLine.readLine } // CommandLineProgram<string> let readEmail = commandLine { do! CommandLine.writeLine "Please enter your email address:" return! CommandLine.readLine }
Both of these values unconditionally accept whatever you write when prompted. From a security standpoint, all input is evil, so in a production code base, you should still perform some validation. This, on the other hand, is demo code, so with that caveat, it accepts all strings you might type.
These values are similar to each other, but once again I invoke the rule of three and keep them as separate values.
Composing the wizard #
Together with the general-purpose command line API, the above values are all you need to compose the wizard. In this incarnation, the wizard should collect the information you type, and create a single record with those values. This is the type of record it must create:
type Reservation = { Date : DateTimeOffset Name : string Email : string Quantity : int }
You can easily compose the wizard like this:
// CommandLineProgram<Reservation> let readReservationRequest = commandLine { let! count = readQuantity let! date = readDate let! name = readName let! email = readEmail return { Date = date; Name = name; Email = email; Quantity = count } }
There's really nothing to it. As all the previous code examples in this article, you compose the readReservationRequest value entirely inside a commandLine expression. You use let! bindings to collect the four data elements you need, and once you have all four, you can return a Reservation value.
Running the program #
You may have noticed that no code so far shown define functions; they are all values. They are small program fragments, expressed as ASTs, composed into slightly larger programs that are still ASTs. So far, all the code is pure.
In order to run the program, you need an interpreter. You can reuse the interpreter from the previous article when composing your main function:
[<EntryPoint>] let main _ = Wizard.readReservationRequest |> CommandLine.bind (CommandLine.writeLine << (sprintf "%A")) |> interpret 0 // return an integer exit code
Notice that most of the behaviour is defined by the above Wizard.readReservationRequest value. That program, however, returns a Reservation value that you should also print to the command line, using the CommandLine module. You can achieve that behaviour by composing Wizard.readReservationRequest with CommandLine.writeLine using CommandLine.bind. Another way to write the same composition would be by using a commandLine computation expression, but in this case, I find the small pipeline of functions easier to read.
When you bind two CommandLineProgram values to each other, the result is a third CommandLineProgram. You can pipe that to interpret in order to run the program. The result is an interaction like the one shown in the beginning of this article.
Summary #
In this article, you've seen how you can create larger ASTs from smaller ASTs, using the syntactic sugar that F# computation expressions afford. The point, so far, is that you can make side-effects and non-deterministic behaviour explicit, while retaining the 'normal' F# development experience.
In Haskell, impure code can execute within an IO context, but inside IO, any sort of side-effect or non-deterministic behaviour could take place. For that reason, even in Haskell, it often makes sense to define an explicitly delimited set of impure operations. In the previous article, you can see a small Haskell code snippet that defines a command-line instruction AST type using Free. When you, as a code reader, encounter a value of the type CommandLineProgram String, you know more about the potential impurities than if you encounter a value of the type IO String. The same argument applies, with qualifications, in F#.
When you encounter a value of the type CommandLineProgram<Reservation>, you know what sort of impurities to expect: the program will only write to the command line, or read from the command line. What if, however, you'd like to combine those particular interactions with other types of interactions?
Read on.
Hello, pure command-line interaction
A gentle introduction to modelling impure interactions with pure code.
Dependency Injection is a well-described concept in object-oriented programming, but as I've explained earlier, its not functional, because it makes everything impure. In general, you should reject the notion of dependencies by instead designing your application on the concept of an impure/pure/impure sandwich. This is possible more often than you'd think, but there's still a large group of applications where this will not work. If your application needs to interact with the impure world for an extended time, you need a way to model such interactions in a pure way.
This article introduces a way to do that.
Command line API #
Imagine that you have to write a command-line program that can ask a series of questions and print appropriate responses. In the general case, this is a (potentially) long-running series of interactions between the user and the program. To keep it simple, though, in this article we'll start by looking at a degenerate example:
Please enter your name. Mark Hello, Mark!
The program is simply going to request that you enter your name. Once you've done that, it prints the greeting. In object-oriented programming, using Dependency Injection, you might introduce an interface. Keeping it simple, you can restrict such an interface to two methods:
public interface ICommandLine { string ReadLine(); void WriteLine(string text); }
Please note that this is clearly a toy example. In later articles, you'll see how to expand the example to cover some more complex interactions, but you could also read a more realistic example already. Initially, the example is degenerate, because there's only a single interaction. In this case, an impure/pure/impure sandwich is still possible, but such a design wouldn't scale to more complex interactions.
The problem with defining and injecting an interface is that it isn't functional. What's the functional equivalent, then?
Instruction set #
Instead of defining an interface, you can define a discriminated union that describes a limited instruction set for command-line interactions:
type CommandLineInstruction<'a> = | ReadLine of (string -> 'a) | WriteLine of string * 'a
You may notice that it looks a bit like the above C# interface. Instead of defining two methods, it defines two cases, but the names are similar.
The ReadLine case is an instruction that an interpreter can evaluate. The data contained in the case is a continuation function. After evaluating the instruction, an interpreter must invoke this function with a string. It's up to the interpreter to figure out which string to use, but it could, for example, come from reading an input string from the command line. The continuation function is the next step in whatever program you're writing.
The WriteLine case is another instruction for interpreters. The data contained in this case is a tuple. The first element of the tuple is input for the interpreter, which can choose to e.g. print the value on the command line, or ignore it, and so on. The second element of the tuple is a value used to continue whatever program this case is a part of.
This enables you to write a small, specialised Abstract Syntax Tree (AST), but there's currently no way to return from it. One way to do that is to add a third 'stop' case. If you're interested in that option, Scott Wlaschin covers this as one iteration in his excellent explanation of the AST design.
Instead of adding a third 'stop' case to CommandLineInstruction<'a>, another option is to add a new wrapper type around it:
type CommandLineProgram<'a> = | Free of CommandLineInstruction<CommandLineProgram<'a>> | Pure of 'a
The Free case contains a CommandLineInstruction that always continues to a new CommandLineProgram value. The only way you can escape the AST is via the Pure case, which simply contains the 'return' value.
Abstract Syntax Trees #
With these two types you can write specialised programs that contain instructions for an interpreter. Notice that the types are pure by intent, although in F# we can't really tell. You can, however, repeat this exercise in Haskell, where the instruction set looks like this:
data CommandLineInstruction next = ReadLine (String -> next) | WriteLine String next deriving (Functor) type CommandLineProgram = Free CommandLineInstruction
Both of these types are pure, because IO is nowhere in sight. In Haskell, functions are pure by default. This also applies to the String -> next function contained in the ReadLine case.
Back in F# land, you can write an AST that implements the command-line interaction shown in the beginning of the article:
// CommandLineProgram<unit> let program = Free (WriteLine ( "Please enter your name.", Free (ReadLine ( fun s -> Free (WriteLine ( sprintf "Hello, %s!" s, Pure ()))))))
This AST defines a little program. The first step is a WriteLine instruction with the input value "Please enter your name.". The WriteLine case constructor takes a tuple as input argument. The first tuple element is that prompt, and the second element is the continuation, which has to be a new CommandLineInstruction<CommandLineProgram<'a>> value.
In this example, the continuation value is a ReadLine case, which takes a continuation function as input. This function should return a new program value, which it does by returning a WriteLine.
This second WriteLine value creates a string from the outer value s. The second tuple element for the WriteLine case must, again, be a new program value, but now the program is done, so you can use the 'stop' value Pure ().
You probably think that I should quit the mushrooms. No one in their right mind will want to write code like this. Neither would I. Fortunately, you can make the coding experience much better, but you'll see how to do that later.
Interpretation #
The above program value is a small CommandLineProgram<unit>. It's a pure value. In itself, it doesn't do anything.
Clearly, we'd like it to do something. In order to make that happen, you can write an interpreter:
// CommandLineProgram<'a> -> 'a let rec interpret = function | Pure x -> x | Free (ReadLine next) -> Console.ReadLine () |> next |> interpret | Free (WriteLine (s, next)) -> Console.WriteLine s next |> interpret
This interpreter is a recursive function that pattern-matches all the cases in any CommandLineProgram<'a>. When it encounters a Pure case, it simply returns the contained value.
When it encounters a ReadLine value, it calls Console.ReadLine (), which returns a string value read from the command line. It then pipes that input value to its next continuation function, which produces a new CommandLineInstruction<CommandLineProgram<'a>> value. Finally, it pipes that continuation value recursively to itself.
A similar treatment is given to the WriteLine case. Console.WriteLine s writes s to the command line, where after next is recursively piped to interpret.
When you run interpret program, you get an interaction like this:
Please enter your name. ploeh Hello, ploeh!
The program is pure; the interpret function is impure.
Syntactic sugar #
Clearly, you don't want to write programs as ASTs like the above. Fortunately, you don't have to. You can add syntactic sugar in the form of computation expressions. The way to do that is to turn your AST types into a monad. In Haskell, you'd already be done, because Free is a monad. In F#, some code is required.
Source functor #
The first step is to define a map function for the underlying instruction set union type. Conceptually, when you can define a map function for a type, you've created a functor (if it obeys the functor laws, that is). Functors are common, so it often pays off being aware of them.
// ('a -> 'b) -> CommandLineInstruction<'a> -> CommandLineInstruction<'b> let private mapI f = function | ReadLine next -> ReadLine (next >> f) | WriteLine (x, next) -> WriteLine (x, next |> f)
The mapI function takes a CommandLineInstruction<'a> value and maps it to a new value by mapping the 'underlying value'. I decided to make the function private because later, I'm also going to define a map function for CommandLineProgram<'a>, and I don't want to confuse users of the API with two different map functions. This is also the reason that the name of the function isn't simply map, but rather mapI, where the I stands for instruction.
mapI pattern-matches on the (implicit) input argument. If it's a ReadLine case, it returns a new ReadLine value, but it uses the mapper function f to translate the next function. Recall that next is a function of the type string -> 'a. When you compose it with f (which is a function of the type 'a -> 'b), you get (string -> 'a) >> ('a -> 'b), or string -> 'b. You've transformed the 'a to a 'b for the ReadLine case. If you can do the same for the WriteLine case, you'll have a functor.
Fortunately, the WriteLine case is similar, although a small tweak is required. This case contains a tuple of data. The first element (x) isn't a generic type (it's a string), so there's nothing to map. You can use it as-is in the new WriteLine value that you'll return. The WriteLine case is degenerate because next isn't a function, but rather a value. It has a type of 'a, and f is a function of the type 'a -> 'b, so piping next to f returns a 'b.
That's it: now you have a functor.
(In order to keep the category theorists happy, I should point out that such functors are really a sub-type of functors called endo-functors. Additionally, functors must obey some simple and intuitive laws in order to be functors, but that's all I'll say about that here.)
Free monad #
There's a reason I spend so much time talking about functors. The goal is syntactic sugar. You can get that with computation expressions. In order to create a computation expression builder, you need a monad.
You need a recipe for creating a monad. Fortunately, there's a type of monad called a free monad. It has the virtue that it enables you to create a monad from any functor.
Just what you need.
In Haskell, this happens automatically when you declare type CommandLineProgram = Free CommandLineInstruction. Thanks to Haskell's type system, Free is automatically a Monad when the underlying type is a Functor. In F#, you have to work for your monads, but the fact that Haskell can automate this means that there's a recipe that you can follow.
Earlier in this article, I mentioned in passing that there are alternative ways in which you can define a 'stop' case for your instruction set. The reason I chose to separate the API into two types (an 'instruction set', and a 'program') is that the instruction set is the underlying functor. The 'program' is part of the free monad. The other part is a bind function (that obeys the monad laws).
// ('a -> CommandLineProgram<'b>) -> CommandLineProgram<'a> // -> CommandLineProgram<'b> let rec bind f = function | Free instruction -> instruction |> mapI (bind f) |> Free | Pure x -> f x
This recursive function pattern-matches on the (implicit) CommandLineProgram<'a> argument. In the Pure case, the 'return' value x has the type 'a, which fits as input for the f function. The result is a value of type CommandLineProgram<'b>.
In the Free case, the instruction is a functor with the map function mapI. The first argument to the mapI function must be a function with the type 'a -> 'b. How can you compose such a function?
If you partially apply the recursive bind function with f (that is: bind f), you get a function of the type CommandLineProgram<'a> -> CommandLineProgram<'b>. This fits with mapI, because instruction has the type CommandLineInstruction<CommandLineProgram<'a>> (refer back to the definition of the Free case if need to convince yourself of that). The result of calling mapI with instruction is a CommandLineInstruction<CommandLineProgram<'b>> value. In order to turn it into a CommandLineProgram<'b> value, you wrap it in a new Free case.
Although this required a bit of explanation, defining a bind function for a free monad is a repeatable process. After all, in Haskell it's automated. In F#, you have to explicitly write the code, but it follows a recipe. Once you get the hang of it, there's not much to it.
Functor #
You'll occasionally need to explicitly use the bind function, but often it'll 'disappear' into a computation expression. There are other building blocks to an API than a bind function, though. You may, for example, need a map function:
// ('a -> 'b) -> CommandLineProgram<'a> -> CommandLineProgram<'b> let map f = bind (f >> Pure)
This makes CommandLineProgram<'a> a functor as well. This is the reason I made mapI private, because mapI makes the instruction set a functor, but the API is expressed in terms of AST programs, and it should be consistent. Within the same module, map should work on the same data type as bind.
Notice that map can be defined as a composition of bind and Pure. This is part of the recipe. For a free monad, the map function always looks like that. The f function is a function with the type 'a -> 'b, and Pure is a case constructor with the type 'b -> CommandLineProgram<'b>. Notice that I've used 'b for the generic type argument instead of the usual 'a. Hopefully, this makes it clear that when you compose these two functions together (f >> Pure), you get a function of the type ('a -> 'b) >> ('b -> CommandLineProgram<'b>), or 'a -> CommandLineProgram<'b>. That's just the type of function needed for the bind function, so the whole composition turns out to type-check and work as intended.
API #
In order to work with an API, you need the ability to create values of the API's type(s). In this case, you must be able to create CommandLineProgram<'a> values. While you can create them explicitly using the ReadLine, WriteLine, Free, and Pure case constructors, it'll be more convenient if you have some predefined functions and values for that.
// CommandLineProgram<string> let readLine = Free (ReadLine Pure) // string -> CommandLineProgram<unit> let writeLine s = Free (WriteLine (s, Pure ()))
In the ReadLine case, there's no input to the instruction, so you can define readLine as a predefined CommandLineProgram<string> value.
The WriteLine case, on the other hand, takes as an input argument a string to write, so you can define writeLine as a function that returns a CommandLineProgram<unit> value.
Computation expression #
The addition of map and supporting API is, to be honest, a bit of digression. You're going to use these functions later, but they aren't required in order to create a computation expression builder. All you need is a bind function and a way to lift a raw value into the monad. All of these are in place, so the builder is a matter of delegation:
type CommandLineBuilder () = member this.Bind (x, f) = CommandLine.bind f x member this.Return x = Pure x member this.ReturnFrom x = x member this.Zero () = Pure ()
This is a fairly minimal builder, but in my experience, most of times, this is all you need.
Create an instance of the CommandLineBuilder class, and you can write computation expressions:
let commandLine = CommandLineBuilder ()
I usually put such an object in a module with an [<AutoOpen>] attribute, so that it's available as a global object.
Producing ASTs with pretty code #
Using the commandLine computation expression is like using the built-in async or seq expressions. You can use it to rewrite the above AST as readable code:
// CommandLineProgram<unit> let program = commandLine { do! CommandLine.writeLine "Please enter your name." let! name = CommandLine.readLine do! sprintf "Hello, %s!" name |> CommandLine.writeLine }
This produces the same AST as before, but with much more readable syntax. The AST is the same, and you can use the above interpret function to run it. The interaction is the same as before:
Please enter your name. Free Hello, Free!
This is, obviously, a toy example, but in coming articles, you'll see how to gradually enhance the code to perform some more complex interactions.
Summary #
Functional programming emphasises pure functions, and a separation of pure and impure code. The simplest way to achieve such a separation is to design your code as an impure/pure/impure sandwich, but sometimes this isn't possible. When it's not possible, an alternative is to define an instruction set for an AST, and turn it into a free monad in order to enable enough syntactic sugar to keep the code readable.
While this may seem complicated, it has the benefit of making impurities explicit in the code. Whenever you see a CommandLineProgram value, you know that, at run-time, something impure is likely to happen. It's not uncontrolled impurity, though. Inside a CommandLineProgram, only reading from, and writing to, the command line will happen. It's not going to generate random values, change global variables, send an email, or any other unpredictable operation - that is, unless the interpreter does that...
Next: A pure command-line wizard.
Pure interactions
Long-running, non-deterministic interactions can be modelled in a pure, functional way.
In a previous article, you can read why Dependency Injection and (strict) functional programming are mutually exclusive. Dependency Injection makes everything impure, and if nothing is pure, then it's hardly functional. In Dependency rejection, you can see how you can often separate impure and pure code into an impure/pure/impure sandwich.
Micro-operation-based architectures #
The impure/pure/impure sandwich architecture works well in scenarios with limited interaction. Some data arrives at the boundary of the system, the system responds, and that's it. That, however, describes a significant fraction of all software running in the world today.
Any HTTP-based application (web site, REST API, most SOAP services) fits the description: an HTTP request arrives, and the server responds with an HTTP response. In a well-designed and well-running system, you should return the response within seconds, if not faster. Everything the software needs in order to run to completion is either part of the request, or part of the application state. You may need to query a database to gather more data based on the incoming request, but you can still gather most data from impure sources, pass it all to your pure core implementation, get the pure values back and return the response.
Likewise, asynchronous message-based systems, such as pub/sub, Pipes and Filters, Actor-based systems, 'SOA done right', CQRS/Event Sourcing, and so on, are based on short-lived, stateless interactions. Similar to HTTP-based applications, there's often (persisted) application state, but once a message arrives at a message handler, the software should process it as quickly as possible. Again, it can read extra (impure) data from a database, pass everything to a pure function, and finally do something impure with the return value.
Common for all such systems is that while they can handle large volumes of data, they do so as the result of a multitude of parallel, distinct, and isolated micro-operations.
Interactive software #
There is, however, another category of software. We could call it 'interactive software'. As the name implies, this includes everything with a user interface, but can also be a long-running batch job, or, as you've already seen, time-sensitive software.
For such software, the impure/pure/impure sandwich architecture is no longer possible. Just think of a UI-based program, like an email client. You compose and send an email, receive a response, then compose a reply, and so on. Every send and receive is impure, as is all the user interface rendering. What happens next depends on what happened before, and everything that happens in the real world is impure.
Have we finally identified the limitations of functional programming?
Hardly. In this series of articles, I'm going to show you how to model pure interactions:
- Hello, pure command-line interaction
- A pure command-line wizard
- Combining free monads in Haskell
- Combining free monads in F#
- F# free monad recipe
This series of articles gives you a comprehensive walkthrough of pure interactions and free monads in F#. For a motivating example, see Pure times, which presents a more realistic example that, on the other hand, doesn't go to the same level of detail.
Summary #
The solution to the problem of continuous impure interactions is to model them as a instructions in a (domain-specific) Abstract Syntax Tree (AST), and then using an impure interpreter for the pure AST. You can model the AST as a (free) monad in order to make the required syntax nice.
Pure times in F#
A Polling Consumer implementation written in F#.
Previously, you saw how to implement a Polling Consumer in Haskell. This proves that it's possible to write pure functional code modelling long-running interactions with the (impure) world. In this article, you'll see how to port the Haskell code to F#.
For reference, I'll repeat the state transition diagram here:
For a complete description of the goals and constraints of this particular Polling Consumer implementation, see my earlier Type Driven Development article, or, even better, watch my Pluralsight course Type-Driven Development with F#.
State data types #
The program has to keep track of various durations. You can model these as naked TimeSpan values, but in order to add extra type safety, you can, instead, define them as separate types:
type PollDuration = PollDuration of TimeSpan type IdleDuration = IdleDuration of TimeSpan type HandleDuration = HandleDuration of TimeSpan type CycleDuration = { PollDuration : PollDuration HandleDuration : HandleDuration }
This is a straightforward port of the Haskell code. See the previous article for more details about the motivation for doing this.
You can now define the states of the finite state machine:
type State<'msg> = | ReadyState of CycleDuration list | ReceivedMessageState of (CycleDuration list * PollDuration * 'msg) | NoMessageState of (CycleDuration list * PollDuration) | StoppedState of CycleDuration list
Again, this is a straight port of the Haskell code.
From instruction set to syntactic sugar #
The Polling Consumer must interact with its environment in various ways:
- Query the system clock
- Poll for messages
- Handle messages
- Idle
type PollingInstruction<'msg, 'next> = | CurrentTime of (DateTimeOffset -> 'next) | Poll of (('msg option * PollDuration) -> 'next) | Handle of ('msg * (HandleDuration -> 'next)) | Idle of (IdleDuration * (IdleDuration -> 'next))
Once more, this is a direct translation of the Haskell code, but from here, this is where your F# code will have to deviate from Haskell. In Haskell, you can, with a single line of code, declare that such a type is a functor. This isn't possible in F#. Instead, you have to explicitly write a map function. This isn't difficult, though. There's a reason that the Haskell compiler can automate this:
// ('a -> 'b) -> PollingInstruction<'c,'a> -> PollingInstruction<'c,'b> let private mapI f = function | CurrentTime next -> CurrentTime (next >> f) | Poll next -> Poll (next >> f) | Handle (x, next) -> Handle (x, next >> f) | Idle (x, next) -> Idle (x, next >> f)
The function is named mapI, where the I stands for instruction. It's private because the next step is to package the functor in a monad. From that monad, you can define a new functor, so in order to prevent any confusion, I decided to hide the underlying functor from any consumers of the API.
Defining a map function for a generic type like PollingInstruction<'msg, 'next> is well-defined. Pattern-match each union case and return the same case, but with the next function composed with the input function argument f: next >> f. In later articles, you'll see more examples, and you'll see how this recipe is entirely repeatable and automatable.
While a functor isn't an explicit concept in F#, this is how PollingInstruction msg next is a Functor in Haskell. Given a functor, you can produce a free monad. The reason you'd want to do this is that once you have a monad, you can get syntactic sugar. Currently, PollingInstruction<'msg, 'next> only enables you to create Abstract Syntax Trees (ASTs), but the programming experience would be cumbersome and alien. Monads give you automatic do notation in Haskell; in F#, it enables you to write a computation expression builder.
Haskell's type system enables you to make a monad from a functor with a one-liner: type PollingProgram msg = Free (PollingInstruction msg). In F#, you'll have to write some boilerplate code. First, you have to define the monadic type:
type PollingProgram<'msg, 'next> = | Free of PollingInstruction<'msg, PollingProgram<'msg, 'next>> | Pure of 'next
You already saw a hint of such a type in the previous article. The PollingProgram<'msg, 'next> discriminated union defines two cases: Free and Pure. The Free case is a PollingInstruction that produces a new PollingProgram as its next step. In essence, this enables you to build an AST, but you also need a signal to stop and return a value from the AST. That's the purpose of the Pure case.
Such a type is only a monad if it defines a bind function (that obey the monad laws):
// ('a -> PollingProgram<'b,'c>) -> PollingProgram<'b,'a> // -> PollingProgram<'b,'c> let rec bind f = function | Free instruction -> instruction |> mapI (bind f) |> Free | Pure x -> f x
This bind function pattern-matches on Free and Pure, respectively. In the Pure case, it simply uses the underlying result value x as an input argument to f. In the Free case, it composes the underlying functor (mapI) with itself recursively. If you find this step obscure, I will not blame you. Just like the implementation of mapI is a bit of boilerplate code, then so is this. It always seems to work this way. If you want to dig deeper into the inner workings of this, then Scott Wlaschin has a detailed explanation.
With the addition of bind PollingProgram<'msg, 'next> becomes a monad (I'm not going to show that the monad laws hold, but they do). Making it a functor is trivial:
// ('a -> 'b) -> PollingProgram<'c,'a> -> PollingProgram<'c,'b> let map f = bind (f >> Pure)
The underlying PollingInstruction type was already a functor. This function makes PollingProgram a functor as well.
It'll be convenient with some functions that lifts each PollingInstruction case to a corresponding PollingProgram value. In Haskell, you can use the liftF function for this, but in F# you'll have to be slightly more explicit:
// PollingProgram<'a,DateTimeOffset> let currentTime = Free (CurrentTime Pure) // PollingProgram<'a,('a option * PollDuration)> let poll = Free (Poll Pure) // 'a -> PollingProgram<'a,HandleDuration> let handle msg = Free (Handle (msg, Pure)) // IdleDuration -> PollingProgram<'a,IdleDuration> let idle duration = Free (Idle (duration, Pure))
currentTime and poll aren't even functions, but values. They are, however, small PollingProgram values, so while they look like values (as contrasted to functions), they represent singular executable instructions.
handle and idle are both functions that return PollingProgram values.
You can now implement a small computation expression builder:
type PollingBuilder () = member this.Bind (x, f) = Polling.bind f x member this.Return x = Pure x member this.ReturnFrom x = x member this.Zero () = this.Return ()
As you can tell, not much is going on here. The Bind method simply delegates to the above bind function, and the rest are trivial one-liners.
You can create an instance of the PollingBuilder class so that you can write PollingPrograms with syntactic sugar:
let polling = PollingBuilder ()
This enables you to write polling computation expressions. You'll see examples of this shortly.
Most of the code you've seen here is automated in Haskell. This means that while you'll have to explicitly write it in F#, it follows a recipe. Once you get the hang of it, it doesn't take much time. The maintenance overhead of the code is also minimal, because you're essentially implementing a universal abstraction. It's not going to change.
Support functions #
Continuing the port of the previous article's Haskell code, you can write a pair of support functions. These are small PollingProgram values:
// IdleDuration -> DateTimeOffset -> PollingProgram<'a,bool> let private shouldIdle (IdleDuration d) stopBefore = polling { let! now = Polling.currentTime return now + d < stopBefore }
This shouldIdle function uses the polling computation expression defined above. It first uses the above Polling.currentTime value to get the current time. While Polling.currentTime is a value of the type PollingProgram<'b,DateTimeOffset>, the let! binding makes now a simple DateTimeOffset value. Computation expressions give you the same sort of syntactic sugar that do notation does in Haskell.
If you add now to d, you get a new DateTimeOffset value that represents the time that the program will resume, if it decides to suspend itself for the idle duration. If this time is before stopBefore, the return value is true; otherwise, it's false. Similar to the Haskell example, the return value of shouldIdle isn't just bool, but rather PollingProgram<'a,bool>, because it all takes place inside the polling computation expression.
The function looks impure, but it is pure.
In the same vein, you can implement a shouldPoll function:
// CycleDuration -> TimeSpan let toTotalCycleTimeSpan x = let (PollDuration pd) = x.PollDuration let (HandleDuration hd) = x.HandleDuration pd + hd // TimeSpan -> DateTimeOffset -> CycleDuration list -> PollingProgram<'a,bool> let private shouldPoll estimatedDuration stopBefore statistics = polling { let expectedHandleDuration = statistics |> List.map toTotalCycleTimeSpan |> Statistics.calculateExpectedDuration estimatedDuration let! now = Polling.currentTime return now + expectedHandleDuration < stopBefore }
This function uses two helper functions: toTotalCycleTimeSpan and Statistics.calculateExpectedDuration. I've included toTotalCycleTimeSpan in the code shown here, while I'm skipping Statistics.calculateExpectedDuration, because it hasn't changed since the code I show in my Pluralsight course. You can also see the function in the GitHub repository accompanying this article.
Compared to shouldIdle, the shouldPoll function needs an extra (pure) step in order to figure out the expectedHandleDuration, but from there, the two functions are similar.
Transitions #
All building blocks are now ready for the finite state machine. In order to break the problem into manageable pieces, you can write a function for each state. Such a function should take as input the data associated with a particular state, and return the next state, based on the input.
The simplest transition is when the program reaches the end state, because there's no way out of that state:
// CycleDuration list -> PollingProgram<'a,State<'b>> let transitionFromStopped s = polling { return StoppedState s }
The data contained in a StoppedState case has the type CycleDuration list, so the transitionFromStopped function simply lifts such a list to a PollingProgram value by returning a StoppedState value from within a polling computation expression.
Slightly more complex, but still simple, is the transition out of the received state. There's no branching logic involved. You just have to handle the message, measure how much time it takes, append the measurements to previous statistics, and return to the ready state:
// CycleDuration list * PollDuration * 'a -> PollingProgram<'a,State<'b>> let transitionFromReceived (statistics, pd, msg) = polling { let! hd = Polling.handle msg return { PollDuration = pd; HandleDuration = hd } :: statistics |> ReadyState }
This function uses the Polling.handle convenience function to handle the input message. Although the handle function returns a PollingProgram<'a,HandleDuration> value, the let! binding inside of a polling computation expression makes hd a HandleDuration value.
The data contained within a ReceivedMessageState case is a CycleDuration list * PollDuration * 'msg tuple. That's the input argument to the transitionFromReceived function, which immediately pattern-matches the tuple's three elements into statistics, pd, and msg.
The pd element is the PollDuration - i.e. the time it took to reach the received state. The hd value returned by Polling.handle gives you the time it took to handle the message. From those two values you can create a new CycleDuration value, and cons (::) it onto the previous statistics. This returns an updated list of statistics that you can pipe to the ReadyState case constructor.
ReadyState in itself creates a new State<'msg> value, but since all of this takes place inside a polling computation expression, the return type of the function becomes PollingProgram<'a,State<'b>>.
The transitionFromReceived function handles the state when the program has received a message, but you also need to handle the state when no message was received:
// IdleDuration -> DateTimeOffset -> CycleDuration list * 'a // -> PollingProgram<'b,State<'c>> let transitionFromNoMessage d stopBefore (statistics, _) = polling { let! b = shouldIdle d stopBefore if b then do! Polling.idle d |> Polling.map ignore return ReadyState statistics else return StoppedState statistics }
This function first calls the shouldIdle support function. Similar to Haskell, you can see how you can compose larger PollingPrograms from smaller PollingProgram values - just like you can compose 'normal' functions from smaller functions.
With the syntactic sugar in place, b is simply a bool value that you can use in a standard if/then/else expression. If b is false, then return a StoppedState value; otherwise, continue with the next steps.
Polling.idle returns the duration of the suspension, but you don't actually need this data, so you can ignore it. When Polling.idle returns, you can return a ReadyState value.
It may look as though that do! expression is a blocking call, but it really isn't. The transitionFromNoMessage function only builds an Abstract Syntax Tree, where one of the instructions suggests that an interpreter could block. Unless evaluated by an impure interpreter, transitionFromNoMessage is pure.
The final transition is the most complex, because there are three possible outcomes:
// TimeSpan -> DateTimeOffset -> CycleDuration list // -> PollingProgram<'a,State<'a>> let transitionFromReady estimatedDuration stopBefore statistics = polling { let! b = shouldPoll estimatedDuration stopBefore statistics if b then let! pollResult = Polling.poll match pollResult with | Some msg, pd -> return ReceivedMessageState (statistics, pd, msg) | None, pd -> return NoMessageState (statistics, pd) else return StoppedState statistics }
In the same way that transitionFromNoMessage uses shouldIdle, the transitionFromReady function uses the shouldPoll support function to decide whether or not to keep going. If b is false, it returns a StoppedState value.
Otherwise, it goes on to poll. Thanks to all the syntactic sugar, pollResult is an 'a option * PollDuration value. As always, when you have a discriminated union, you can handle all cases with pattern matching (and the compiler will help you keep track of whether or not you've handled all of them).
In the Some case, you have a message, and the duration it took to poll for that message. This is all the data you need to return a ReceivedMessageState value.
In the None case, you also have the poll duration pd; return a NoMessageState value.
That's four transition functions that you can combine in a single function that, for any state, returns a new state:
// TimeSpan -> IdleDuration -> DateTimeOffset -> State<'a> // -> PollingProgram<'a,State<'a>> let transition estimatedDuration idleDuration stopBefore = function | ReadyState s -> transitionFromReady estimatedDuration stopBefore s | ReceivedMessageState s -> transitionFromReceived s | NoMessageState s -> transitionFromNoMessage idleDuration stopBefore s | StoppedState s -> transitionFromStopped s
You simply pattern-match the (implicit) input argument with the four state cases, and call the appropriate transition function for each case.
Interpretation #
The transition function is pure. It returns a PollingProgram value. How do you turn it into something that performs real work?
You write an interpreter:
// PollingProgram<Msg,'a> -> 'a let rec interpret = function | Pure x -> x | Free (CurrentTime next) -> DateTimeOffset.Now |> next |> interpret | Free (Poll next) -> Imp.poll () |> next |> interpret | Free (Handle (msg, next)) -> Imp.handle msg |> next |> interpret | Free (Idle (d, next)) -> Imp.idle d |> next |> interpret
A PollingProgram is either a Pure or a Free case. In the Free case, the contained data is a PollingInstruction value, which can be one of four separate cases. With pattern matching, the interpreter handles all five cases.
In the Pure case, it returns the value, but in all the Free cases, it recursively calls itself after having first followed the instruction in each PollingInstruction case. For instance, when the instruction is CurrentTime, it invokes DateTimeOffset.Now, passes the return value (a DateTimeOffset value) to the next continuation, and then recursively calls interpret. The next instruction, then, could be another Free case, or it could be Pure.
The other three instruction cases delegate to implementation functions defined in an Imp module. I'm not going to show them here. They're normal, although impure, F# functions.
Execution #
You're almost done. You have a function that returns a new state for any given input state, as well as an interpreter. You need a function that can repeat this in a loop until it reaches StoppedState:
// TimeSpan -> IdleDuration -> DateTimeOffset -> State<Msg> -> State<Msg> let rec run estimatedDuration idleDuration stopBefore s = let ns = PollingConsumer.transition estimatedDuration idleDuration stopBefore s |> interpret match ns with | PollingConsumer.StoppedState _ -> ns | _ -> run estimatedDuration idleDuration stopBefore ns
This function calls PollingConsumer.transition with the input state s, which returns a new PollingProgram<Msg,PollingConsumer.State<Msg>> value that you can pipe to the interpret function. That gives you the new state ns. If ns is a StoppedState, you return; otherwise, you recurse into run for another round.
Finally, you can write the entry point for the application:
[<EntryPoint>] let main _ = let timeAtEntry = DateTimeOffset.Now printOnEntry timeAtEntry let stopBefore = timeAtEntry + limit let estimatedDuration = TimeSpan.FromSeconds 2. let idleDuration = TimeSpan.FromSeconds 5. |> IdleDuration let durations = PollingConsumer.ReadyState [] |> run estimatedDuration idleDuration stopBefore |> PollingConsumer.durations |> List.map PollingConsumer.toTotalCycleTimeSpan printOnExit timeAtEntry durations // Return 0. This indicates success. 0
This defines an estimated duration of 2 seconds, an idle duration of 5 seconds, and a maximum run time of 60 seconds (limit). The initial state is ReadyState with no prior statistics. Pass all these arguments to the run function, and you have a running program.
This function also uses a few printout functions that I'm not going to show here. When you run the program, you should see output like this:
Started polling at 11:18:28. Polling Handling Polling Handling Polling Sleeping Polling Sleeping Polling Handling Polling Handling Polling Sleeping Polling Sleeping Polling Sleeping Polling Handling Polling Sleeping Polling Sleeping Polling Sleeping Polling Sleeping Polling Handling Stopped polling at 11:19:26. Elapsed time: 00:00:58.4428980. Handled 6 message(s). Average duration: 00:00:01.0550346 Standard deviation: 00:00:00.3970599
It does, indeed, exit before 60 seconds have elapsed.
Summary #
You can model long-running interactions with an Abstract Syntax Tree. Without computation expressions, writing programs as 'raw' ASTs would be cumbersome, but turning the AST into a (free) monad makes it all quite palatable.
Haskell code with a free monad can be ported to F#, although some boilerplate code is required. That code, however, is unlikely to be much of a burden, because it follows a well-known recipe that implements a universal abstraction.
For more details on how to write free monads in F#, see Pure interactions.
Pure times in Haskell
A Polling Consumer implementation written in Haskell.
As you can read in the introductory article, I've come to realise that the Polling Consumer that I originally wrote in F# isn't particularly functional. Being the friendly and productive language that it is, F# doesn't protect you from mixing pure and impure code, but Haskell does. For that reason, you can develop a prototype in Haskell, and later port it to F#, if you want to learn how to solve the problem in a strictly functional way.
To recapitulate, the task is to implement a Polling Consumer that runs for a predefined duration, after which it exits (so that it can be restarted by a scheduler).
The program is a finite state machine that moves between four states. From the ready state, it'll need to decide whether to poll for a new message or exit. Polling and handling takes time (and at compile-time we don't know how long), and the program ought to stop at a pre-defined time. If it gets too close to that time, it should exit, but otherwise, it should attempt to handle a message (and keep track of how long this takes). You can read a more elaborate description of the problem in the original article.
State data types #
The premise in that initial article was that F#'s type system is so powerful that it can aid you in designing a good solution. Haskell's type system is even more powerful, so it can give you even better help.
The Polling Consumer program must measure and keep track of how long it takes to poll, handle a message, or idle. All of these are durations. In Haskell, we can represent them as NominalDiffTime values. I'm a bit concerned, though, that if I represent all of these durations as NominalDiffTime values, I may accidentally use a poll duration where I really need a handle duration, and so on. Perhaps I'm being overly cautious, but I like to get help from the type system. In the words of Igal Tabachnik, types prevent typos:
newtype PollDuration = PollDuration NominalDiffTime deriving (Eq, Show) newtype IdleDuration = IdleDuration NominalDiffTime deriving (Eq, Show) newtype HandleDuration = HandleDuration NominalDiffTime deriving (Eq, Show) data CycleDuration = CycleDuration { pollDuration :: PollDuration, handleDuration :: HandleDuration } deriving (Eq, Show)
This simply declares that PollDuration, IdleDuration, and HandleDuration are all NominalDiffTime values, but you can't mistakenly use a PollDuration where a HandleDuration is required, and so on.
In addition to those three types of duration, I also define a CycleDuration. This is the data that I actually need to keep track of: how long does it take to handle a single message? I'm assuming that polling for a message is an I/O-bound operation, so it may take significant time. Likewise, handling a message may take time. When deciding whether to exit or handle a new message, both durations count. Instead of defining CycleDuration as a newtype alias for NominalDiffTime, I decided to define it as a record type comprised of a PollDuration and a HandleDuration. It's not that I'm really interested in keeping track of these two values individually, but it protects me from making stupid mistakes. I can only create a CycleDuration value if I have both a PollDuration and a HandleDuration value.
In short, I'm trying to combat primitive obsession.
With these duration types in place, you can define the states of the finite state machine:
data PollingState msg = Ready [CycleDuration] | ReceivedMessage [CycleDuration] PollDuration msg | NoMessage [CycleDuration] PollDuration | Stopped [CycleDuration] deriving (Show)
Like the original F# code, state data can be represented as a sum type, with a case for each state. In all four cases, a CycleDuration list keeps track of the observed message-handling statistics. This is the way the program should attempt to calculate whether it's safe to handle another message, or exit. Two of the cases (ReceivedMessage and NoMessage) also contain a PollDuration, which informs the program about the duration of the poll operation that caused it to reach that state. Additionally, the ReceivedMessage case contains a message of the generic type msg. This makes the entire PollingState type generic. A message can be of any type: a string, a number, or a complex data structure. The Polling Consumer program doesn't care, because it doesn't handle messages; it only schedules the polling.
This is reminiscent of the previous F# attempt, with the most notable difference that it doesn't attempt to capture durations as Timed<'a> values. It does capture durations, but not when the operations started and stopped. So how will it know what time it is?
Interactions as pure values #
This is the heart of the matter. The Polling Consumer must constantly look at the clock. It's under a deadline, and it must also measure durations of poll, handle, and idle operations. All of this is non-deterministic, so not pure. The program has to interact with impure operations during its entire lifetime. In fact, its ultimate decision to exit will be based on impure data. How can you model this in a pure fashion?
You can model long-running (impure) interactions by defining a small instruction set for an Abstract Syntax Tree (AST). That sounds intimidating, but once you get the hang of it, it becomes routine. In later articles, I'll expand on this, but for now I'll refer you to an excellent article by Scott Wlaschin, who explains the approach in F#.
data PollingInstruction msg next = CurrentTime (UTCTime -> next) | Poll ((Maybe msg, PollDuration) -> next) | Handle msg (HandleDuration -> next) | Idle IdleDuration (IdleDuration -> next) deriving (Functor)
This PollingInstruction sum type defines four cases of interaction. Each case is
- named after the interaction
- defines the type of data used as input arguments for the interaction
- and also defines a continuation; that is: a function that will be executed with the return value of the interaction
Handle case contains all three elements: the interaction is named Handle, the input to the interaction is of the generic type msg, and the continuation is a function that takes a HandleDuration value as input, and returns a value of the generic type next. In other words, the interaction takes a msg value as input, and returns a HandleDuration value as output. That duration is the time it took to handle the input message. (The intent is that the operation that 'implements' this interaction also actually handles the message, whatever that means.)
Likewise, the Idle interaction takes an IdleDuration as input, and also returns an IdleDuration. The intent here is that the 'implementation' of the interaction suspends itself for the duration of the input value, and returns the time it actually spent in suspension (which is likely to be slightly longer than the requested duration).
Both CurrentTime and Poll, on the other hand, are degenerate, because they take no input. You don't need to supply any input argument to read the current time. You could model that interaction as taking () ('unit') as an input argument (CurrentTime () (UTCTime -> next)), but the () is redundant and can be omitted. The same is the case for the Poll case, which returns a Maybe msg and how long the poll took.
(The PollingInstruction sum type defines four cases, which is also the number of cases defined by PollingState. This is a coincidence; don't read anything into it.)
The PollingInstruction type is generic in a way that you can make it a Functor. Haskell can do this for you automatically, using the DeriveFunctor language extension; that's what deriving (Functor) does. If you'd like to see how to explicitly make such a data structure a functor, please refer to the F# example; F# can't automatically derive functors, so you'll have to do it manually.
Since PollingInstruction is a Functor, we can make a Monad out of it. You use a free monad, which allows you to build a monad from any functor:
type PollingProgram msg = Free (PollingInstruction msg)
In Haskell, it's literally a one-liner, but in F# you'll have to write the code yourself. Thus, if you're interested in learning how this magic happens, I'm going to dissect this step in the next article.
The motivation for defining a Monad is that we get automatic syntactic sugar for our PollingProgram ASTs, via Haskell's do notation. In F#, we're going to write a computation expression builder to achieve the same effect.
The final building blocks for the specialised PollingProgram API is a convenience function for each case:
currentTime :: PollingProgram msg UTCTime currentTime = liftF (CurrentTime id) poll :: PollingProgram msg (Maybe msg, PollDuration) poll = liftF (Poll id) handle :: msg -> PollingProgram msg HandleDuration handle msg = liftF (Handle msg id) idle :: IdleDuration -> PollingProgram msg IdleDuration idle d = liftF (Idle d id)
More one-liners, as you can tell. These all use liftF to turn PollingInstruction cases into PollingProgram values. The degenerate cases CurrentTime and Poll simply become values, whereas the complete cases become (pure) functions.
Support functions #
You may have noticed that until now, I haven't written much 'code' in the sense that most people think of it. It's mostly been type declarations and a few one-liners. A strong and sophisticated type system like Haskell's enable you to shift some of the programming burden from 'real programming' to type definitions, but you'll still have to write some code.
Before we get to the state transitions proper, we'll look at some support functions. These will, I hope, serve as a good introduction to how to use the PollingProgram API.
One decision the Polling Consumer program has to make is to decide whether it should suspend itself for a short time. That's easy to express using the API:
shouldIdle :: IdleDuration -> UTCTime -> PollingProgram msg Bool shouldIdle (IdleDuration d) stopBefore = do now <- currentTime return $ d `addUTCTime` now < stopBefore
The shouldIdle function returns a small program that, when evaluated, will decide whether or not to suspend itself. It first reads the current time using the above currentTime value. While currentTime has the type PollingProgram msg UTCTime, due to Haskell's do notation, the now value simply has the type UTCTime. This enables you to use the built-in addUTCTime function (here written using infix notation) to add now to d (a NominalDiffTime value, due to pattern matching into IdleDuration).
Adding the idle duration d to the current time now gives you the time the program would resume, were it to suspend itself. The shouldIdle function compares that time to the stopBefore argument (another UTCTime value). If the time the program would resume is before the time it ought to stop, the return value is True; otherwise, it's False.
Since the entire function is defined within a do block, the return type isn't just Bool, but rather PollingProgram msg Bool. It's a little PollingProgram AST, but it looks like imperative code.
You sometimes hear the bon mot that Haskell is the world's greatest imperative language. The combination of free monads and do notation certainly makes it easy to define small grammars (dare I say DSLs?) that look like imperative code, while still being strictly functional.
The crux is that shouldIdle is pure. It looks impure, but it's not. It's an Abstract Syntax Tree, and it only becomes non-deterministic if interpreted by an impure interpreter (more on that later).
The purpose of shouldIdle is to decide whether or not to idle or exit. If the program decides to idle, it should return to the ready state, as per the above state diagram. In this state, it needs to decide whether or not to poll for a message. If there's a message, it should be handled, and all of that takes time. In the ready state, then, the program must figure out how much time it thinks that handling a message will take.
One way to do that is to consider the observed durations so far. This helper function calculates the expected duration based on the average and standard deviation of the previous durations:
calculateExpectedDuration :: NominalDiffTime -> [CycleDuration] -> NominalDiffTime calculateExpectedDuration estimatedDuration [] = estimatedDuration calculateExpectedDuration _ statistics = toEnum $ fromEnum $ avg + stdDev * 3 where fromCycleDuration :: CycleDuration -> Float fromCycleDuration (CycleDuration (PollDuration pd) (HandleDuration hd)) = toEnum $ fromEnum $ pd + hd durations = fmap fromCycleDuration statistics l = toEnum $ length durations avg = sum durations / l stdDev = sqrt (sum (fmap (\x -> (x - avg) ** 2) durations) / l)
I'm not going to dwell much on this function, as it's a normal, pure, mathematical function. The only feature I'll emphasise is that in order to call it, you must pass an estimatedDuration that will be used when statistics is empty. This is because you can't calculate the average of an empty list. This estimated duration is simply your wild guess at how long you think it'll take to handle a message.
With this helper function, you can now write a small PollingProgram that decides whether or not to poll:
shouldPoll :: NominalDiffTime -> UTCTime -> [CycleDuration] -> PollingProgram msg Bool shouldPoll estimatedDuration stopBefore statistics = do let expectedHandleDuration = calculateExpectedDuration estimatedDuration statistics now <- currentTime return $ expectedHandleDuration `addUTCTime` now < stopBefore
Notice that the shouldPoll function looks similar to shouldIdle. As an extra initial step, it first calculates expectedHandleDuration using the above calculateExpectedDuration function. With that, it follows the same two steps as shouldIdle.
This function is also pure, because it returns an AST. While it looks impure, it's not, because it doesn't actually do anything.
Transitions #
Those are all the building blocks required to write the state transitions. In order to break down the problem in manageable chunks, you can write a transition function for each state. Such a function would return the next state, given a particular input state.
While it'd be intuitive to begin with the ready state, let's instead start with the simplest transition. In the end state, nothing should happen, so the transition is a one-liner:
transitionFromStopped :: Monad m => [CycleDuration] -> m (PollingState msg) transitionFromStopped statistics = return $ Stopped statistics
Once stopped, the program stays in the Stopped state. This function simply takes a list of CycleDuration values and elevates them to a monad type. Notice that the return value isn't specifically a PollingProgram, but any monad. Since PollingProgram is a monad, that'll work too, though.
Slightly more complicated than transitionFromStopped is the transition from the received state. There's no branching in that case; simply handle the message, measure how long it took, add the observed duration to the statistics, and transition back to ready:
transitionFromReceived :: [CycleDuration] -> PollDuration -> msg -> PollingProgram msg (PollingState msg) transitionFromReceived statistics pd msg = do hd <- handle msg return $ Ready (CycleDuration pd hd : statistics)
Again, this looks impure, but the return type is PollingProgram msg (PollingState msg), indicating that the return value is an AST. As is not uncommon in Haskell, the type declaration is larger than the implementation.
Things get slightly more interesting in the no message state. Here you get to use the above shouldIdle support function:
transitionFromNoMessage :: IdleDuration -> UTCTime -> [CycleDuration] -> PollingProgram msg (PollingState msg) transitionFromNoMessage d stopBefore statistics = do b <- shouldIdle d stopBefore if b then idle d >> return (Ready statistics) else return $ Stopped statistics
The first step in transitionFromNoMessage is calling shouldIdle. Thanks to Haskell's do notation, the b value is a simple Bool value that you can use to branch. If b is True, then first call idle and then return to the Ready state; otherwise, exit to the Stopped state.
Notice how PollingProgram values are composable. For instance, shouldIdle defines a small PollingProgram that can be (re)used in a bigger program, such as in transitionFromNoMessage.
Finally, from the ready state, the program can transition to three other states, so this is the most complex transition:
transitionFromReady :: NominalDiffTime -> UTCTime -> [CycleDuration] -> PollingProgram msg (PollingState msg) transitionFromReady estimatedDuration stopBefore statistics = do b <- shouldPoll estimatedDuration stopBefore statistics if b then do pollResult <- poll case pollResult of (Just msg, pd) -> return $ ReceivedMessage statistics pd msg (Nothing , pd) -> return $ NoMessage statistics pd else return $ Stopped statistics
Like transitionFromNoMessage, the transitionFromReady function first calls a supporting function (this time shouldPoll) in order to make a decision. If b is False, the next state is Stopped; otherwise, the program moves on to the next step.
The program polls for a message using the poll helper function defined above. While poll is a PollingProgram msg (Maybe msg, PollDuration) value, thanks to do notation, pollResult is a Maybe msg, PollDuration value. Matching on that value requires you to handle two separate cases: If a message was received (Just msg), then return a ReceivedMessage state with the message. Otherwise (Nothing), return a NoMessage state.
With those four functions you can now define a function that can transition from any input state:
transition :: NominalDiffTime -> IdleDuration -> UTCTime -> PollingState msg -> PollingProgram msg (PollingState msg) transition estimatedDuration idleDuration stopBefore state = case state of Ready stats -> transitionFromReady estimatedDuration stopBefore stats ReceivedMessage stats pd msg -> transitionFromReceived stats pd msg NoMessage stats _ -> transitionFromNoMessage idleDuration stopBefore stats Stopped stats -> transitionFromStopped stats
The transition function simply pattern-matches on the input state and delegates to each of the four above transition functions.
A short philosophical interlude #
All code so far has been pure, although it may not look that way. At this stage, it may be reasonable to pause and consider: what's the point, even?
After all, when interpreted, a PollingProgram can (and, in reality, almost certainly will) have impure behaviour. If we create an entire executable upon this abstraction, then we've essentially developed a big program with impure behaviour...
Indeed we have, but the alternative would have been to write it all in the context of IO. If you'd done that, then you'd allow any non-deterministic, side-effecty behaviour anywhere in your program. At least with a PollingProgram, any reader will quickly learn that only a maximum of four impure operations can happen. In other words, you've managed to control and restrict the impurity to exactly those interactions you want to model.
Not only that, but the type of impurity is immediately visible as part of a value's type. In a later article, you'll see how different impure interaction APIs can be composed.
Interpretation #
At this point, you have a program in the form of an AST. How do you execute it?
You write an interpreter:
interpret :: PollingProgram Message a -> IO a interpret program = case runFree program of Pure r -> return r Free (CurrentTime next) -> getCurrentTime >>= interpret . next Free (Poll next) -> pollImp >>= interpret . next Free (Handle msg next) -> handleImp msg >>= interpret . next Free (Idle d next) -> idleImp d >>= interpret . next
When you turn a functor into a monad using the Free constructor (see above), your functor is wrapped in a general-purpose sum type with two cases: Pure and Free. Your functor is always contained in the Free case, whereas Pure is the escape hatch. This is where you return the value of the entire computation.
An interpreter must match both Pure and Free. Pure is easy, because you simply return the result value.
In the Free case, you'll need to match each of the four cases of PollingInstruction. In all four cases, you invoke an impure implementation function, pass its return value to next, and finally recursively invoke interpret with the value returned by next.
Three of the implementations are details that aren't of importance here, but if you want to review them, the entire source code for this article is available as a gist. The fourth implementation is the built-in getCurrentTime function. They are all impure; all return IO values. This also implies that the return type of the entire interpret function is IO a.
This particular interpreter is impure, but nothing prevents you from writing a pure interpreter, for example for use in unit testing.
Execution #
You're almost done. You have a function that returns a new state for any given input state, as well as an interpreter. You need a function that can repeat this in a loop until it reaches the Stopped state:
run :: NominalDiffTime -> IdleDuration -> UTCTime -> PollingState Message -> IO (PollingState Message) run estimatedDuration idleDuration stopBefore state = do ns <- interpret $ transition estimatedDuration idleDuration stopBefore state case ns of Stopped _ -> return ns _ -> run estimatedDuration idleDuration stopBefore ns
This recursive function calls transition with the input state. You may recall that transition returns a PollingProgram msg (PollingState msg) value. Passing this value to interpret returns an IO (PollingState Message) value, and because of the do notation, the new state (ns) is a PollingState Message value.
You can now pattern match on ns. If it's a Stopped value, you return the value. Otherwise, you recursively call run once more.
The run function keeps doing this until it reaches the Stopped state.
Finally, then, you can write the entry point for the program:
main :: IO () main = do timeAtEntry <- getCurrentTime let estimatedDuration = 2 let idleDuration = IdleDuration 5 let stopBefore = addUTCTime 60 timeAtEntry s <- run estimatedDuration idleDuration stopBefore $ Ready [] timeAtExit <- getCurrentTime putStrLn $ "Elapsed time: " ++ show (diffUTCTime timeAtExit timeAtEntry) putStrLn $ printf "%d message(s) handled." $ report s
It defines the initial input parameters:
- My wild guess about the handle duration is 2 seconds
- I'd like the idle duration to be 5 seconds
- The program should run for 60 seconds
Ready []. These are all the arguments you need to call run.
Once run returns, you can print the number of messages handled using a (trivial) report function that I haven't shown (but which is available in the gist).
If you run the program, it'll produce output similar to this:
Polling Handling Polling Handling Polling Handling Polling Sleeping Polling Handling Polling Sleeping Polling Handling Polling Handling Polling Sleeping Polling Sleeping Polling Sleeping Polling Sleeping Polling Sleeping Polling Handling Polling Handling Polling Handling Polling Handling Polling Sleeping Polling Elapsed time: 56.6835022s 10 message(s) handled.
It does, indeed, exit before 60 seconds have elapsed.
Summary #
You can model long-running interactions with an Abstract Syntax Tree. Without do notation, writing programs as 'raw' ASTs would be cumbersome, but turning the AST into a (free) monad makes it all quite palatable.
Haskell's sophisticated type system makes this a fairly low-hanging fruit, once you understand how to do it. You can also port this type of design to F#, although, as you shall see next, more boilerplate is required.
Next: Pure times in F#.
Comments
Good introduction to the notion of programs-as-embedded-languages here, thanks for writing it!
In my experience a majority of Free interpreters fit into the foldFree pattern. Saves you the repetitous bits of your interpret function:
interpret = foldFree eta
where eta (CurrentTime k) = k <$> getCurrentTime
eta (Poll k) = k <$> pollImp
eta (Handle msg k) = k <$> handleImp msg
eta (Idle d k) = k <$> idleImp d
Anyway, I just wanted to give an alternative viewpoint on the topic of Free which will hopefully be some food for thought. I'm generally not an advocate of the Free approach to modelling effectful computation. I don't think it has much of an advantage over the old fashioned mtl style, especially since you have only one effect and only one interpreter. I'd have written your interface like this:
class Monad m => MonadPoll msg m | m -> msg where
currentTime :: m UTCTime
poll :: m (Maybe msg, PollDuration)
handle :: msg -> m HandleDuration
idle :: m IdleDuration
transitionFromNoMessage :: MonadPoll msg m => IdleDuration -> UTCTime -> [CycleDuration] -> m (PollingState msg)
transitionFromNoMessage d stopBefore statistics = do
b <- shouldIdle d stopBefore
if b
then idle d >> return (Ready statistics)
else return $ Stopped statistics
It's a clearer, more direct expression of the monadic interface, in my opinion, and it admits simpler implementations (and it's faster because GHC can specialise and inline everything). Computations with access to only a MonadPoll context can only perform polling actions, so it's still pure, and you can swap out different implementations of MonadPoll (eg, for testing) by writing types with different instances. You can do eg this if you need "decorator"-style interpreters. The main downside of the mtl style is the "n^2 instances problem" (though GeneralizedNewtypeDeriving does somewhat ease the pain).
Kiselyov has some good lecture notes about using the mtl style to model abstract syntax trees and compositional interpreters. I probably wouldn't go that far if I were building a compiler! Type classes are good at effect systems and algebraic data types are good at syntax trees, and while each job can be done by either it pays to pick your tools carefully.
Having said all that, the Free approach is probably more attractive in F#, because it doesn't feature type classes or higher kinds. And Free has other uses outside of the world of effect systems.
Hope all the above is interesting to you!
Benjamin
Benjamin, thank you for writing. It is, indeed, interesting to me, and I appreciate that you took the time to write such a helpful and concise comment.
I wasn't aware of foldFree, but I can see that I'll have to look into it.
One day (soon), I'll have to try writing a small Haskell program using the mtl style instead. It looks as though the code would be quite similar, although the types are different. Are these approaches isomorphic?
In any case, I hope that I'm not coming off as being too authoritative. In some sense, this blog often serves as my own elaborate journal documenting what I've been learning recently. I hope that what I write is mostly correct, but I don't presume that what I write is the one and only truth; it's bound by my knowledge at the time of writing. I still have much to learn, and I'm always happy when people help me expand my horizon.
I think that you hit the nail concerning F#. One of my motivations for exploring this space was to figure out what can be done in F#. As far as I can tell, the mtl style doesn't translate well to F#. You can debate whether or not free monads translate well to F#, but at least the concept does carry over.
Yep, they're isomorphic, in that you can round-trip in either direction between the two representations - to . from = from . to = id:
instance MonadPoll msg (Free (PollingInstruction msg)) where
currentTime = liftF (CurrentTime id)
poll = liftF (Poll id)
handle msg = liftF (Handle msg id)
idle d = liftF (Idle d id)
to :: (forall m. MonadPoll msg m => m a) -> Free (PollingInstruction msg) a
to x = x
from :: MonadPoll msg m => Free (PollingInstruction msg) a -> m a
from x = foldFree eta
where eta (CurrentTime k) = k <$> currentTime
eta (Poll k) = k <$> poll
eta (Handle msg k) = k <$> handle msg
eta (Idle d k) = k <$> idle d
But the representations being isomorphic doesn't mean they're equally convenient. (Another example of this would be lenses: van Laarhoven lenses (Ã la lens) are isomorphic to "costate comonad coalgebra" (ie get/set) lenses, but they're much more composable.)
Benjamin
Benjamin, thank you once again for writing. It's amazing that not only are they isomorphic, but you can actually prove it with code. I have to admit, though, that I haven't tried compiling or running your code yet. First, I need to digest this.
I was never under the impression that I knew most of what there was to know, but by Jove!, poking at Haskell unearths fathomless depths of knowledge of which I still only glance the surface. It's occasionally frustrating, but mostly exhilarating.
Pure times
How to interact with the system clock using strict functional programming.
A couple of years ago, I published an article called Good times with F#. Unfortunately, that article never lived up to my expectations. Not that I don't have a good time with F# (I do), but the article introduced an attempt to model execution durations of operations in a functional manner. The article introduced a Timed<'a> generic type that I had high hopes for.
Later, I published a Pluralsight course called Type-Driven Development with F#, in which I used Timed<'a> to implement a Polling Consumer. It's a good course that teaches you how to let F#'s type system give you rapid feedback. You can read a few articles that highlight the important parts of the course.
There's a problem with the implementation, though. It's not functional.
It's nice F# code, but F# is this friendly, forgiving, multi-paradigmatic language that enables you to get real work done. If you want to do this using partial application as a replacement for Dependency Injection, it'll let you. It is, however, not functional.
Consider, as an example, this function:
// (Timed<TimeSpan list> -> bool) -> (unit -> Timed<'a>) -> Timed<TimeSpan list> // -> State let transitionFromNoMessage shouldIdle idle nm = if shouldIdle nm then idle () |> Untimed.withResult nm.Result |> ReadyState else StoppedState nm.Result
The idle function has the type unit -> Timed<'a>. This can't possibly be a pure function, since a deterministic function can't produce a value from nothing when it doesn't know the type of the value. (In F#, this is technically not true, since we could return null for all reference types, and 'zero' for all value types, but even so, it should be clear that we can't produce any useful return value in a deterministic manner.)
The same argument applies, in weaker form, to the shouldIdle function. While it is possible to write more than one pure function with the type Timed<TimeSpan list> -> bool, the intent is that it should look at the time statistics and the current time, and decide whether or not it's 'safe' to poll again. Getting the current time from the system clock is a non-deterministic operation.
Ever since I discovered that Dependency Injection is impossible in functional programming, I knew that I had to return to the Polling Consumer example and show how to implement it in a truly functional style. In order to be sure that I don't accidentally call an impure function from a 'pure' function, I'll first rewrite the Polling Consumer in Haskell, and afterwards translate the Haskell code to F#. When reading, you can skip the Haskell article and go directly to the F# article, or vice versa, if you like.
Next: Pure times in Haskell.
Fractal trees with PureScript
A fractal tree drawn with PureScript
Last week, I attended Mathias Brandewinder's F# (and Clojure) dojo in Copenhagen, and had great fun drawing a fractal tree in F# together with other attendees. Afterwards, I started thinking that it'd be fairly easy to port the F# code to Haskell, but then I reconsidered. The combination of Haskell, Windows, and drawing sounded intimidating. This seemed a good opportunity to take PureScript for a spin, because that would enable me to draw the tree on an HTML canvas.
In case you're wondering, a fractal tree is simply a tree that branches infinitely in (I suppose) a deterministic fashion. Here's an example of the output of the code of this article:
This is my first attempt at PureScript, and I think I spent between five and ten hours in total. Most of them I used to figure out how to install PureScript, how to set up a development environment, and so on. All in all I found the process pleasing.
While it's a separate, independent language, PureScript is clearly a descendant of Haskell, and the syntax is similar.
Separating data from effects #
In functional programming, you routinely separate data from effects. Instead of trying to both draw and calculate branches of a tree in a single operation, you figure out how to first define a fractal tree as data, and then subsequently you can draw it.
A generic binary tree is a staple of functional programming. Here's one way to do it:
data Tree a = Leaf a | Node a (Tree a) (Tree a)
Such a tree is either a leaf node with a generically typed value, or an (intermediate) node with a value and two branches, which are themselves (sub)trees.
In a sense, this definition is an approximation, because a 'real' fractal tree has no leafs. In Haskell you can easily define infinite trees, because Haskell is lazily evaluated. PureScript, on the other hand, is eagerly evaluated, so infinite recursion would require jumping through some hoops, and I don't think it's important in this exercise.
While the above tree type can contain values of any type, in this exercise, it should contain line segments. One way to do this is to define a Line record type:
data Line = Line { x :: Number, y :: Number, angle :: Number, length :: Number, width :: Number }
This is a type with five labelled values, all of them numbers. x and y are coordinates for the origin of the line, angle defines the angle (measured in radians) from the origin, and length the length of the line. In a similarly obvious vein, width denotes the width of the line, although this data element has no impact on the calculation of the tree. It's purely a display concern.
Given the first four numbers in a Line value, you can calculate the endpoint of a line:
endpoint :: forall r. { x :: Number , y :: Number , angle :: Number , length :: Number | r } -> Tuple Number Number endpoint line = -- Flip the y value because Canvas coordinate system points down from upper -- left corner Tuple (line.x + line.length * cos line.angle) (-(-line.y + line.length * sin line.angle))
This may look more intimidating than it really is. The first seven lines are simply the (optional) type declaration; ignore that for a minute. The function itself is a one-liner, although I've formatted it on several lines in order to stay within an 80 characters line width. It simply performs a bit of trigonometry in order to find the endpoint of a line with an origin, angle, and length. As the code comment states, it negates the y value because the HTML canvas coordinate system points down instead of up (larger y values are further towards the bottom of the screen than smaller values).
The function calculates a new set of coordinates for the endpoint, and returns them as a tuple. In PureScript, tuples are explicit and created with the Tuple data constructor.
In general, as far as I can tell, you have less need of tuples in PureScript, because instead, you have row type polymorphism. This is still a new concept to me, but as far as I can tell, it's a sort of static duck typing. You can see it in the type declaration of the endpoint function. The function takes a line argument, the type of which is any record type that contains x, y, angle, and length labels of the Number type. For instance, as you'll soon see, you can pass a Line value to the endpoint function.
Creating branches #
In a fractal tree, you calculate two branches for any given branch. Typically, in order to draw a pretty picture, you make the sub-branches smaller than the parent branch. You also incline each branch an angle from the parent branch. While you can hard-code the values for these operations, you can also pass them as arguments. In order to prevent an explosion of primitive function arguments, I collected all such parameters in a single data type:
data FractalParameters = FractalParameters { leftAngle :: Number, rightAngle :: Number, shrinkFactor :: Number }
This is a record type similar to the Line type you've already seen.
When you have a FractalParameters value and a (parent) line, you can calculate its branches:
createBranches :: FractalParameters -> Line -> Tuple Line Line createBranches (FractalParameters p) (Line line) = Tuple left right where Tuple x y = endpoint line left = Line { x: x, y: y, angle: pi * (line.angle / pi + p.leftAngle), length: (line.length * p.shrinkFactor), width: (line.width * p.shrinkFactor) } right = Line { x: x, y: y, angle: pi * (line.angle / pi - p.rightAngle), length: (line.length * p.shrinkFactor), width: (line.width * p.shrinkFactor) }
The createBranches function returns a tuple of Line values, one for the left branch, and one for the right branch. First, it calls endpoint with line. Notice that line is a Line value, and because Line defines x, y, angle, and length labels, it can be used as an input argument. This type-checks because of row type polymorphism.
Given the endpoint of the parent line, createBranches then creates two new Line values (left and right) with that endpoint as their origins. Both of these values are modified with the FractalParameters argument, so that they branch off to the left and the right, and also shrink in an aesthetically pleasing manner.
Creating a tree #
Now that you can calculate the branches of a line, you can create a tree using recursion:
createTree :: Int -> FractalParameters -> Line -> Tree Line createTree depth p line = if depth <= 0 then Leaf line else let Tuple leftLine rightLine = createBranches p line left = createTree (depth - 1) p leftLine right = createTree (depth - 1) p rightLine in Node line left right
The createTree function takes a depth argument, which specifies the depth (or is it the height?) of the tree. The reason I called it depth is because createTree is recursive, and depth controls the depth of the recursion. If depth is zero or less, the function returns a Leaf node containing the input line.
Otherwise, it calls createBranches with the input line, and recursively calls createTree for each of these branches, but with a decremented depth. It then returns a Node containing the input line and the two sub-trees left and right.
This implementation isn't tail-recursive, but the above image was generated with a recursion depth of only 10, so running out of stack space wasn't my biggest concern.
Drawing the tree #
With the createTree function you can create a fractal tree, but it's no fun if you can't draw it. You can use the Graphics.Canvas module in order to draw on an HTML canvas. First, here's how to draw a single line:
drawLine :: Context2D -> Line -> Eff (canvas :: CANVAS) Unit drawLine ctx (Line line) = do let Tuple x' y' = endpoint line void $ strokePath ctx $ do void $ moveTo ctx line.x line.y void $ setLineWidth line.width ctx void $ lineTo ctx x' y' closePath ctx
While hardly unmanageable, I was surprised that I wasn't able to find a pre-defined function that would let me draw a line. Perhaps I was looking in the wrong place.
With this helper function, you can now draw a tree using pattern matching:
drawTree :: Context2D -> Tree Line -> Eff (canvas :: CANVAS) Unit drawTree ctx (Leaf line) = drawLine ctx line drawTree ctx (Node line left right) = do drawLine ctx line drawTree ctx left drawTree ctx right
If the input tree is a Leaf value, the first line matches and the function simply draws the line, using the drawLine function.
When the input tree is a Node value, the function first draws the line associated with that node, and then recursively calls itself with the left and right sub-trees.
Execution #
The drawTree function enables you to draw using a Context2D value, which you can create from an HTML canvas:
mcanvas <- getCanvasElementById "canvas" let canvas = unsafePartial (fromJust mcanvas) ctx <- getContext2D canvas
From where does the "canvas" element come? Ultimately, PureScript compiles to JavaScript, and you can put the compiled script in an HTML file together with a canvas element:
<body> <canvas id="canvas" width="800" height="800"></canvas> <script src="index.js" type="text/javascript"></script> </body>
Once you have a Context2D value, you can draw a tree. Here's the whole entry point, including the above canvas-finding code:
main :: Eff (canvas :: CANVAS) Unit main = do mcanvas <- getCanvasElementById "canvas" let canvas = unsafePartial (fromJust mcanvas) ctx <- getContext2D canvas let trunk = Line { x: 300.0, y: 600.0, angle: (pi / 2.0), length: 100.0, width: 4.0 } let p = FractalParameters { leftAngle: 0.1, rightAngle: 0.1, shrinkFactor: 0.8 } let tree = createTree 10 p trunk drawTree ctx tree
After it finds the Context2D value, it hard-codes a trunk Line and a set of FractalParameters. From these, it creates a tree of size 10 and draws the tree in the beginning of this article.
You can fiddle with the parameters to your liking. For example, you can make the right angle wider than the left angle:
let p = FractalParameters { leftAngle: 0.1, rightAngle: 0.2, shrinkFactor: 0.8 }
This produces an asymmetric tree:
In order to compile the code, I used this command:
$ pulp browserify -t html/index.js
This compiles the PureScript code to a single index.js file, which is output to the html directory. This directory also contains the HTML file with the canvas.
You can find the entire PureScript file in this Gist.
Summary #
It was fun to try PureScript. I've been staying away from JavaScript-based development for many years now, but if I ever have to do some client-side development, I may consider it. So far, I've found that PureScript seems viable for drawing. How good it is if you need to interact with 'normal' web-pages or SPAs, I don't know (yet).
If you have some experience with Haskell, it looks like it's easy to get started with PureScript.
Using Polly with F# async workflows
How to use Polly as a Circuit Breaker in F# async workflows.
Release It! describes a stability design pattern called Circuit Breaker, which is used to fail fast if a downstream service is experiencing problems.
I recently had to add a Circuit Breaker to an F# async workflow, and although Circuit Breaker isn't that difficult to implement (my book contains an example in C#), I found it most prudent to use an existing implementation. Polly seemed a good choice.
In my F# code base, I was already working with an 'abstraction' of the type HttpRequestMessage -> Async<HttpResponseMessage>: given an HttpClient called client, the implementation is as simple as client.SendAsync >> Async.AwaitTask. Since SendAsync can throw HttpRequestException or WebException, I wanted to define a Circuit Breaker policy for these two exception types.
While Polly supports policies for Task-based APIs, it doesn't automatically work with F# async workflows. The problem is that whenever you convert an async workflow into a Task (using Async.AwaitTask), or a Task into an async workflow (using Async.StartAsTask), any exceptions thrown will end up buried within an AggregateException. In order to dig them out again, I first had to write this function:
// Exception -> bool let rec private isNestedHttpException (e : Exception) = match e with | :? AggregateException as ae -> ae.InnerException :: Seq.toList ae.InnerExceptions |> Seq.exists isNestedHttpException | :? HttpRequestException -> true | :? WebException -> true | _ -> false
This function recursively searches through all inner exceptions of an AggregateException and returns true if it finds one of the exception types I'm interested in handling; otherwise, it returns false.
This predicate enabled me to write the Polly policy I needed:
open Polly // int -> TimeSpan -> CircuitBreaker.CircuitBreakerPolicy let createPolicy exceptionsAllowedBeforeBreaking durationOfBreak = Policy .Handle<AggregateException>(fun ae -> isNestedHttpException ae) .CircuitBreakerAsync(exceptionsAllowedBeforeBreaking, durationOfBreak)
Since Polly exposes an object-oriented API, I wanted a curried alternative, so I also wrote this curried helper function:
// Policy -> ('a -> Async<'b>) -> 'a -> Async<'b> let private execute (policy : Policy) f req = policy.ExecuteAsync(fun () -> f req |> Async.StartAsTask) |> Async.AwaitTask
The execute function executes any function of the type 'a -> Async<'b> with a Polly policy. As you can see, there's some back-and-forth between Tasks and async workflows, so this is probably not the most efficient Circuit Breaker ever configured, but I wagered that since the underlying operation was going to involve an HTTP request and response, the overhead would be insignificant. No one has complained yet.
When Polly opens the Circuit Breaker, it throws an exception of the type BrokenCircuitException. Again because of all the marshalling, this also gets wrapped within an AggregateException, so I had to write another function to unwrap it:
// Exception -> bool let rec private isNestedCircuitBreakerException (e : Exception) = match e with | :? AggregateException as ae -> ae.InnerException :: Seq.toList ae.InnerExceptions |> Seq.exists isNestedCircuitBreakerException | :? CircuitBreaker.BrokenCircuitException -> true | _ -> false
The isNestedCircuitBreakerException is similar to isNestedHttpException, so it'd be tempting to refactor. I decided, however, to rely on the rule of three and leave both functions as they were.
In my F# code I prefer to handle application errors using Either values instead of relying on exceptions, so I wanted to translate any BrokenCircuitException to a particular application error. With the above isNestedCircuitBreakerException predicate, this was now possible with a try/with expression:
// Policy -> ('a -> Async<'b>) -> 'a -> Async<Result<'b, BoundaryFailure>> let sendUsingPolicy policy send req = async { try let! resp = req |> execute policy send return Result.succeed resp with e when isNestedCircuitBreakerException e -> return Result.fail Controllers.StabilityFailure }
This function takes a policy, a send function that actually sends the request, and the request to send. If all goes well, the response is lifted into a Success case and returned. If the Circuit Breaker is open, a StabilityFailure value is returned instead.
Since the with expression uses an exception filter, all other exceptions will still be thrown from this function.
It might still be worthwhile to look into options for a more F#-friendly Circuit Breaker. One option would be to work with the Polly maintainers to add such an API to Polly itself. Another option would be to write a separate F# implementation.
Comments
There are two minor points I want to address: * I think instead of the recursive search for a nested exception you can use AggregateException.Flatten() |> Seq.exists ...
* And I know that you know that a major difference between
Async and Task is that a Task is typically started whereas an Async is not.
So it might be irritating that calling execute already starts the execution. If you wrapped the body of execute inside another async block it would be lazy as usual, I think.
Simple holidays
A story about arriving at the simplest solution that could possibly work.
The Zen of Python states: Simple is better than complex. If I've met a programmer who disagrees with that, I'm not aware of it. It's hardly a controversial assertion, but what does 'simplicity' mean? Can you even identify a simple solution?
I often see software developers defaulting to complex solutions, because a simpler solution isn't immediately obvious. In retrospect, a simple solution often is obvious, but only once you've found it. Until then, it's elusive.
I'd like to share a story in which I arrived at a simple solution after several false starts. I hope it can be an inspiration.
Dutch holidays #
Recently, I had to write some code that takes into account Dutch holidays. (In order to address any confusion that could arise from this: No, I'm not Dutch, I'm Danish, but currently, I'm doing some work on a system targeting a market in the Netherlands.) Specifically, given a date, I had to find the latest possible Dutch bank day on or before that date.
For normal week days (Monday to Friday), it's easy, because such a date is already a bank date. In other words, in that case, you can simply return the input date. Also, in normal weeks, given a Saturday or Sunday, you should return the preceding Friday. The problem is, however, that some Fridays are holidays, and therefore not bank days.
Like many other countries, the Netherlands have complicated rules for determining official holidays. Here are some tricky parts:
- Some holidays always fall on the same date. One example is Bevrijdingsdag (Liberation Day), which always falls on May 5. This holiday celebrates a historic event (the end of World War II in Europe), so if you wanted to calculate bank holidays in the past, you'd have to figure out in which year this became a public holiday. Surely, at least, it must have been 1945 or later.
- Some holidays fall on specific week days. The most prominent example is Easter, where Goede Vrijdag (Good Friday) always (as the name implies) falls on a Friday. Which Friday exactly can be calculated using a complicated algorithm.
- One holiday (Koningsdag (King's Day)) celebrates the king's birthday. The date is determined by the currently reigning monarch's birthday, and it's called Queen's Day when the reigning monarch is a queen. Obviously, the exact date changes depending on who's king or queen, and you can't predict when it's going to change. And what will happen if the current monarch abdicates or dies before his or her birthday, but after the new monarch's birthday? Does that mean that there will be no such holiday that year? Or what about the converse? Could there be two such holidays if a monarch abdicates after his or her birthday, and the new monarch's birthday falls later the same year?
Figuring out if a date is a bank day, then, is what you might call an 'interesting' problem. How would you solve it? Before you read on, take a moment to consider how you'd attempt to solve the problem. If you will, you can consider the test cases immediately below to get a better sense of the problem.
Test cases #
Here's a small set of test cases that I wrote in order to describe the problem:
| Test case | Input date | Expected output |
|---|---|---|
| Monday | 2017-03-06 | 2017-03-06 |
| Tuesday | 2017-03-07 | 2017-03-07 |
| Wednesday | 2017-03-08 | 2017-03-08 |
| Thursday | 2017-03-09 | 2017-03-09 |
| Friday | 2017-03-10 | 2017-03-10 |
| Saturday | 2017-03-11 | 2017-03-10 |
| Sunday | 2017-03-12 | 2017-03-10 |
| Good Friday | 2017-04-14 | 2017-04-13 |
| Saturday after Good Friday | 2017-04-15 | 2017-04-13 |
| Sunday after Good Friday | 2017-04-16 | 2017-04-13 |
| Easter Monday | 2017-04-17 | 2017-04-13 |
| Ascension Day - Thursday | 2017-05-25 | 2017-05-24 |
| Whit Monday | 2110-05-26 | 2110-05-23 |
| Liberation Day | 9713-05-05 | 9713-05-04 |
Option: query a third-party service #
How would you solve the problem? The first solution that occurred to me was to use a third-party service. My guess is that most developers would consider this option. After all, it's essentially third-part data. The official holidays are determined by a third party, in this case the Dutch state. Surely, some Dutch official organisation would publish the list of official holidays somewhere. Perhaps, if you're lucky, there's even an on-line service you can query in order to download the list of holidays in some machine-readable format.
There are, however, problems with this alternative: if you query such a service each time you need to find an appropriate bank date, how are you going to handle network errors? What if the third-part service is (temporarily) unavailable?
Since I'm trying to figure out bank dates, you may already have guessed that I'm handling money, so it's not desirable to simple throw an exception and say that a caller would have to try again later. This could lead to loss of revenue.
Querying a third-party service every time you need to figure out a Dutch bank holiday is out of the question for that reason. It's also likely to be inefficient.
Option: cache third-party data #
Public holidays rarely change, so your next attempt could be a variation of the previous. Use third-party data, but instead of querying a third-party service every time you need the information, cache it.
The problem with caching is that you're not guaranteed that the data you seek is in the cache. At application start, caches are usually empty. You'd have to rely on making one good query to the third-party data source in order to put the data in the cache. Only if that succeeds can you use the cache. This, again, leaves you vulnerable to the normal failure modes of distributed computing. If you can't reach the third-party data source, you have nothing to put in the cache.
This can be a problem at application start, or when the cache data expires.
Using a cache reduces the risk that the data is unavailable, but it doesn't eliminate it. It also adds complexity in the form of a cache that has to be configured and managed. Granted, you can use a reusable cache library or service to minimise that cost, so it may not be a big deal. Still, when making a decision about application architecture, I think it helps to explicitly identify advantages and disadvantages.
Using a cache felt better to me, but I still wasn't happy. Too many things could go wrong.
Option: persistent cache #
An incremental improvement on the previous option would be to write the cache data to persistent storage. This takes care of the issue with the cache being empty at application start-up. You can even deal with cache expiry by keep using stale data if you can't reach the 'official' source of the data.
It leaves me a bit concerned, though, because if you allow the system to continue working with stale data, perhaps the application could enter a state where the data never updates. This could happen if the official data source moves, or changes format. In such a case, your application would keep trying to refresh the cache, and it would permanently fail. It would permanently run with stale data. Would you ever discover that problem?
My concern is that the application could silently fail. You could counter that by logging a warning somewhere, but that would introduce a permanent burden on the team responsible for operating the application. This isn't impossible, but it does constitute an extra complexity. This alternative still didn't feel good to me.
Option: cron #
Because I wasn't happy with any of the above alternatives, I started looking for different approaches to the problem. For a short while, I considered using a .NET implementation of cron, with a crontab file. As far as I can tell, though there's no easy way to define Easter using cron, so I quickly abandoned that line of inquiry.
Option: Nager.Date #
I wasn't entirely done with idea of calculating holidays on the fly. While calculating Easter is complicated, it can be done; there is a well-defined algorithm for it. Whenever I run into a general problem like this, I assume that someone has already done the required work, and this is also the case here. I quickly found an open source library called Nager.Date; I'm sure that there are other alternatives, but Nager.Date looks like it's more than good enough.
Such a library would be able to calculate all holidays for a given year, based on the algorithms embedded in it. That looked really promising.
And yet... again, I was concerned. Official holidays are, as we've already established, politically decided. Using an algorithmic approach is fundamentally wrong, because that's not really how the holidays are determined. Holidays are defined by decree; it just so happens that some of the decrees take the form of an algorithm (such as Easter).
What would happen if the Dutch state decides to add a new holiday? Or to take one away? Of when a new monarch is crowned? In order to handle such changes, we'd now have to hope that Nager.Date would be updated. We could try to make that more likely to happen by sending a pull request, but we'd still be vulnerable to a third party. What if the maintainer of Nager.Date is on vacation?
Even if you can get a change into a library like Nager.Date, how is the algorithmic approach going to deal with historic dates? If the monarch changes, you can update the library, but does it correctly handle dates in the past, where the King's Day was different?
Using an algorithm to determine a holiday seemed promising, but ultimately, I decided that I didn't like this option either.
Option: configuration file #
My main concern about using an algorithm is that it'd make it difficult to handle arbitrary changes and exceptional cases. If we'd use a configuration file, on the other hand, we could always edit the configuration file in order to add or remove holidays for a given year.
In essence, I was envisioning a configuration file that simply contained a list of holidays for each year.
That sounds fairly simple and maintainable, but from where should the data come?
You could probably download a list of official holidays for the next few years, like 2017, 2018, 2019, and so on, but the list would be finite, and probably not cover more than a few years into the future.
What if, for example, I'd only be able to find an official list that goes to 2020? What will happen, then, when our application enters 2021? To the rest of the code base, it'd look like there were no holidays in 2021.
At this time we can expect that new official lists have been published, so a programmer could obtain such a list and update the configuration file when it's time. This, unfortunately, is easy to forget. Four years in the future, perhaps none of the original programmers are left. It's more than likely that no one will remember to do this.
Option: algorithm-generated configuration file #
The problem that the configuration data could 'run out' can be addressed by initialising the configuration file with data generated algorithmically. You could, for example, ask Nager.Date to generate all the holidays for the next many years. In fact, the year 9999 is the maximum year handled by .NET's System.DateTime, so you could ask it to generate all the holidays until 9999.
That sounds like a lot, but it's only about half a megabyte of data...
This solves the problem of 'running out' of holiday data, but still enables you to edit the holiday data when it changes in the future. For example, if the King's Day changes in 2031, you can change all the King's Day values from 2031 onward, while retaining the correct values for the previous years.
This seems promising...
Option: hard-coded holidays #
I almost decided to use the previous, configuration-based solution, and I was getting ready to invent a configuration file format, and a reader for it, and so on. Then I recalled Mike Hadlow's article about the configuration complexity clock.
I'm fairly certain that the only people who would be editing a hypothetical holiday configuration file would be programmers. In that case, why put the configuration in a proprietary format? Why deal with the hassle of reading and parsing such a file? Why not put the data in code?
That's what I decided to do.
It's not a perfect solution. It's still necessary to go and change that code file when the holiday rules change. For example, when the King's Day changes, you'd have to edit the file.
Still, it's the simplest solution I could come up with. It has no moving parts, and uses a 'best effort' approach in order to guarantee that holidays will always be present. If you can come up with a better alternative, please leave a comment.
Data generation #
Nager.Date seemed useful for generating the initial set of holidays, so I wrote a small F# script that generated the necessary C# code snippets:
#r @"packages/Nager.Date.1.3.0/lib/net45/Nager.Date.dll" open System.IO open Nager.Date let formatHoliday (h : Model.PublicHoliday) = let y, m, d = h.Date.Year, h.Date.Month, h.Date.Day sprintf "new DateTime(%i, %2i, %2i), // %s/%s" y m d h.Name h.LocalName let holidays = [2017..9999] |> Seq.collect (fun y -> DateSystem.GetPublicHoliday (CountryCode.NL, y)) |> Seq.map formatHoliday File.WriteAllLines (__SOURCE_DIRECTORY__ + "/dutch-holidays.txt", holidays)
This script simply asks Nager.Date to calculate all Dutch holidays for the years 2017 to 9999, format them as C# code snippets, and write the lines to a text file. The size of that file is 4 MB, because the auto-generated code comments also take up some space.
First implementation attempt #
The next thing I did was to copy the text from dutch-holidays.txt to a C# code file, which I had already prepared with a class and a few methods that would query my generated data. The result looked like this:
public static class DateTimeExtensions { public static DateTimeOffset AdjustToLatestPrecedingDutchBankDay( this DateTimeOffset value) { var candidate = value; while (!(IsDutchBankDay(candidate.DateTime))) candidate = candidate.AddDays(-1); return candidate; } private static bool IsDutchBankDay(DateTime date) { if (date.DayOfWeek == DayOfWeek.Saturday) return false; if (date.DayOfWeek == DayOfWeek.Sunday) return false; if (dutchHolidays.Contains(date.Date)) return false; return true; } #region Dutch holidays private static DateTime[] dutchHolidays = { new DateTime(2017, 1, 1), // New Year's Day/Nieuwjaarsdag new DateTime(2017, 4, 14), // Good Friday/Goede Vrijdag new DateTime(2017, 4, 17), // Easter Monday/ Pasen new DateTime(2017, 4, 27), // King's Day/Koningsdag new DateTime(2017, 5, 5), // Liberation Day/Bevrijdingsdag new DateTime(2017, 5, 25), // Ascension Day/Hemelvaartsdag new DateTime(2017, 6, 5), // Whit Monday/Pinksteren new DateTime(2017, 12, 25), // Christmas Day/Eerste kerstdag new DateTime(2017, 12, 26), // St. Stephen's Day/Tweede kerstdag new DateTime(2018, 1, 1), // New Year's Day/Nieuwjaarsdag new DateTime(2018, 3, 30), // Good Friday/Goede Vrijdag // Lots and lots of dates... new DateTime(9999, 5, 6), // Ascension Day/Hemelvaartsdag new DateTime(9999, 5, 17), // Whit Monday/Pinksteren new DateTime(9999, 12, 25), // Christmas Day/Eerste kerstdag new DateTime(9999, 12, 26), // St. Stephen's Day/Tweede kerstdag }; #endregion }
My old computer isn't happy about having to compile 71,918 lines of C# in a single file, but it's doable, and as far as I can tell, Visual Studio caches the result of compilation, so as long as I don't change the file, there's little adverse effect.
Unit tests #
In order to verify that the implementation works, I wrote this parametrised test:
public class DateTimeExtensionsTests { [Theory] [InlineData("2017-03-06", "2017-03-06")] // Monday [InlineData("2017-03-07", "2017-03-07")] // Tuesday [InlineData("2017-03-08", "2017-03-08")] // Wednesday [InlineData("2017-03-09", "2017-03-09")] // Thursday [InlineData("2017-03-10", "2017-03-10")] // Friday [InlineData("2017-03-11", "2017-03-10")] // Saturday [InlineData("2017-03-12", "2017-03-10")] // Sunday [InlineData("2017-04-14", "2017-04-13")] // Good Friday [InlineData("2017-04-15", "2017-04-13")] // Saturday after Good Friday [InlineData("2017-04-16", "2017-04-13")] // Sunday after Good Friday [InlineData("2017-04-17", "2017-04-13")] // Easter Monday [InlineData("2017-05-25", "2017-05-24")] // Ascension Day - Thursday [InlineData("2110-05-26", "2110-05-23")] // Whit Monday [InlineData("9713-05-05", "9713-05-04")] // Liberation Day public void AdjustToLatestPrecedingDutchBankDayReturnsCorrectResult( string sutS, string expectedS) { var sut = DateTimeOffset.Parse(sutS); var actual = sut.AdjustToLatestPrecedingDutchBankDay(); Assert.Equal(DateTimeOffset.Parse(expectedS), actual); } }
All test cases pass. This works in [Theory], but unfortunately, it turns out, it doesn't work in practice.
When used in an ASP.NET Web API application, AdjustToLatestPrecedingDutchBankDay throws a StackOverflowException. It took me a while to figure out why, but it turns out that the stack size is smaller in IIS than when you run a 'normal' .NET process, such as an automated test.
System.DateTime is a value type, and as far as I can tell, it uses some stack space during initialisation. When the DateTimeExtensions class is first used, the static dutchHolidays array is initialised, and that uses enough stack space to exhaust the stack when running in IIS.
Final implementation #
The stack space problem seems to be related to DateTime initialisation. If I store a similar number of 64-bit integers in an array, it seems that there's no problem.
First, I had to modify the formatHoliday function:
let formatHoliday (h : Model.PublicHoliday) = let t, y, m, d = h.Date.Ticks, h.Date.Year, h.Date.Month, h.Date.Day sprintf "%19iL, // %i-%02i-%02i, %s/%s" t y m d h.Name h.LocalName
This enabled me to generate a new file with C# code fragments, but now containing ticks instead of DateTime values. Copying those C# fragments into my file gave me this:
public static class DateTimeExtensions { public static DateTimeOffset AdjustToLatestPrecedingDutchBankDay( this DateTimeOffset value) { var candidate = value; while (!(IsDutchBankDay(candidate.DateTime))) candidate = candidate.AddDays(-1); return candidate; } private static bool IsDutchBankDay(DateTime date) { if (date.DayOfWeek == DayOfWeek.Saturday) return false; if (date.DayOfWeek == DayOfWeek.Sunday) return false; if (dutchHolidays.Contains(date.Date.Ticks)) return false; return true; } #region Dutch holidays private static long[] dutchHolidays = { 636188256000000000L, // 2017-01-01, New Year's Day/Nieuwjaarsdag 636277248000000000L, // 2017-04-14, Good Friday/Goede Vrijdag 636279840000000000L, // 2017-04-17, Easter Monday/ Pasen 636288480000000000L, // 2017-04-27, King's Day/Koningsdag 636295392000000000L, // 2017-05-05, Liberation Day/Bevrijdingsdag 636312672000000000L, // 2017-05-25, Ascension Day/Hemelvaartsdag 636322176000000000L, // 2017-06-05, Whit Monday/Pinksteren 636497568000000000L, // 2017-12-25, Christmas Day/Eerste kerstdag 636498432000000000L, // 2017-12-26, St. Stephen's Day/Tweede kerstdag 636503616000000000L, // 2018-01-01, New Year's Day/Nieuwjaarsdag 636579648000000000L, // 2018-03-30, Good Friday/Goede Vrijdag // Lots and lots of dates... 3155171616000000000L, // 9999-05-06, Ascension Day/Hemelvaartsdag 3155181120000000000L, // 9999-05-17, Whit Monday/Pinksteren 3155372928000000000L, // 9999-12-25, Christmas Day/Eerste kerstdag 3155373792000000000L, // 9999-12-26, St. Stephen's Day/Tweede kerstdag }; #endregion }
That implementation still passes all tests, and works at in practice as well.
Conclusion #
It took me some time to find a satisfactory solution. I had more than once false start, until I ultimately arrived at the solution I've described here. I consider it simple because it's self-contained, deterministic, easy to understand, and fairly easy to maintain. I even left a comment in the code (not shown here) that described how to recreate the configuration data using the F# script shown here.
The first solution that comes into your mind may not be the simplest solution, but if you take some time to consider alternatives, you may save yourself and your colleagues some future grief.
Comments
What do you think about creating an "admin page" that would allow users to configure the bank holidays themselves (which would then be persisted in the application database)? This moves the burden of correctness to the administrators of the application, who I'm sure are highly motivated to get this right - as well as maintain it. It also removes the need for a deployment in the face of changing holidays.
For the sake of convenience, you could still "seed" the database with the values generated by your F# script
jadarnel27, thank you for writing. Your suggestion could be an option as well, but is hardly the simplest solution. In order to implement that, I'd need to add an administration web site for my application, program the user interface, connect the administration site and my original application (a REST API) to a persistent data source, write code for input validation, etcetera.
Apart from all that work, the bank holidays would have to be stored in an out-of-process data store, such as a database or NoSQL data store, because the REST API that needs this feature is running in a server farm. This adds latency to each lookup, as well as a potential error source. What should happen if the connection to the data store is broken? Additionally, such a data store should be backed up, so we'd also need to establish an operational procedure to ensure that that happens.
It was never a requirement that the owners of the application should be able to administer this themselves. It's certainly an option, but it's so much more complex than the solution outlined above that I think one should start by making a return-on-investment analysis.
Another option: Calculate the holidays! I think you might find som useful code in my HolidaysAPI. It is even in F#, and the Web project is based upon a course or blog post by you.
Alf, thank you for writing. Apart from the alternative library, how is that different from the option I covered under the heading Option: Nager.Date?
Great post, thanks. The minor point here is that it is probably not so effective to do Contains over long[]. I'd consider using something that can check the value existance faster.
EQR, thank you for writing. The performance profile of the implementation wasn't my main concern with this article, so it's likely that it can be improved.
I did do some lackadaisical performance testing, but didn't detect any measurable difference between the implementation shown here, and one using a HashSet. On the other hand, there are other options I didn't try at all. One of these could be to perform a binary search, since the array is already ordered.
Hi Mark, thanks for this post. One small note on your selection of bank holidays. Liberation day is an official bank holiday, but only for civil servants, for us 'normal' people this only happens every 5 years. This is reflected in Nager.Date wrong here
Thomas, thank you for writing. That just goes to show, I think, that holiday calculation is as complicated as any other 'business logic'. It should be treated as such, and not as an algorithmic calculation.
Comments
Here's an additional simplification. Rather than writing
FreeT ReservationsApiProgram CommandLineProgramwhich requires you to lift, you can instead form the sum (coproduct) of both functors:Now you can lift the helpers directly to
Program, like so:Then (after you change the types of the
read*helpers), you can drop alllifts fromtryReserve:tryReserve :: Program () tryReserve = do q <- readParse "Please enter number of diners:" "Not an Integer." d <- readParse "Please enter your desired date:" "Not a date." availableSeats <- (sum . fmap seatsLeft) <$> getSlots d if availableSeats < q then writeLine $ "Only " ++ show availableSeats ++ " remaining seats." else do n <- readAnything "Please enter your name:" e <- readAnything "Please enter your email address:" postReservation Reservation { reservationDate = d , reservationName = n , reservationEmail = e , reservationQuantity = q }And finally your interpreter needs to dispatch over
InL/InR(this is using functions fromControl.Monad.Free, you can actually drop theTransimport at this point):interpretCommandLine :: CommandLineInstruction (IO a) -> IO a interpretCommandLine (ReadLine next) = getLine >>= next interpretCommandLine (WriteLine line next) = putStrLn line >> next interpretReservationsApi :: ReservationsApiInstruction (IO a) -> IO a interpretReservationsApi (GetSlots zt next) = HttpClient.getSlots zt >>= next interpretReservationsApi (PostReservation r next) = HttpClient.postReservation r >> next interpret :: Program a -> IO a interpret program = iterM go program where go (InL cmd) = interpretCommandLine cmd go (InR res) = interpretReservationsApi resI find this to be quite clean!
George, thank you for writing. That alternative does, indeed, look simpler and cleaner than mine. Thank you for sharing.
FWIW, one reason I write articles on this blog is to learn and become better. I publish what I know and have learned so far, and sometimes, people tell me that there's a better way. That's great, because it makes me a better programmer, and hopefully, it may make other readers better as well.
In case you'll be puzzling over my next blog post, however, I'm going to share a little secret (which is not a secret if you look at the blog's commit history): I wrote this article series more than a month ago, which means that all the remaining articles are already written. While I agree that using the sum of functors instead of
FreeTsimplifies the Haskell code, I don't think it makes that much of a difference when translating to F#. I may be wrong, but I haven't tried yet. My point, though, is that the next article in the series is going to ignore this better alternative, because, when it was written, I didn't know about it. I invite any interested reader to post, as a comment to that future article, their better alternatives :)Hi Mark,
I think you'll enjoy Data Types a la Carte. It's the definitive introduction to the style that George Pollard demonstrates above. Swierstra covers how to build datatypes with initial algebras over coproducts, compose them abstracting over the concrete functor, and tear them down generically. It's well written, too 😉
Benjamin