Applicative example

Applicative.hs

module Applicative where

-- A real-world example of Applicative.
--
-- Imagine we have a `User` data structure (with all the usual fields) which
-- we must assemble from various data sources, like databases, files, external
-- services and so on.
--
-- One thing our specs call for is that we must log error messages whenever
-- some external service fails or is otherwise unavailable. However, we'd like
-- to log *all* error messages instead of stopping after the first one, so
-- that our DevOps team can efficiently investigate all failures at once
-- instead of having to painstakingly fix errors one by one while paying the
-- price of a full deployment cycle each time.

-- We start by defining a `Result` type. `Result a` describes a computation
-- which is either successful or otherwise contains a list of error messages.

data Result a = Success a | Fail [String] deriving Show

-- The `Functor` instance is pretty straightfoward: pass through `Fail` as-is
-- or apply `f` to the value inside `Success`.

instance Functor Result where
  fmap _ (Fail es)   = Fail es
  fmap f (Success a) = Success (f a)

-- The `Applicative` instance isn't too complicated either. `pure` just puts
-- a normal value in a succeeding `Result` error-tracking "context". `<*>`
-- accumulates all errors: either from both sides if both sides fail or just
-- from the failing one. Otherwise if both sides succeed it takes the function
-- contained in the left `Result` and applies it to the right `Result`.

instance Applicative Result where
  pure a                  = Success a

  Fail es <*> Fail es'    = Fail (es ++ es')
  _ <*> Fail es'          = Fail es'
  Fail es <*> _           = Fail es
  Success f <*> Success a = Success (f a)

-- Just as `pure` takes a normal value and produces a succeeding `Result a`
-- we need a way to indicate failure:

failure :: String -> Result a
failure e = Fail [e]

-- And here is our very boring `User` type:

data User = User
  { name          :: String
  , age           :: Int
  , authenticated :: Bool
  } deriving Show

-- Now, here are the functions that collect our `User` data from various data
-- sources. In reality these functions would do some kind of `IO`, but for
-- simplicity's sake we'll keep them pure.

getName :: Result String
getName = pure "UnnamedPlayer"

getAge :: Result Int
getAge = failure "Couldn't connect to database"

getAuthenticated :: Result Bool
getAuthenticated = failure "Couldn't connect to auth system"

-- Here's where the `Applicative` magic happens: we construct a `Result User`
-- by assembling it from various other, smaller `Result` pieces. `Applicative`
-- just glues everything together, so that we wouldn't have to write boring,
-- repetetive error tracking code by hand.

getUser :: Result User
getUser = User
  <$> getName
  <*> getAge
  <*> getAuthenticated

-- `print getUser`
-- `Fail ["Couldn't connect to database","Couldn't connect to auth system"]`
--
-- As you can see, we've tracked both error messages caused by `getAge` and
-- `getAuthenticated` above.
--
-- Just to see how everything looks when nothing goes wrong, here's another,
-- luckier `User`:

getUser2 :: Result User
getUser2 = User
  <$> pure "UnnamedPlayer"
  <*> pure 3
  <*> pure True

-- `print getUser2`
-- `Success (User {name = "UnnamedPlayer", age = 3, authenticated = True})`

-- `Applicative`, of course, composes well. Let's say we want to extend our
-- `User` with an additional `Address`:

data Address = Address
  { street :: String
  , city   :: String
  } deriving Show

data UserWithAddress = UserWithAddress
  { name2          :: String
  , age2           :: Int
  , authenticated2 :: Bool
  , address2       :: Address
  } deriving Show

-- Again, some functions reading from imaginary data sources:

getStreet :: Result String
getStreet = pure "Boss Street"

getCity :: Result String
getCity = failure "Couldn't read from server, error: 404"

getAddress :: Result Address
getAddress = Address
  <$> getStreet
  <*> getCity

-- `getAddress` will predictibly fail:
-- `Fail ["Couldn't read from server, error: 404"]`
--
-- But now, let's construct our new user with the same failing `Address`:

getUserWithAddress :: Result UserWithAddress
getUserWithAddress = UserWithAddress
  <$> getName
  <*> getAge
  <*> getAuthenticated
  <*> getAddress

-- `print getUserWithAddress`
-- `Fail ["Couldn't connect to database","Couldn't connect to auth system","Couldn't read from server, error: 404"]`
--
-- As expected, we've collected all error messages, even those caused by
-- `getAddress`!
--
-- This example loosely corresponds to the following Javascript code:
--
-- ```
-- function getUser(errors) {
--   let user = {};
--
--   user.name = getName(errors);
--   user.age = getAge(errors);
--   user.authenticated = getAuthenticated(errors);
--
--   return user.name && user.age && user.authenticated ? user : null;
-- }
-- ```
--
-- Notice how we'd have to manually pass an `errors` array down the call stack
-- (or, alternatively, use a global array somewhere) and manually check whether
-- every field is valid before returning a valid `User`, which is tedious and
-- error prone (we'd have to do the same in `getAddress` and so on). The
-- `Result` `Applicative` takes care of that boilerplate for us.