Haskell and Domain Driven Design (DDD)
After working on a few projects where used C# and Domain Driven Design (DDD), I realized that there are some nice benefits about applying the ideas behind DDD in a software project. I started to wonder if we could apply the ideas from DDD in Haskell. This post explores a very simple Haskell application (for demonstration purposes) to see how the ideas of DDD fit in with Haskell.
Another question I have in the back of my mind is how successfully Haskell can by used to write a business application? Line-of-business (LOB) applications are not where we see Haskell often, and I would like to explore why (or why not) Haskell is good for writing these applications (in this and later posts).
The application is a very simple Handyman application which a Handyman can use to collect information about his/her clients and their home (or other buildings) and then issue a job card if the client needs some maintenance done. The following image shows our domain model:
In this post we are only going to be looking at the Client
portion of the domain model and see how we structure the Haskell code, following DDD principles. The following image shows how we are going to structure our Haskell Handyman program:
Following DDD convention, we have 3 high-level layers (Haskell modules) in our application:
- Handyman.Application (Application Layer) – coordinates elements in other layers to get a specific task done.
- Handyman.Model (Domain Model Layer) – contains all our business logic.
- Handyman.Infra (Infrastructure Layer) – provides low-level application and framework infrastructure.
Now, let’s start looking at the Handyman source code. First we look at the application entry point where everything begins:
module Main where -- import the functions in the ClientApplicationService -- (so we can add a new client) import Handyman.Application.ClientAppService main :: IO () main = do -- try to add a new client to the system addNewClient "Rouan van Dalen" "8822668899221" |
module Main where -- import the functions in the ClientApplicationService -- (so we can add a new client) import Handyman.Application.ClientAppService main :: IO () main = do -- try to add a new client to the system addNewClient "Rouan van Dalen" "8822668899221"
When we run our Haskell Handyman application, the Main function is called automatically and we try to add a new client to the database. in the main
function, we call the addNewClient
application service function to add the new client. Let’s take a look at the addNewClient
function in our application layer:
module Handyman.Application.ClientAppService where -- import Haskell exception handling library and our own Infrastructure exceptions import Control.Exception import Handyman.Infra.Exceptions -- import our Client model (data structure) import qualified Handyman.Model.Client as Client -- import our repository infrastructure code so we can try to save our new Client to the DB import qualified Handyman.Infra.Repository as Repository import qualified Handyman.Infra.ClientRepo as ClientRepo addNewClient :: String -> String -> IO () addNewClient clientName clientIdNo = do -- create a new client record, with the given clientName, clientIdNo let newClient = Client.mkNewDefault clientName clientIdNo -- need to get a DbContext for use with repositories Repository.withDbContext (\ dbCtx -> do -- check if a similar client already exists in the DB clientExists <- ClientRepo.similarClientExists dbCtx newClient -- if no similar client can be found, try to save the new client. -- If a similar client was found, throw a new Infrastructure exception. if not clientExists then Repository.save dbCtx newClient else throwIO $ InfraException "a client with the same ID number already exists in the database.") |
module Handyman.Application.ClientAppService where -- import Haskell exception handling library and our own Infrastructure exceptions import Control.Exception import Handyman.Infra.Exceptions -- import our Client model (data structure) import qualified Handyman.Model.Client as Client -- import our repository infrastructure code so we can try to save our new Client to the DB import qualified Handyman.Infra.Repository as Repository import qualified Handyman.Infra.ClientRepo as ClientRepo addNewClient :: String -> String -> IO () addNewClient clientName clientIdNo = do -- create a new client record, with the given clientName, clientIdNo let newClient = Client.mkNewDefault clientName clientIdNo -- need to get a DbContext for use with repositories Repository.withDbContext (\ dbCtx -> do -- check if a similar client already exists in the DB clientExists <- ClientRepo.similarClientExists dbCtx newClient -- if no similar client can be found, try to save the new client. -- If a similar client was found, throw a new Infrastructure exception. if not clientExists then Repository.save dbCtx newClient else throwIO $ InfraException "a client with the same ID number already exists in the database.")
In the addNewClient
function, we create a new client by calling the Client.mkNewDefault
constructor function, which creates a new Client
Haskell record, setting the name
and idNo
fields to their respective values.
After our new client record is created, we use the Repository.withDbContext
repository helper function to manage the create and release of our DB context (the DB context is needed by calls to the repository functions). We need to pass the Repository.withDbContext
a function, which takes as a parameter the created DB context, and executes some DB actions. Our repository actions are:
- Check if a similar client already exists, based on the new client’s ID number.
- If a similar client does NOT exist, try to save the client record.
- If a similar client does exist, throw an Infrastructure exception.
Now let’s take a look at how we implemented our Client haskell record in the Domain Model layer:
module Handyman.Model.Client where -- import the ClientPackage haskell record because our Client record -- makes use of it import qualified Handyman.Model.ClientPackage as ClientPackage -- define our Client record. (eId = unique entity ID) data R = R { eId :: Maybe Int , name :: String , idNo :: String , packages :: [ClientPackage.R] } -- define a new constructor function that allows us to create a new -- Client record, by supplying just the client name and ID number. mkNewDefault :: String -> String -> R mkNewDefault name idNo = R { eId = Nothing , name = name , idNo = idNo , packages = [] } |
module Handyman.Model.Client where -- import the ClientPackage haskell record because our Client record -- makes use of it import qualified Handyman.Model.ClientPackage as ClientPackage -- define our Client record. (eId = unique entity ID) data R = R { eId :: Maybe Int , name :: String , idNo :: String , packages :: [ClientPackage.R] } -- define a new constructor function that allows us to create a new -- Client record, by supplying just the client name and ID number. mkNewDefault :: String -> String -> R mkNewDefault name idNo = R { eId = Nothing , name = name , idNo = idNo , packages = [] }
Now, for the last layer: the Infrastructure layer. I am only going to cover the Handyman.Infra.Repository
and Handyman.Infra.ClientRepo
Haskell modules, which represent some repository plumbing and the client-specific repository functions:
module Handyman.Infra.Repository where import Control.Exception import Database.HDBC import Database.HDBC.Sqlite3 -- define some type aliases to make types self-documenting type DbCtxt = Connection type SqlQuery = String type SqlQueryParam = SqlValue class Repository e id | e -> id where save :: DbCtxt -> e -> IO () insert :: DbCtxt -> e -> IO () update :: DbCtxt -> e -> IO () delete :: DbCtxt -> e -> IO () getById :: DbCtxt -> id -> IO e getAll :: DbCtxt -> IO [e] -- repository helper function that abstracts the creating and destroying of our DB context and -- resource management if an exception was thrown. withDbContext :: (DbCtxt -> IO ()) -> IO () withDbContext dbAction = do -- open a new DB connection dbConn <- connectSqlite3 "test1.db" (do -- apply the supplied dbAction to the open DB connection dbAction dbConn -- commit any changes made by the dbAction commit dbConn -- close the dbConnection disconnect dbConn) `onException` (do -- rollback the transaction rollback dbConn -- close the dbConnection disconnect dbConn) -- general function that executes the supplied SQL SELECT query and returns true if some -- rows were returned by the query. sqlExists :: DbCtxt -> SqlQuery -> [SqlQueryParam] -> IO Bool sqlExists dbCtx sqlQuery sqlQueryParams = do result <- quickQuery' dbCtx sqlQuery sqlQueryParams return $! length result > 0 -- general function that executes the supplied SQL INSERT query. sqlInsert :: DbCtxt -> SqlQuery -> [SqlQueryParam] -> IO () sqlInsert dbCtx sqlQuery sqlQueryParams = do run dbCtx sqlQuery sqlQueryParams return () |
module Handyman.Infra.Repository where import Control.Exception import Database.HDBC import Database.HDBC.Sqlite3 -- define some type aliases to make types self-documenting type DbCtxt = Connection type SqlQuery = String type SqlQueryParam = SqlValue class Repository e id | e -> id where save :: DbCtxt -> e -> IO () insert :: DbCtxt -> e -> IO () update :: DbCtxt -> e -> IO () delete :: DbCtxt -> e -> IO () getById :: DbCtxt -> id -> IO e getAll :: DbCtxt -> IO [e] -- repository helper function that abstracts the creating and destroying of our DB context and -- resource management if an exception was thrown. withDbContext :: (DbCtxt -> IO ()) -> IO () withDbContext dbAction = do -- open a new DB connection dbConn <- connectSqlite3 "test1.db" (do -- apply the supplied dbAction to the open DB connection dbAction dbConn -- commit any changes made by the dbAction commit dbConn -- close the dbConnection disconnect dbConn) `onException` (do -- rollback the transaction rollback dbConn -- close the dbConnection disconnect dbConn) -- general function that executes the supplied SQL SELECT query and returns true if some -- rows were returned by the query. sqlExists :: DbCtxt -> SqlQuery -> [SqlQueryParam] -> IO Bool sqlExists dbCtx sqlQuery sqlQueryParams = do result <- quickQuery' dbCtx sqlQuery sqlQueryParams return $! length result > 0 -- general function that executes the supplied SQL INSERT query. sqlInsert :: DbCtxt -> SqlQuery -> [SqlQueryParam] -> IO () sqlInsert dbCtx sqlQuery sqlQueryParams = do run dbCtx sqlQuery sqlQueryParams return ()
module Handyman.Infra.ClientRepo where import Database.HDBC import Handyman.Infra.Repository import qualified Handyman.Model.Client as Client instance Repository Client.R Int where save dbCtx client = case (Client.eId client) of Nothing -> insert dbCtx client Just _ -> update dbCtx client insert dbCtx Client.R {..} = sqlInsert dbCtx "INSERT INTO Client (name, idNo) VALUES (?, ?)" [toSql name, toSql idNo] update dbCtx client = undefined delete dbCtx client = undefined getById dbCtx clientId = undefined getAll dbCtx = undefined similarClientExists :: DbCtxt -> Client.R -> IO Bool similarClientExists dbCtx Client.R {..} = do sqlExists dbCtx "SELECT * FROM Client WHERE idNo = ?" [toSql idNo] |
module Handyman.Infra.ClientRepo where import Database.HDBC import Handyman.Infra.Repository import qualified Handyman.Model.Client as Client instance Repository Client.R Int where save dbCtx client = case (Client.eId client) of Nothing -> insert dbCtx client Just _ -> update dbCtx client insert dbCtx Client.R {..} = sqlInsert dbCtx "INSERT INTO Client (name, idNo) VALUES (?, ?)" [toSql name, toSql idNo] update dbCtx client = undefined delete dbCtx client = undefined getById dbCtx clientId = undefined getAll dbCtx = undefined similarClientExists :: DbCtxt -> Client.R -> IO Bool similarClientExists dbCtx Client.R {..} = do sqlExists dbCtx "SELECT * FROM Client WHERE idNo = ?" [toSql idNo]
Only the minimum code is implemented to actually insert a new client into the DB. I am not going to cover all the other Haskell modules. The code should be enough to get a rough idea of what DDD looks like in Haskell. This is only my first attempt and there is still much to consider and we will be refactoring and discussing improvements in later posts.