## Domain Modelling with Haskell: Accumulating with WriterT

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)

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.