Skip to content

Zenhackers

  • Home
June 25, 2012September 17, 2012 Rouan van DalenSoftware Development

Haskell and Domain Driven Design (DDD)

Haskell

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:

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:

application model

Following DDD convention, we have 3 high-level layers (Haskell modules) in our application:

  1. Handyman.Application (Application Layer) – coordinates elements in other layers to get a specific task done.
  2. Handyman.Model (Domain Model Layer) – contains all our business logic.
  3. 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:

  1. Check if a similar client already exists, based on the new client’s ID number.
  2. If a similar client does NOT exist, try to save the client record.
  3. 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.

Tagged Haskell

Related Posts

Shifting gears // The need for speed!

June 26, 2023June 26, 2023Software Development

Keeping things simple – a challenge all teams face

June 12, 2023June 12, 2023Software Development
Copyright © 2022 Hait. All rights reserved.
↑