I want to share a nice implementation detail I’m using in a project I’m working on. Some quick Googling shows that I’m definitely not the first to “discover” it, but I found it really neat so I thought I’d present it here for anyone who might find it useful.

Some things we love in Haskell projects:

1. Separation of concerns: The more we can isolate bits of code into small, manageable, independent chunks, the better. This leads to easier testing, better scalability, and reusability.

   In Haskell, there are different levels of granularity we can use to keep unrelated code apart: functions, modules, and packages.

   For more detail on this concept and others related to it, see:

   • This blog post about “The Clean Architecture”.
   • This summary of the “Functional core, imperative shell” paradigm.

2. Explicit effects: Being able to track effects at the type level gives us better encapsulation, and is frankly really cool. It also helps with #1 above: it lets us separate the definition of effects (what a function does) from the implementation of those effects (how it performs those effects).

   Effect libraries such as Effectful, Bluefin and fused-effects, give us the ability to say exactly what types of effects a particular function can perform.

   For a great breakdown on effect systems, I recommend this talk by Alexis King.

This article assumes some knowledge of Effectful and a few other libraries - see the relevant documentation for detailed guides.

All the code from this article can be found in this repo.

Package design

The Haskell backend of this project is a big monorepo, split into quite a lot of smaller packages:

• prelude - custom prelude based on Protolude
• core - core domain types + logic
• backend - backend server
  • backend/backend-api - Servant API definitions
  • backend/backend-server - server implementation for the API
• etc.

An important part of any application is how it stores data. My project needs to store user information, user data, server data etc. When we’re developing our application we might start off keeping all the data in memory; later we might use a SQLite database, and later still we might migrate to something more serious like PostgreSQL.

If we made the mistake of intertwining our storage code with our API code in backend-server, each of these changes would require a lot of refactoring, and could be very error-prone. So let’s extract all our storage code into its own package:

• prelude
• core
• backend
  • backend/backend-api
  • backend/backend-server
• storage - how we store and manage application data
• etc.

However, we can go a step further. What if we want the option to support multiple different storage backends, or all of them? Maybe we want to use the in-memory backend for pure testing, the SQLite database for local development, and PostgreSQL in production? It would be great if we could separate the definitions of what we want to store and what operations we want to support from the actual implementations. Fortunately, in Haskell we can do anything. The approach I’m going to take is using the extensible effects library Effectful.

Let’s split our storage package up again: one package for defining our storage effect, and one for each backend (of course we’re free to add more in the future, completely orthogonally):

• prelude
• core
• backend
  • backend/backend-api
  • backend/backend-server
• storage
  • storage/storage - our storage abstraction
  • storage/storage-memory - implementation of our storage abstraction using an in-memory backend
  • storage/storage-postgresql - implementation of our storage abstraction using a PostgreSQL database
• etc.

Right, let’s look at some actual code.

Domain model

First, let’s review some of our domain types in core, omitting details about parameters and fields:

-- file core/src/Core.hs

{-# LANGUAGE TemplateHaskell #-}

module Core where

import Control.Lens

type UserId = Int

-- | This parameterisation allows us to define useful type synonyms.
data User' id ... = User
  { _userId :: id
  , ...
  }
  deriving (Show, Generic)

-- | A full user in the model
type User =
  User'
    UserId
    ...
-- | A user without IDs etc, to be created
type UserCreate =
  User'
    ()
    ...

type TransactionId = Int

data Transaction' id userId ... = Transaction
  { _transactionId :: id
  , _transactionUserId :: userId
  , ...
  }
  deriving (Show, Generic)

type Transaction =
  Transaction'
    TransactionId
    UserId
    ...
type TransactionCreate =
  Transaction'
    ()
    ()
    ...

-- generate lenses for easy and awesome manipulation
makeLenses ''User'
makeLenses ''Transaction'

API definition

Now, let’s look at our backend API, since that will inform the design of our Storage abstraction.

-- file backend/api/src/Backend/API.hs

module Backend.API where

import Core
import Servant.API

type UserAPI =
       "list" :> Get '[JSON] [User]
    -- ^ list all the users
  :<|> "create" :> ReqBody '[JSON] UserCreate :> Post '[JSON] User
    -- ^ create a new user

type TransactionAPI =
       "list" :> Get '[JSON] [Transaction]
    -- ^ list all user transactions
  :<|> "delete" :> Capture "id" TransactionId :> DeleteNoContent
    -- ^ delete a transaction

-- | The full API.
type API =
  "user" :> UserAPI
    :<|> "transaction" :> TransactionAPI

Pretty standard stuff. But now we know what operations we need our Storage effect to support:

Storage abstraction

-- file storage/storage/src/Storage/Effect.hs

{-# LANGUAGE TemplateHaskell #-}

module Storage.Effect where

import Core
import Effectful
import Effectful.TH

data Storage :: Effect where
  ListUsers :: Storage m [User]
  CreateUser :: UserCreate -> Storage m User

  ListTransactions :: Storage m [Transaction]
  DeleteTransaction :: TransactionId -> Storage m ()

makeEffect ''Storage

Note that last Template Haskell splice will generate code that looks like:

listUsers :: (Storage :> es) => Eff es [User]
createUser :: (Storage :> es) => UserCreate -> Eff es User

These will come in very useful when we implement the server…

Server implementation

Now, we can write our Servant handlers:

-- file backend/server/src/Backend/Server.hs

module Backend.Server where

import Backend.API
import Data.Functor (($>))
import Effectful
import Servant.API hiding ((:>))
import Servant.Server
import Storage.Effect

userServer :: (Storage :> es) => ServerT UserAPI (Eff es)
userServer = listUsers :<|> createUser

transactionServer ::
  (Storage :> es) => ServerT TransactionAPI (Eff es)
transactionServer =
  listTransactions :<|> deleteTransaction'
  where
    deleteTransaction' tId = deleteTransaction tId $> NoContent

apiServer :: (Storage :> es) => ServerT API (Eff es)
apiServer = userServer :<|> transactionServer

Wow! That was almost boring with how mechanical it was. And apart from being concise, notice that none of the code in this module cares about how the Storage effect is dispatched. There isn’t even an interpreter for the Storage effect in scope!

Some interpreters

Speaking of which, now we can write some handlers for our Storage effect. Let’s start with a simple in-memory implementation.

In-memory interpreter

-- file storage/memory/src/Storage/Memory.hs

{-# LANGUAGE TemplateHaskell #-}

module Storage.Memory where

import Control.Lens
import Core
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.State.Static.Local
import qualified Data.Map as M
import Storage.Effect

-- first we define a datatype to hold our data in-memory

data Memory = Memory
  { _users :: M.Map UserId User
  , _transactions :: M.Map TransactionId Transaction
  , _nextId :: Int
  }
  deriving (Show)

makeLenses ''Memory

-- in real life, we'd want a cleaner way of generating IDs, but this
-- is good enough for demonstration purposes
runStorageMemory ::
  (State Memory :> es) => Eff (Storage : es) a -> Eff es a
runStorageMemory = interpret $ \_ -> \case
  ListUsers -> gets $ M.elems . _users
  CreateUser userCreate -> do
    uId <- state $ nextId <+~ 1
    let newUser = userCreate & userId .~ uId
    modify $ users . at uId ?~ newUser
    pure newUser

  ListTransactions -> gets $ M.elems . _transactions
  DeleteTransaction tId -> modify $ transactions . at tId .~ Nothing

PostgreSQL interpreter

--file storage/memory/src/Storage/Postgres.hs

{-# OPTIONS_GHC -Wno-orphans #-}

module Storage.Postgres where

import Control.Lens
import Control.Monad (void)
import Core
import Database.PostgreSQL.Simple
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.State.Static.Local
import Storage.Effect

-- first we need some instances

instance FromRow User
instance ToRow User
instance FromRow Transaction
instance ToRow Transaction

-- again, we use 'State' for generating IDs
runStoragePostgres ::
  (State Int :> es, IOE :> es) =>
  Connection ->
  Eff (Storage : es) a ->
  Eff es a
runStoragePostgres conn = interpret $ \_ -> \case
  ListUsers -> liftIO $ query_ conn "SELECT * FROM app_users"
  CreateUser userCreate -> do
    uId <- get
    modify (+ 1)
    let newUser = userCreate & userId .~ uId
    liftIO $
      execute conn "INSERT INTO app_users values (?)" newUser
    pure newUser

  ListTransactions ->
    liftIO $ query_ conn "SELECT * FROM transactions"
  DeleteTransaction tId ->
    void . liftIO $
      execute conn "DELETE FROM transactions where id = ?" (Only tId)

Conclusion

As you can see, this is a very powerful technique. Algebraic effects let us separate the definition of what storage operations we want to support, from how we implement them. This is very similar in the way that Servant types let us separate the shape of an API, from how its server functions are implemented.