This is the third episode in the short series on Domain Modelling with Haskell. Now our hypothetical customer requires reporting not only at the level of individual projects, but also on the project group level. Our previous solution using Traversable and Foldable won’t help us much, so we use explicit recursion and the WriterT monad transformer to accumulate calculated reports as we traverse the project tree structure.

Show Notes

Welcome to Haskell at Work, previously known as CODA, a screencast focused on practical Haskell programming. You’re watching the third part of Domain Modelling with Haskell.

So far, we have built a basic domain model for the project management system, we have used Traversable to calculate a project structure of reports for individual projects, and we have used Foldable to collapse those reports into a single report.

We have a new customer requirement, but first, I want to correct a mistake in our existing code.

Using Decimal instead of Double

To keep the videos simple, I used the Double data type, a floating-point type, for money. That is most likely not something you would want to do in a real system for financial values, and we should not do it here either. We are going to use the Decimal package, but you might also consider the Fixed or Rational types, which are in base.

Let’s begin by adding the Decimal package as a dependency.

build-depends:
      base >=4.7 && <5
    , containers
    , Decimal
    , fixplate
    , mtl
    , random
    , text

In the Project module we import the Decimal type from Data.Decimal, and use it instead of Double. We need to restart the REPL for the Decimal package to be available.

import           Data.Decimal (Decimal)
import           Data.Text    (Text)

newtype Money = Money
  { unMoney :: Decimal
  } deriving (Show, Eq, Num)

In the Database module, which is a faked implementation generating random budgets and transactions, we now need to generate random decimals. Decimal doesn’t have an instance of Random, so we will generate random Double values and convert them. Precision is not important here.

We need the realFracToDecimal conversion function from Data.Decimal.

import           Data.Decimal  (realFracToDecimal)

Before it gets too messy, we will create a random money generating function called randomMoney. Given a range, it generates a random Double and converts that into a Money with precision 2.

randomMoney :: (Double, Double) -> IO Money
randomMoney range =
  Money . realFracToDecimal 2 <$> getStdRandom (randomR range)

We rewrite getBudget and getTransactions to use randomMoney.

getBudget :: ProjectId -> IO Budget
getBudget _ = do
  income <- randomMoney (0, 10000)
  expenditure <- randomMoney (0, 10000)
  pure Budget {budgetIncome = income, budgetExpenditure = expenditure}

getTransactions :: ProjectId -> IO [Transaction]
getTransactions _ = do
  sale <- Sale <$> randomMoney (0, 4000)
  purchase <- Purchase <$> randomMoney (0, 4000)
  pure [sale, purchase]

The prettyReport function needs some changes. Instead of using printf’s floating-point formatting, we will use Decimal’s Show instance and the roundTo function, which we need to import.

import           Data.Decimal (roundTo)

Let’s write a new function prettyMoney, from Money to String. It rounds the Decimal to a precision of 2 decimal numbers, and adds a “+” sign in front if the number is positive. The Decimal show instance already adds a “-” sign if negative.

prettyMoney :: Money -> String
prettyMoney (Money d) = sign ++ show (roundTo 2 d)
  where
    sign =
      if d > 0
        then "+"
        else ""

We can change all unMoney to prettyMoney, and change the printf format string to use strings.

prettyReport :: Report -> String
prettyReport r =
  printf
    "Budget: %s, Net: %s, difference: %s"
    (prettyMoney (budgetProfit r))
    (prettyMoney (netProfit r))
    (prettyMoney (difference r))

OK, we now have decimals. Let’s continue with the customer requirements.

A Polymorphic ProjectGroup Field

Our hypothetical customer wants reporting at the project group level as well. We extend the project data type with yet another type argument, and a polymorphic field for project groups, to store the new information.

data Project g a
  = Project Text
            a
  | ProjectGroup Text
                 g
                 [Project g a]
  deriving (Show, Eq, Functor, Foldable, Traversable)

The field g will be the slot for project group level reports in our resulting data structure. It could hold any data, so if we wanted project groups to have IDs, this would be a place to put them. We use the type variable g when constructing the recursive Project type.

Reports for Project Groups

We will use the WriterT monad transformer to collect child project reports as we recurse through the project data structure. The MonadWriter type class is a multi-param type class, and thus we need to enable FlexibleContexts.

{-# LANGUAGE FlexibleContexts #-}

liftIO will be needed to lift an IO action into a WriterT action, and we need some functions related to WriterT.

import Control.Monad.IO.Class (liftIO)
import Control.Monad.Writer (listen, runWriterT, tell)

We will not need the accumulateProjectReport function anymore, as calculateProjectReports will return reports on all levels.

calculateProjectReports will accept a project tree with any group value g, and return an IO action of a project tree, with reports for group projects and invididual projects.

In this version of calculateProjectReports, we will do recursion explicitly. Even if we would reach for something like Bifunctors or Bitraversables, we could not collect child reports in a traversal while retaining the project tree structure. Again, Traversable only transforms individual elements, and Foldable collapses the structure.

Instead, we will define calc, a function that recurses through the project tree using the WriterT monad transformer, combined with IO.

The Haskell Wiki describes the writer monad’s computation type as “computations which produce a stream of data in addition to the computed values” and says it’s “useful for logging, or computations that produce output on the side.” In our case, the output produced on the side is a report, and the computed value is a project.

We will start at the top project level, so we need that argument. The result of runWriterT is a tuple of the return value of the computation, and the written report. As we have already included the relevant reports in our return value (the project structure, that is,) we extract only the first element of the tuple.

calculateProjectReports :: Project g ProjectId -> IO (Project Report Report)
calculateProjectReports project = fst <$> runWriterT (calc project)
  where
    -- (definitions below)

Given a single project, we will calculate a report, just as before. But in addition to including it in the resulting project value, we will also tell it. This is an operation of the Writer monad.

    calc (Project name p) = do
      report <-
        liftIO (calculateReport <$> DB.getBudget p <*> DB.getTransactions p)
      tell report
      pure (Project name report)

Given a project group, we calculate report-decorated projects by mapping calc over all sub-projects. Also, we use listen to extract the combined report of all those sub-projects.

    calc (ProjectGroup name _ projects) = do
      (projects', report) <- listen (mapM calc projects)
      pure (ProjectGroup name report projects')

With the writer monad, the type of value you tell must have a Monoid instance. All told values are appended, starting with the empty element, and thus we get a single report back.

At the project group level, we don’t have to tell any report, as the individual projects under it have already done so, and as those reports accumulate in the writer monad.

Printing and Testing

In the PrettyPrint module, we will not need the qualified import of Text anymore.

The asTree function will now need yet another pretty-printing function as an argument. It will be used to print group values. Like with prettyValue, we need to pass it along when recursing.

asTree :: (g -> String) -> (a -> String) -> Project g a -> Tree String
asTree prettyGroup prettyValue project =
  case project of
    Project name x -> Node (printf "%s: %s" name (prettyValue x)) []
    ProjectGroup name x projects ->
      Node
        (printf "%s: %s" name (prettyGroup x))
        (map (asTree prettyGroup prettyValue) projects)

Again, the prettyProject helper needs the same arguments.

prettyProject :: (g -> String) -> (a -> String) -> Project g a -> String
prettyProject prettyGroup prettyValue =
  drawTree . asTree prettyGroup prettyValue

In our Demo module test data, we don’t have any group values. We don’t have any interesting information to put there at the moment, so we will use unit values.

someProject :: Project () ProjectId
someProject = ProjectGroup "Sweden" () [stockholm, göteborg, malmö]
  where
    stockholm = Project "Stockholm" 1
    göteborg = Project "Gothenburg" 2
    malmö = ProjectGroup "Malmö" () [city, limhamn]
    city = Project "Malmö City" 3
    limhamn = Project "Limhamn" 4

We can now calculate a project tree with reports on all levels, and pretty-print it, using prettyReport for both groups and individual projects.

$ stack repl
...
> pr <- calculateProjectReports someProject
> putStrLn (prettyProject prettyReport prettyReport pr)
Reporting Database Demo PrettyPrint Project Reporting> pr <- calculateProjectReports someProject
*Reporting Database Demo PrettyPrint Project Reporting> putStrLn (prettyProject prettyReport pretty
prettyMoney    prettyProject  prettyReport
*Reporting Database Demo PrettyPrint Project Reporting> putStrLn (prettyProject prettyReport prettyReport pr)
Sweden: Budget: -6850.33, Net: -5592.98, difference: +1257.35
|
+- Stockholm: Budget: +2868.43, Net: -3065.94, difference: -5934.37
|
+- Gothenburg: Budget: +1938.65, Net: +2314.45, difference: +375.80
|
`- Malmö: Budget: -11657.41, Net: -4841.49, difference: +6815.92
   |
   +- Malmö City: Budget: -9428.67, Net: -2829.45, difference: +6599.22
   |
   `- Limhamn: Budget: -2228.74, Net: -2012.04, difference: +216.70

Very nice reporting, indeed!

Summary

And we’re done. We have extended our project management system to handle reporting at all project levels, using explicit recursion, and the WriterT monad transformer to accumulate reports along the way.

In the next part, the last one of this series, we will accomplish the same goal in much more generic way, using the Fixplate package.

Source Code

The source code for the full series is available at github.com/haskell-at-work/domain-modelling-with-haskell.