The Printer Monad in Haskell

Posted on Fri 04 August 2017 in Code • Tagged with Haskell, Writer, monads, monad transformers, WriterTLeave a comment

Quite recently, I have encountered an interesting case of monad-based refactoring in Haskell.

Suppose you have a ComplicatedRecord that holds the results of some lengthy and important process in your program. You want to present that data to the user in a nicely formatted way, so you write a function which begins somewhat like this:

{-# LANGUAGE RecordWildcards #-}

-- | Pretty-print the content of the record.
ppRecord :: ComplicatedRecord -> IO ()
ppRecord ComplicatedRecord{..} = do
    -- ...

Inside, there is plenty of putStrLn calls, likely hidden inside more specific subfunctions that format all the numerous parts of ComplicatedRecord. But the IO monad isn’t there just for printing: because the code went through multiple iterations, some of this logic actually takes advantage of it by making additional system & network calls.

So yeah, it’s not particularly pretty.

Now, however, we find out that the output we’re printing here shouldn’t always go directly to stdout. In some cases, unsurprisingly, we actually want it back as a single string, without having it sent to the standard output at all.

Just $ return . it

Your first instinct here may be to simply give back the final string (well, Text) as the function result1:

ppRecord :: ComplicatedRecord -> IO Text

However, this turns out to be rather awkward. While in most other languages we would simply accumulate output by progressively adding more data to a mutable result, this would be much more inconvenient (and somewhat weird) to do in Haskell.

This is where the stdout-based approach seems cleaner; instead of straightforward, sequential code like this:

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.Extra (whenJust)
import Data.Text.IO
import TextShow

ppOrder Order{..} = do
    putStrLn $ "Order #" <> ordNumber
    ppAddress ordDeliveryAddress
    forM_ (zip [1..] ordItems) $ \(i, Item{..}) -> do
        putStrLn $ showt (i::Int) <> ". " <> itName <> " x" <> showt itQuantity
    whenJust ordBillingAddress ppAddress

ppAddress Address{..} = do
    putStrLn $ addrFirstName <> " " <> addrLastName
    putStrLn addrLine1
    whenJust addrLine2 putStrLn
    putStrLn $ addrCity <> ", " <> addrPostalCode

we have to overhaul each function and turn it into a much less pleasant “mappendage”:

ppOrder Order{..} = unlines $ mconcat
    [ "Order #" <> ordNumber
    , ppAddress ordDeliveryAddress
    , ppItems ordItems
    ] + maybe [] (\addr -> [ppAddress addr]) ordBillingAddress
    where
    ppItems = mconcat . map (uncurry ppItem) . zip [1..]
    ppItem i Item{..} = showt i <> ". " <> itName <> " x" <> itQuantity

One may argue that this is, in fact, the more idiomatic approach, but I’m not very fond of all those commas. Plus, it shows rather clearly that any conditional logic (like with ordBillingAddress here) is going to get pretty cumbersome.

Along comes the Writer

What I’m saying here is that even in pure code, it is sometimes very desirable to have a do notation. For that, however, we need a suitable Monad2 to provide the meaning of “invisible semicolon” in a do block.

And Text, obviously, isn’t one. Neither is [Text] (lines of text), nor any other type we’d use to represent the final output of formatting & printing. They are unsuitable, because they cannot encode the computation that eventually produces said output — either the top-level one (ppRecord) or any of its building blocks (like the ppOrder or ppAddress), down to a most elementary putStrLn. The only thing they can stand for is the result itself.

Fortunately, the pattern of executing code and occassionally producing some “additional” output has been abstracted over in the Haskell standard library. This is exactly the use case for the Writer monad!

The definition of Writer is roughly equivalent to the following:

newtype Writer w a = ... -- omitted

Of the two type parameters it takes, the w one signifies what output it can produce “on the side”. This is contrasted with a which is the regular result of a monadic expression or function. In our case, a will basically always be () (unit/”empty” type), but it is nonetheless necessary for the Writer to behave as a monad.

To complement the above definition, Writer comes with several useful functions. Among those, the most interesting one is tell:

tell :: w -> Writer w ()

write would’ve probably been a better name for it, as it’s definitely the main and defining operation of Writer.

Looking at its signature, we can see it takes a bit of the Writers output (w) and results in a Writer action. Internally, it will simply add the argument to the already accumulated output of the writer3.

To make everything more concrete, here’s a literal “Hello world” example coded very verbosly as a Writer action:

import Control.Monad.Writer

hello :: Writer Text ()
hello = do
    tell "Hello"
    tell " "
    tell "world"

main :: IO ()
main = do
    let (_, greeting) = runWriter hello
    Text.putStrLn greeting

It also contains the last element of the Writer puzzle:

runWriter :: Writer w a -> (a, w)

Like its name suggests, this function will “run” any Writer action that we give it, returning both the “regular” result (a) plus any output passed in tells (w).4

My little monad: transformers are magic

The last example may be very simple, but it contains all the building blocks for many of the printing functions we need. If we define a convenience wrapper for tell:

putLn :: Text -> Writer Text ()
putLn line = tell $ line <> "\n"

then both ppAddress and ppOrder can be translated through a mere mechanical substitution of putStrLn with putLn:

ppAddress Address{..} = do
    putLn $ addrFirstName <> " " <> addrLastName
    putLn addrLine1
    whenJust addrLine2 putLn
    putLn $ addrCity <> ", " <> addrPostalCode

-- ppOrder omitted

Unfortunately, a bare Writer like this can only work for pure code, which isn’t a luxury we can expect in every situtation. In my case, some of the printing logic was tied pretty strongly to IO, and it would be difficult and time consuming to decouple it.

Thankfully, the reliance on IO isn’t a complete deal breaker. While we cannot ensure that nothing calls putStrLn anymore, we can provide the tell/putLn capabilities alongside whatever other IO calls our code has to make (for now).

To achieve that, we need to create a monad stack with WriterT:

newtype WriterT w m a = ... -- omitted

WriterT is a monad transformer, one of those scary Haskell concepts that are actually simpler than they appear on the surface. This is because transfomers like WriterT are mere wrappers. The only difference between it and a regular Writer is the additional m parameter, which is the inner monad we’re packaging inside a new Writer.

Here (and in many other cases), m will be substituted with IO:

type Printer a = WriterT Text IO a  -- w == Text, m == IO

thus creating the titular Printer monad. This hybrid beast can both output Text through the Writer API, as well as perform any additional IO operations that the code may (still) require.

Below is an example; the User record requires an I/O call to get the size of its $HOME directory:

import Control.Monad.IO.Class (liftIO)
import System.Directory (getFileSize)

-- To print this data type nicely, we sadly require I/O :(
data User = User { usrName :: Text
                 , usrHomeDir :: FilePath
                 }

ppUser :: User -> IO Text
ppUser User{..} = snd <$> runWriterT $ do
    putLn $ "Name: " <> usrName
    homeSize <- liftIO $ getFileSize usrHomeDir
    putLn $ "$HOME: " <> showt usrHomeDir <> "(" <> showt homeSize <> " bytes)"

As a bit of necessary cruft, we have to use liftIO to “lift” (wrap) IO actions such as getFileSize in a full Printer monad before executing them. Besides everything else you can think of, this is yet another argument for eventually getting rid of the IO :)

Making the monads coexist

But our job isn’t done yet. Despite looking very reasonable, this version of ppUser doesn’t actually compile! The actual type error may vary a little, but it all boils down to a difference between WriterT Text IO () (i.e. Printer ()) and Writer Text () at each call site of putLn.

GHC is obviously correct. However, the problem lies not in how we’re calling putLn, but rather the way it’s been defined:

putLn :: Text -> Writer Text ()

This type can only produce a specific, pure Writer action. But to fit inside the do block of our compound monad, we need the Writer + IO combo from WriterT Text IO (i.e. Printer).

We can try to address the mismatch by changing the signature to:

putLn :: Text -> WriterT Text IO ()  -- or just: Printer ()

but this will only result in the opposite problem. Now, all the pure printers like ppAddress are facing the fact that putLn is a (wrapped) IO action, despite not actually doing any I/O whatsoever.

The obvious question is, can we have something that fits both?

Earlier on, I’ve said that both vanilla Writer and the IO-spruced Printer support the “Writer API”, most notably the tell function. This notion of a “monadic interface” isn’t just hand-waving, though, and Haskell (obviously!) provides a way to express it programmatically.

Meet the MonadWriter typeclass:

class (Monad m, Monoid w) => MonadWriter w m

Any monad that can work as a Writer will be an instance of it, regardless of whether it wraps over IO or anything else. Functions like tell are defined to be polymorphic over it, enabling us to leverage the same technique they use when we define putLn:

{-# LANGUAGE FlexibleContexts #-}

import Control.Monad.Writer.Class

putLn :: MonadWriter Text m => Text -> m ()
putLn line = tell $ line <> "\n"

If you aren’t very familiar with this syntax, the part before => is a typeclass constraint, or context. It defines the requirements to be satisfied by types which are later used in the function signature.

Here, we request a MonadWriter instance — one where Text is the output but anything can be the inner monad. We refer to that unknown monad only as m, a type variable. The compiler will figure out what to substitute for it at every call site of putLn.

As a result, both a pure Writer and the IO-bound Printer can now use it. In the second case, the relevant instance of MonadWriter will, naturally, have IO fill in the m position.

But curiously, the “pure” Writer also has an inner monad. It just literally does nothing but wrap some other value:

newtype Identity a = Identity { runIdentity :: a }

In most cases, this fact is hidden behind the real definition of Writer, though runIdentity may sometimes come handy for some on-the-spot type hacks5.

The wrap

The many things we’ve talked about here could of course be a starting point for even more advanced stuff, but obviously we have to stop somewhere! But don’t worry: knowing about MonadWriter and other monad typeclasses like this is enough to write quite idiomatic code…

…at least until you learn about free monads, effects, and the like ;-)

In any case, you can check this gist for the complete code from this post.


  1. IO is still necessary due to ad-hoc network fetches and syscalls mentioned earlier. 

  2. Or at least an Applicative, via the ApplicativeDo GHC extension. 

  3. The adding is done via mappend, requiring w to be a Monoid

  4. There is also the execWriter variant which is actually more practical here as it only returns the accumulated output. 

  5. We could, for example, use it alongside mapWriterT to “fix” the calls to putLn if we didn’t have control over its definition. 

Continue reading

Rust as a gateway drug to Haskell

Posted on Tue 13 June 2017 in Programming • Tagged with Rust, Haskell, traits, typeclasses, monads, ADTs, FPLeave a comment

For work-related reasons, I had to recently get up to speed on programming in Haskell.

Before that, I had very little actual experience with the language, clocking probably at less than a thousand lines of working code over a couple of years. Nothing impressive either: some wrapper script here, some experimental rewrite there…

These days, I heard, there are a few resources for learning Haskell1 that don’t require having a PhD in category theory2. They may be quite helpful when your exposure to the functional programming is limited. In my case, however, the one thing that really enabled me to become (somewhat) productive was not even related to Haskell at all.

It was Rust.

In theory, this shouldn’t really make much of a sense. If you compare both languages by putting checkmarks in a feature chart, you won’t find them to have much in common.

Some of the obvious differences include:

  • predominantly functional vs. mostly imperative
  • garbage collection vs. explicit memory management
  • lazy vs. eager evaluation
  • rich runtime3 vs. almost no runtime
  • global vs. localized type inference
  • indentation vs. braces
  • two decades (!) vs. barely two years since release

Setting aside syntax, most of those differences are pretty significant.

You probably wouldn’t use Haskell for embedded programming, for instance, both for performance (GC) and memory usage reasons (laziness). Similarly, Rust’s ownership system can be too much of a hassle for high level code that isn’t subject to real time requirements.

But if you look a little deeper, beyond just the surface descriptions of both languages, you can find plenty of concepts they share.

Traits: they are typeclasses, essentially

Take Haskell’s typeclasses, for example — the cornerstone of its rich and expressive type system.

A typeclass is, simply speaking, a list of capabilities: it defines what a type can do. There exist analogs of typeclasses in most programming languages, but they are normally called interfaces or protocols, and remain closely tied to the object-oriented paradigm.

Not so in Haskell.

Or in Rust for that matter, where the equivalent concept exists under the name of traits. What typeclasses and traits have in common is that they’re used for all kinds of polymorphism in their respective languages.

Generics

For example, let’s consider parametrized types, sometimes also referred to as templates (C++) or generics (C#).

In many cases, a generic function or type requires its type arguments to exhibit certain characteristics. In some languages (like the legacy C++), this is checked only implicitly: as long as the template type-checks after its expansion, everything is okay:

template <typename T> T min(T a, T b) {
    return a > b ? b : a;
}

struct Foo {};

int main() {
    min(1, 2);  // OK
    min(Foo(), Foo());  // ERROR, no operator `>`
}

More advanced type systems, however, allow to specify the generic constraints explicitly. This is the case in Rust:

fn min<T: Ord>(a: T, b: T) -> T {
    if a > b { b } else { a }
}

as well as in Haskell:

min :: (Ord a) => a -> a -> a
min a b = if a > b then b else a

In both languages, the notion of a type supporting certain operations (like comparison/ordering) is represented as its own, first-class concept: a trait (Rust) or a typeclass (Haskell). Since the compiler is aware of those constraints, it can verify that the min function is used correctly even before it tries to generate code for a specific substitution of T.

Dynamic dispatch

On the other hand, let’s look at runtime polymorphism: the one that OO languages implement through abstract base classes and virtual methods. It’s the tool of choice if you need a container of objects of different types, which nevertheless all expose the same interface.

To offer it, Rust has trait objects, and they work pretty much exactly like base class pointers/references from Java, C++, or C#.

// Trait definition
trait Draw {
    fn draw(&self);
}

// Data type implementing the trait
struct Circle { radius: i32 }
impl Draw for Circle {
    fn draw(&self) { /* omitted */ }
}

// Usage
fn draw_all(objects: &Vec<Box<Draw>>) {
    for &obj in objects {
        obj.draw();
    }
}

The Haskell analogue is, in turn, based on typeclasses, though the specifics can be a little bit trickier:

{-# LANGUAGE ExistentialQuantification #-}

-- Typeclass definition
class Draw a where
    draw :: a -> IO ()

-- Polymorphic wrapper type
data Draw' = forall a. Draw a => Draw' a
instance Draw Draw' where
    draw (Draw' d) = draw d

-- Data types instantiating ("implementing") the typeclass
data Circle = Circle ()
instance Draw Circle where draw = undefined -- omitted
data Square = Square ()
instance Draw Square where draw = undefined -- omitted

-- Usage
drawAll :: (Draw a) => [a] -> IO ()
drawAll ds = mapM_ draw ds

main = do
    let shapes = [Draw' Circle (), Draw' Square ()]
    drawAll shapes

Here, the generic function can use typeclass constraints directly ((Draw a) => ...), but creating a container of different object types requires a polymorphic wrapper4.

Differences

All those similarities do not mean that Rust traits and Haskell typeclasses are one and the same. There are, in fact, quite a few differences, owing mostly to the fact that Haskell’s type system is more expressive:

  • Rust lacks higher kinded types, making certain abstractions impossible to encode as traits. It is possible, however, to implement a trait for infinitely many types at once if the implementation itself is generic (like here).

  • When defining a trait in Rust, you can ask implementors to provide some auxiliary, associated types in addition to just methods5. A similar mechanism in Haskell is expanded into type families, and requires enabling a GHC extension.

  • While typeclasses in Haskell can be implemented for multiple types simultaneously via a GHC extension, Rust’s take on this feature is to make traits themselves generic (e.g. trait Foo<T>). The end result is roughly similar; however, the “main implementing type” (one after for in impl ... for ...) is still a method receiver (self), just like in OO languages.

  • Rust enforces coherence rules on trait implementations. The topic is actually rather complicated, but the gist is about local (current package) vs. remote (other packages / standard library) traits and types.
    Without too much detail, coherence demands that there be a local type or trait somewhere in the impl ... for ... construct. Haskell doesn’t have this limitation, although it is recommended not to take advantage of this.

The M-word

Another area of overlap between Haskell and Rust exists in the data model utilized by those languages. Both are taking heavy advantage of algebraic data types (ADT), including the ability to define both product types (“regular” structs and records) as well as sum types (tagged unions).

Maybe you’d like Some(T)?

Even more interestingly, code in both languages makes extensive use of the two most basic ADTs:

  • Option (Rust) or Maybe (Haskell) — for denoting a presence or absence of a value
  • Result (Rust) or Either (Haskell) — for representing the alternative of “correct” and “erroneous” value

These aren’t just simple datatypes. They are deeply interwoven into the basic semantics of both languages, not to mention their standard libraries and community-provided packages.

The Option/Maybe type, for example, is the alternative to nullable references: something that’s been heavily criticized for making programs prone to unexpected NullReferenceExceptions. The idea behind both of those types is to make actual values impossible to confuse with nulls by encoding the potential nullability into the type system:

enum Option<T> { Some(T), None }
data Maybe a = Just a | Nothing

Result and Either, on the other hand, can be thought as an extension of this idea. They also represent two possibilities, but the “wrong” one isn’t just None or Nothing — it has some more information associated with it:

enum Result<T, E> { Ok(T), Err(E) }
data Either e a = Left e | Right a

This dichotomy between the Ok (or Right) value and the Error value (or the Left one) makes it a great vehicle for carrying results of functions that can fail.

In Rust, this replaces the traditional error handling mechanisms based on exceptions. In Haskell, the exceptions are present and sometimes necessary, but Either is nevertheless the preferred approach to dealing with errors.

What to do?

One thing that Haskell does better is composing those fallible functions into bigger chunks of logic.

Relatively recently, Rust has added the ? operator as a replacement for the try! macro. This is now the preferred way of error propagation, allowing for a more concise composition of functions that return Results:

/// Read an integer from given file.
fn int_from_file(path: &Path) -> io::Result<i32> {
    let mut file = fs::File::open(path)?;
    let mut s = String::new();
    file.read_to_string(&mut s)?;
    let result = s.parse().map_err(|e| io::Error::new(io::ErrorKind::InvalidData, e))?;
    Ok(result)
}

But Haskell had it for much longer, and it’s something of a hallmark of the language and functional programming in general — even though it looks thoroughly imperative:

intFromFile :: FilePath -> IO Int
intFromFile path = do
    s <- readFile path
    i <- readIO s
    return i

If you haven’t seen it before, this is of course a monad — the IO monad, to be precise. While discussing monads in detail is way outside of the scope of this article, we can definitely notice some analogies with Rust. The do notation with <- arrows is evidently similar to how in Rust you’d assign the result of a fallible operation after “unpacking” it with ?.

But of course, there’s plenty of different monads in Haskell: not just IO, but also Either, Maybe, Reader, Writer, Cont, STM, and many others. In Rust (at least as of 1.19), the ? operator only works for Result types, although there is some talk about extending it to Option as well6.

Eventually, we may see the language adopt some variant of the do notation, though the motivation for this will most likely come from asynchronous programming with Futures rather than plain Results. General monads, however, require support for higher kinded types which isn’t coming anytime soon.

A path through Rust?

Now that we’ve discussed those similarities, the obvious question arises.

Is learning Rust worthwhile if your ultimate goal is getting proficient at functional programming in general, or Haskell in particular?

My answer to that is actually pretty straightforward.

If “getting to FP” is your main goal, then Rust will not help you very much. Functional paradigm isn’t the main idea behind the language — its shtick is mostly memory safety, and zero-cost abstractions. While it succeeds somewhat at being “Haskell Lite”, it really strives to be safer C++7.

But if, on the other hand, you regard FP mostly as a curiosity that seems to be seeping into your favorite imperative language at an increasing rate, Rust can be a good way to gain familiarity with this peculiar beast.

At the very least, you will learn the functional way of modeling programs, with lots of smart enums/unions and structs but without inheritance.

And the best part is: you will be so busy fighting the borrow checker you won’t even notice when it happens ;-)


  1. Just ask in #haskell-beginners on Freenode if you’re interested. 

  2. Though ironically, I found the CT lectures by Bartosz Milewski very helpful in developing the right intuitions, even though they’re very abstract. 

  3. For example, Haskell has green threads (created with forkIO) which are somewhat similar to goroutines from Go. To get anything remotely similar in Rust, you need to use external libraries

  4. Note that such containers aren’t very idiomatic Haskell. A more typical solution would be to just curry the draw function, implicitly putting the Draw object inside its closure. 

  5. This mechanisms expands to associated constants in Rust 1.20. 

  6. Those two types also have a form of monadic bind (>>= in Haskell) exposed as the and_then method

  7. If you want another language for easing into the concept of functional programming, I’ve heard that Scala fills that niche quite well. 

Continue reading