Let’s say we wanted to perform two operations on a tree:

- count the number of leaves
- transform it to a list

In this post we will perform both by employing three different strategies:

- recursive functions
- using the Foldable typeclass
- using the State Monad

```
data Tree a
= Leaf a
| Node (Tree a) (Tree a)
instance showTree :: Show a => Show (Tree a) where
show (Leaf x) = "(Leaf " <> show x <> ")"
show (Node l r) = "(Node " <> show l <> " " <> show r <> ")"
exampleTree :: Tree Char
exampleTree =
Node
(Node (Leaf 'a') (Leaf 'b'))
(Leaf 'c')
main :: Effect Unit
main = do
logShow exampleTree
-- (Node (Node (Leaf 'a') (Leaf 'b')) (Leaf 'c'))
```

PureScript is a purely functional programming language and `Tree a`

is a recursive type: recursive functions are a perfect fit.

```
countTreeRec :: forall a. Tree a -> Int
countTreeRec tree =
go 0 tree
where
go i (Leaf _) = i + 1
go i (Node l r) = go i l + go i r
toListRec :: forall a. Tree a -> List a
toListRec tree =
go Nil tree
where
go xs (Leaf x) = xs <> Cons x Nil
go xs (Node l r) = go xs l <> go xs r
main :: Effect Unit
main = do
logShow $ countTreeRec exampleTree
-- 3
logShow $ toListRec exampleTree
-- ('a' : 'b' : 'c' : Nil)
```

The functions do what they are supposed to do. However, their shape is really similar. The only differences between `countTreeRec`

and `toListRec`

are:

- the initial value passed to the
`go`

function (i.e.`0`

vs`Nil`

) - the calculation in the base case of
`go`

(i.e.`i + 1`

vs`xs <> Cons x Nil`

) - the way the recursive case combines the result of the recursive calls (i.e.
`+`

vs`<>`

)

What’s described above is exactly what the Foldable typeclass captures. Let’s see how that looks in code.

The Foldable typeclass captures the idea of “folding” a structure into another one.

```
instance foldableTree :: Foldable Tree where
-- foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m
foldMap g (Leaf x) = g x
foldMap g (Node l r) = foldMap g l <> foldMap g r
foldr g = foldrDefault g
foldl g = foldlDefault g
countTreeFold :: forall a. Tree a -> Int
countTreeFold tree =
count
where Additive count = foldMap (\_ -> Additive 1) tree
toListFold :: forall a. Tree a -> List a
toListFold tree =
foldMap (\x -> Cons x Nil) tree
main :: Effect Unit
main = do
logShow $ countTreeFold exampleTree
-- 3
logShow $ toListFold exampleTree
-- ('a' : 'b' : 'c' : Nil)
```

In this case, we could have used `foldr`

or `foldl`

to achieve the same results. But `foldMap`

is a tad more elegant. The way it works is simple:

- It first runs each element of the tree through the function passed to it (i.e.
`(\_ -> Additive 1)`

vs`(\x -> Cons x Nil)`

. That function must transform each element of the tree into a Monoid - It combines all of the Monoids of the tree using the
`<>`

operator. Since`<>`

is implemented as`+`

for`Additive`

and`<>`

is implemented as`Cons`

for`List`

, everything works as before.

Try to compare `countTreeFold`

vs `countTreeRec`

and `toListFold`

vs `toListRec`

.

The foldable trick is totally cool. But why not go overkill implementing and using a State Monad?

```
newtype State s a = State (s -> Tuple a s)
runState :: forall s a. State s a -> s -> Tuple a s
runState (State s) a = s a
instance functorState :: Functor (State s) where
-- map :: forall a b. (a -> b) -> f a -> f b
map g f = State (\s -> let Tuple a s' = runState f s in Tuple (g a) s')
instance applyState :: Functor (State s) => Apply (State s) where
-- apply :: forall a b. f (a -> b) -> f a -> f b
apply fg f = State (\s -> let Tuple g s' = runState fg s
Tuple a s'' = runState f s' in Tuple (g a) s'')
instance applicativeState :: Apply (State s) => Applicative (State s) where
-- pure :: forall a. a -> f a
pure a = State (\s -> Tuple a s)
instance bindState :: Apply (State s) => Bind (State s) where
-- bind :: forall a b. m a -> (a -> m b) -> m b
bind m mg = State (\s -> let Tuple a s' = runState m s in runState (mg a) s')
addOne :: State Int Int
addOne = State (\s -> Tuple s (s+1))
countTreeState :: forall a. Tree a -> State Int (Tree Int)
countTreeState (Leaf _) = Leaf <$> addOne
countTreeState (Node l r) = Node <$> countTreeState l <*> countTreeState r
appendValue :: forall a. a -> State (List a) a
appendValue x = State (\s -> Tuple x (s <> Cons x Nil))
toListState :: forall a. Tree a -> State (List a) (Tree a)
toListState (Leaf x) = Leaf <$> appendValue x
toListState (Node l r) = Node <$> toListState l <*> toListState r
main :: Effect Unit
main = do
logShow $ snd $ runState (countTreeState exampleTree) 0
-- 3
logShow $ snd $ runState (toListState exampleTree) Nil
-- ('a' : 'b' : 'c' : Nil)
```

I’m gonna cover `State`

in a future post, so keep tuned!

```
module Main where
import Prelude (class Applicative, class Apply, class Bind, class Functor, class Show, Unit, discard, show, ($), (+), (<$>),
(<*>), (<>))
import Effect (Effect)
import Effect.Console (logShow)
import Data.Foldable
import Data.List (List(..), foldMap)
import Data.Monoid.Additive (Additive(..))
import Data.Tuple (Tuple(..), snd)
data Tree a
= Leaf a
| Node (Tree a) (Tree a)
instance showTree :: Show a => Show (Tree a) where
show (Leaf x) = "(Leaf " <> show x <> ")"
show (Node l r) = "(Node " <> show l <> " " <> show r <> ")"
exampleTree :: Tree Char
exampleTree =
Node
(Node (Leaf 'a') (Leaf 'b'))
(Leaf 'c')
countTreeRec :: forall a. Tree a -> Int
countTreeRec tree =
go 0 tree
where
go i (Leaf _) = i + 1
go i (Node l r) = go i l + go i r
toListRec :: forall a. Tree a -> List a
toListRec tree =
go Nil tree
where
go xs (Leaf x) = xs <> Cons x Nil
go xs (Node l r) = go xs l <> go xs r
instance foldableTree :: Foldable Tree where
-- foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m
foldMap g (Leaf x) = g x
foldMap g (Node l r) = foldMap g l <> foldMap g r
foldr g = foldrDefault g
foldl g = foldlDefault g
countTreeFold :: forall a. Tree a -> Int
countTreeFold tree =
count
where Additive count = foldMap (\_ -> Additive 1) tree
toListFold :: forall a. Tree a -> List a
toListFold tree =
foldMap (\x -> Cons x Nil) tree
newtype State s a = State (s -> Tuple a s)
runState :: forall s a. State s a -> s -> Tuple a s
runState (State s) a = s a
instance functorState :: Functor (State s) where
-- map :: forall a b. (a -> b) -> f a -> f b
map g f = State (\s -> let Tuple a s' = runState f s in Tuple (g a) s')
instance applyState :: Functor (State s) => Apply (State s) where
-- apply :: forall a b. f (a -> b) -> f a -> f b
apply fg f = State (\s -> let Tuple g s' = runState fg s
Tuple a s'' = runState f s' in Tuple (g a) s'')
instance applicativeState :: Apply (State s) => Applicative (State s) where
-- pure :: forall a. a -> f a
pure a = State (\s -> Tuple a s)
instance bindState :: Apply (State s) => Bind (State s) where
-- bind :: forall a b. m a -> (a -> m b) -> m b
bind m mg = State (\s -> let Tuple a s' = runState m s in runState (mg a) s')
addOne :: State Int Int
addOne = State (\s -> Tuple s (s+1))
countTreeState :: forall a. Tree a -> State Int (Tree Int)
countTreeState (Leaf _) = Leaf <$> addOne
countTreeState (Node l r) = Node <$> countTreeState l <*> countTreeState r
appendValue :: forall a. a -> State (List a) a
appendValue x = State (\s -> Tuple x (s <> Cons x Nil))
toListState :: forall a. Tree a -> State (List a) (Tree a)
toListState (Leaf x) = Leaf <$> appendValue x
toListState (Node l r) = Node <$> toListState l <*> toListState r
main :: Effect Unit
main = do
logShow exampleTree
-- (Node (Node (Leaf 'a') (Leaf 'b')) (Leaf 'c'))
logShow $ countTreeRec exampleTree
-- 3
logShow $ toListRec exampleTree
-- ('a' : 'b' : 'c' : Nil)
logShow $ countTreeFold exampleTree
-- 3
logShow $ toListFold exampleTree
-- ('a' : 'b' : 'c' : Nil)
logShow $ snd $ runState (countTreeState exampleTree) 0
-- 3
logShow $ snd $ runState (toListState exampleTree) Nil
-- ('a' : 'b' : 'c' : Nil)
```

An example run

The code

```
module Main where
import Prelude
import Effect (Effect)
import Effect.Console (log)
import Data.Tuple (Tuple(..))
import Data.Array.NonEmpty as NEA
import Data.Array as A
import Data.Foldable (elem, length)
import Data.String.Common as S
import Effect.Timer as T
import Control.MonadZero (guard)
maxX :: Int
maxX = 80
maxY :: Int
maxY = 10
type Y = Int
type X = Int
type Pos = Tuple Y X
-- Alive cells
type Board = Array Pos
block :: Board
block =
[ Tuple 0 0
, Tuple 0 1
, Tuple 1 0
, Tuple 1 1
]
blinker :: Board
blinker =
[ Tuple 0 1
, Tuple 1 1
, Tuple 2 1
]
glider :: Board
glider =
[ Tuple 0 1
, Tuple 1 2
, Tuple 2 0
, Tuple 2 1
, Tuple 2 2
]
showBoard :: Board -> String
showBoard board =
S.joinWith "\n" $ map showRow $ A.groupBy haveSameY $ A.sort allPositions
where
haveSameY :: Pos -> Pos -> Boolean
haveSameY (Tuple y1 _) (Tuple y2 _) = y1 == y2
showRow :: NEA.NonEmptyArray Pos -> String
showRow fs = S.joinWith "" $ NEA.toArray $ map (\f -> if elem f board then "O" else "X") fs
nextGeneration :: Board -> Board
nextGeneration board = do
p <- allPositions
guard $ willLive p board
pure p
allPositions :: Board
allPositions = do
y <- A.range 0 maxY
x <- A.range 0 maxX
pure $ Tuple y x
willLive :: Pos -> Board -> Boolean
willLive p board =
case Tuple (aliveNeighbors p board) (isAlive board p) of
Tuple 0 true -> false
Tuple 1 true -> false
Tuple 2 true -> true
Tuple 3 _ -> true
_ -> false
aliveNeighbors :: Pos -> Board -> Int
aliveNeighbors p board =
length $ A.filter (isAlive board) $ neighbors p
isAlive :: Board -> Pos -> Boolean
isAlive board p =
elem p board
neighbors :: Pos -> Array Pos
neighbors p1@(Tuple y1 x1) = do
y2 <- A.range (y1 - 1) (y1 + 1)
x2 <- A.range (x1 - 1) (x1 + 1)
let p2 = Tuple y2 x2
guard $ p1 /= p2
pure p2
loop :: Board -> Effect Unit
loop board = do
log "\x1B[2J\x1B[0f" -- clear terminal
log $ showBoard board
log ""
_ <- T.setTimeout 2000 (loop $ nextGeneration board)
pure unit
main :: Effect Unit
main = do
-- loop block
-- loop blinker
loop glider
pure unit
```

Nim is a mathematical game of strategy in which two players take turns removing (i.e., nimming) objects from distinct heaps or piles. On each turn, a player must remove at least one object, and may remove any number of objects provided they all come from the same heap/pile. The goal of the game is to avoid taking the last object.

An example run

```
1: * * * * *
2: * * * *
3: * * *
4: * *
5: *
Player1
Insert ROW NUM. Example '1 3'
> 1 3
1: * *
2: * * * *
3: * * *
4: * *
5: *
Player2
Insert ROW NUM. Example '1 3'
> 1 3
Invalid move
Player2
Insert ROW NUM. Example '1 3'
...
```

The code

```
module Main where
import Prelude
import Effect (Effect)
import Effect.Console (log, logShow)
import Data.Foldable (foldMap, foldr)
import Data.Array as Array
import Data.String.Common as String
import Node.ReadLine as RL
import Data.String.Pattern (Pattern(..))
import Data.Int as Int
import Data.Maybe (Maybe(..))
newtype Board = Board
{ row1 :: Int
, row2 :: Int
, row3 :: Int
, row4 :: Int
, row5 :: Int
}
instance showBoard :: Show Board where
show (Board board) = foldMap identity
[ "1: ", stars board.row1, "\n"
, "2: ", stars board.row2, "\n"
, "3: ", stars board.row3, "\n"
, "4: ", stars board.row4, "\n"
, "5: ", stars board.row5
]
where stars i = String.joinWith " " $ Array.replicate i "*"
data Player
= Player1
| Player2
instance showPlayer :: Show Player where
show Player1 = "Player1"
show Player2 = "Player2"
initialBoard :: Board
initialBoard = Board
{ row1: 5
, row2: 4
, row3: 3
, row4: 2
, row5: 1
}
nextPlayer :: Player -> Player
nextPlayer Player1 = Player2
nextPlayer Player2 = Player1
validMove :: Int -> Int -> Board -> Boolean
validMove 1 num (Board board) = board.row1 >= num
validMove 2 num (Board board) = board.row2 >= num
validMove 3 num (Board board) = board.row3 >= num
validMove 4 num (Board board) = board.row4 >= num
validMove 5 num (Board board) = board.row5 >= num
validMove _ _ _ = false
play :: Int -> Int -> Board -> Board
play 1 num (Board board) = Board $ board { row1 = board.row1 - num }
play 2 num (Board board) = Board $ board { row2 = board.row2 - num }
play 3 num (Board board) = Board $ board { row3 = board.row3 - num }
play 4 num (Board board) = Board $ board { row4 = board.row4 - num }
play 5 num (Board board) = Board $ board { row5 = board.row5 - num }
play _ num (Board board) = Board board
finished :: Board -> Boolean
finished (Board board) = foldr (\a b -> a && b) true
[ board.row1 == 0
, board.row2 == 0
, board.row3 == 0
, board.row4 == 0
, board.row5 == 0
]
main :: Effect Unit
main = do
interface <- RL.createConsoleInterface RL.noCompletion
let
lineHandler board player move =
case map Int.fromString $ String.split (Pattern " ") move of
[ Just row, Just num ] ->
if validMove row num board
then do
let nextBoard = play row num board
let nextPlayer_ = nextPlayer player
if finished nextBoard
then do
RL.close interface
log $ show nextPlayer_ <> " won!"
else do
logShow nextBoard
logShow nextPlayer_
RL.setLineHandler interface $ lineHandler nextBoard nextPlayer_
log "Insert ROW NUM. Example '1 3'"
RL.setPrompt "> " 2 interface
RL.prompt interface
else do
log "Invalid move"
logShow player
log "Insert ROW NUM. Example '1 3'"
RL.setPrompt "> " 2 interface
RL.prompt interface
_ -> do
log "Insert ROW NUM. Example '1 3'"
RL.setPrompt "> " 2 interface
RL.prompt interface
logShow initialBoard
logShow Player1
RL.setLineHandler interface $ lineHandler initialBoard Player1
log "Insert ROW NUM. Example '1 3'"
RL.setPrompt "> " 2 interface
RL.prompt interface
```

An example run

The code

```
module Main where
import Prelude
import Effect (Effect)
import Effect.Console (log)
import Node.ReadLine as RL
import Data.String.Yarn (fromChars, toChars) as S
import Data.List.Lazy as L
import Data.String (length) as S
mask :: String -> String -> String
mask word guess =
let as = S.toChars word :: L.List Char
bs = S.toChars guess :: L.List Char
bs' = bs <> L.replicate (L.length as - L.length bs) '-'
zipper a b = if a == b then a else '-'
in
S.fromChars $ L.zipWith zipper as bs'
main :: Effect Unit
main = do
interface <- RL.createConsoleInterface RL.noCompletion
let
lineHandler word guess =
case word of
"" -> do
log $ S.fromChars $ L.take (S.length guess) (L.repeat '-')
log "Try to guess"
RL.setLineHandler interface $ lineHandler guess
RL.setPrompt "> " 2 interface
RL.prompt interface
_ ->
if word == guess then do
RL.close interface
log "You won!"
else do
log $ mask word guess
RL.setPrompt "> " 2 interface
RL.prompt interface
RL.setLineHandler interface $ lineHandler ""
log "Insert word to guess"
RL.setPrompt "> " 2 interface
RL.prompt interface
```

By default Hakyll does not add the proper meta tags for Twitter Cards. For that reason, if we try to tweet a link to a Hakyll post, no card will be rendered. We can confirm that by using Twitter’s Card Validator:

That can be fixed with a few lines of code:

As explained in the docs, it’s enough to add to the `head`

of the HTML document the following stuff:

```
<meta name="twitter:card" content="summary" />
<meta name="twitter:site" content="@nytimesbits" />
<meta name="twitter:creator" content="@nickbilton" />
<meta property="og:url" content="http://bits.blogs.nytimes.com/2011/12/08/a-twitter-for-my-sister/" />
<meta property="og:title" content="A Twitter for My Sister" />
<meta property="og:description" content="In the early days, Twitter grew so quickly that it was almost impossible to add new features because engineers spent their time trying to keep the rocket ship from stalling." />
<meta property="og:image" content="http://graphics8.nytimes.com/images/2011/12/08/technology/bits-newtwitter/bits-newtwitter-tmagArticle.jpg" />
```

In Hakyll we can add the meta tags to `templates/default.html`

. We just need to make sure to have them only in the post pages. To make that happen, we just check if the `description`

key is present in the context:

```
$if(description)$
<meta name="twitter:card" content="summary" />
<meta name="twitter:site" content="MY_TWITTER_HANDLE" />
<meta name="twitter:creator" content="MY_TWITTER_HANDLE" />
<meta property="og:url" content="$url$" />
<meta property="og:title" content="$title$" />
<meta property="og:description" content="$description$" />
<meta property="og:image" content="$cover_image$" />
$else$
$endif$
```

And then in each post metadata we need to add `description`

and `cover_image`

:

This week I’ve decided to write some code in PureScript that resembles a compiler. As for the last few posts, I’ve limited the scope to the smallest possible unit.

That means, I haven’t had much time to learn about compilers myself. Hopefully, this will prove useful foundation when I’ll decide to dive deeper.

As long as I understand, a compiler consists of a series of steps that take some input code and transforms it into the target language.

As an input we will use a language that supports two operations (i.e. `add`

and `sub`

) on integers. In particular, we will use as an input the following code: `add 1 sub 6 add 3 2`

.

The first thing we want to do is to parse the code into an Abstract Syntax Tree (AST). In other words, a structure that enables us to work easily with the code. The AST for the example code provided above would look like

```
add
/ \
1 sub
/ \
6 add
/ \
3 2
```

The code to do that is the following

```
data Ast
= Node Op Ast Ast
| Value Int
instance showAst :: Show Ast where
show (Node op ast1 ast2) = "(" <> show op <> " " <> show ast1 <> " " <> show ast2 <> ")"
show (Value i) = show i
data Op
= Add
| Sub
instance showOp :: Show Op where
show Add = "Add"
show Sub = "Sub"
astParser :: Parser Ast
astParser = do
skipSpaces
op <- opParser
skipSpaces
ast1 <- valueParser <|> astParser
skipSpaces
ast2 <- valueParser <|> astParser
pure $ Node op ast1 ast2
opParser :: Parser Op
opParser =
addParser <|> subParser
addParser :: Parser Op
addParser = do
_ <- string "add"
pure Add
subParser :: Parser Op
subParser = do
_ <- string "sub"
pure Sub
intParser :: Parser Int
intParser = do
ds <- many1 anyDigit
case fromString $ fromChars ds of
Just i -> pure i
Nothing -> fail "I was expecting an int!"
valueParser :: Parser Ast
valueParser = do
i <- intParser
pure $ Value i
```

With the AST at our disposal we can either compile to some other language or evaluate the code:

```
generate :: Ast -> String
generate (Value i) = show i
generate (Node Add ast1 ast2) =
"(" <> generate ast1 <> " + " <> generate ast2 <> ")"
generate (Node Sub ast1 ast2) =
"(" <> generate ast1 <> " - " <> generate ast2 <> ")"
evaluate :: Ast -> Int
evaluate (Value i) = i
evaluate (Node Add ast1 ast2) =
evaluate ast1 + evaluate ast2
evaluate (Node Sub ast1 ast2) =
evaluate ast1 - evaluate ast2
```

```
input :: String
input =
"add 1 sub 6 add 3 2"
main :: Effect Unit
main = do
logShow $ runParser astParser input
-- (Right (Add 1 (Sub 6 (Add 3 2))))
logShow $ map generate $ runParser astParser input
-- (Right "(1 + (6 - (3 + 2)))")
logShow $ map evaluate $ runParser astParser input
-- (Right 2)
```

If you want to read more, this is what inspired me to take a few steps into the compilers world:

- The Super Tiny Compiler
- Tiny Interepter and Compiler
- How to be a compiler — make a compiler with JavaScript

If you liked the post and want to help spread the word, please make some noise 🤘 But only if you really liked it. Otherwise, please feel free to comment or tweet me with any suggestions or feedback. And please do cause I need help with my FP!

Let’s start with a refresher of `map`

:

In other words, map takes a function `a -> b`

and gives us a function `f a -> f b`

. For that reason, we can take any two nested functors (e.g. `Array`

and `Maybe`

) and run a function on the nested values by putting two `map`

s together:

```
v :: Array (Maybe Int)
v = [Just 1, Nothing, Just 3]
f1 :: Int -> String
f1 = show
main :: Effect Unit
main = do
logShow $ map (map f1) v
-- [(Just "1"),Nothing,(Just "3")]
```

This time we want to take a look at `bind`

:

If we tried to compose the same way we did with functors, we would notice the code does not compile:

```
v :: Array (Maybe Int)
v = [Just 1, Nothing, Just 3]
f2 :: Int -> Array (Maybe String)
f2 i = [Just $ show i]
main :: Effect Unit
main = do
logShow $ bind v (\x -> bind x f2) -- DOES NOT COMPILE!!
```

The problem here is in the nested `bind`

:

In fact, `Maybe Int -> (Int -> Array (Maybe String)) -> ??`

is not what `bind`

expects: the first argument seems to indicate that `m`

is `Maybe`

but the second seems to indicate that `m`

is `Array`

. This does not compile since the monad `m`

is supposed to be the same.

To make the program compile we have to make use of a function (i.e. `maybe`

) specific to the monad we are dealing with (i.e. `Maybe`

):

```
main :: Effect Unit
main = do
-- logShow $ bind v (\x -> bind x f2) -- DOES NOT COMPILE!!
logShow $ bind v (maybe (pure Nothing) f2)
```

Or we could use the `MaybeT`

monad transformer:

```
v2 :: MaybeT Array Int
v2 = MaybeT [Just 1, Nothing, Just 3]
f3 :: Int -> MaybeT Array String
f3 i = MaybeT [Just $ show i]
main :: Effect Unit
main = do
--logShow $ bind v (\x -> bind x f2)
logShow $ bind v (maybe [Nothing] f2)
logShow $ runMaybeT $ bind v2 f3
```

I’ve blatantly copied the content of this blog post out of a talk by Tony Morris. So be sure to check the original stuff out!

If you liked the post and want to help spread the word, please make some noise 🤘 But only if you really liked it. Otherwise, please feel free to comment or tweet me with any suggestions or feedback. And please do cause I need help with my FP!

Last week we’ve had some fun solving the Bank Kata in PureScript. Now it’s time to add some unit tests.

In particular, we are going to test the three main functions of the kata:

```
deposit :: Int -> StateT (Array Transaction) Effect Unit
withdraw :: Int -> StateT (Array Transaction) Effect Unit
printStatement :: StateT (Array Transaction) Effect Unit
```

Let’s start with `deposit`

:

```
deposit :: Int -> StateT (Array Transaction) Effect Unit
deposit amount = do
ts <- lift nowDateTime
let t = Deposit { timestamp: ts, amount: amount }
modify\_ \ts -> ts <> [t]
```

Unfortunately, it uses `Effect`

. That means, it does something impure we cannot check in a unit test.

We can fix that easily by changing the type signature into

In other words, we don’t specify the specific monad (`Effect`

) anymore. We just say that `deposit`

uses a monad `m`

as a base monad for `StateT`

.

Sadly, that does not compile. In fact, the type signature is telling a lie. In the body of the function we do `ts <- lift nowDateTime`

. As explained in the previous post, that obliges the function to use `Effect`

.

Luckily, this is an easy fix. Instead of using `nowDateTime`

in `deposit`

, we will just inject it:

The downside of this refactoring is that we need to change the production code from `deposit 500`

to `deposit nowDateTime 500`

. The upside is that we can use a unit testable monad now. Not that bad!

Here’s the test

```
testDeposit :: Effect Unit
testDeposit = do
ts <- nowDateTime
let amount = 1
expected = Identity [Deposit {amount: amount, timestamp: ts}]
actual = execStateT (deposit (Identity timestamp) amount) []
assertEqual { actual: actual, expected: expected }
```

We wrap `timestamp :: DateTime`

in the `Identity`

monad so that `deposit (Identity timestamp) amount`

has type `StateT (Array Transaction) Identity Unit`

. That means, `execStateT`

returns `Identity (Array Transaction)`

.

Testing `withdraw`

follows the exact same pattern so we are not going to cover that.

Let’s move to `printStatement`

:

```
printStatement :: StateT (Array Transaction) Effect Unit
printStatement = do
s <- gets toStatement
lift $ log s
```

Here the story is really similar to what we did to `deposit`

:

```
printStatement :: forall m. Monad m => (String -> m Unit) -> StateT (Array Transaction) m Unit
printStatement logger = do
s <- gets toStatement
lift $ logger s
```

And the corresponding unit test:

```
testPrintStatementWithTransactions :: Effect Unit
testPrintStatementWithTransactions = do
timestamp <- nowDateTime
let d = Deposit { amount: 500, timestamp: timestamp }
w = Withdraw { amount: 100, timestamp: timestamp }
state = [d, w]
expected = "expected string"
actual = execWriter (execStateT (printStatement \s -> tell s) state)
assertEqual { actual: actual, expected: expected }
```

Notice that as a base monad we use `Writer`

. This monad gives us access to `tell`

which allows us to append to an accumulator. That way `printStatement`

“writes” the statement in the accumulator instead of the console.

Code:

```
data Transaction
= Deposit Info
| Withdraw Info
derive instance eqTransaction :: Eq Transaction
instance showTransaction :: Show Transaction where
show (Deposit i) = show i
show (Withdraw i) = show i
type Info =
{ timestamp :: DateTime
, amount :: Int
}
deposit :: forall m. Monad m => m DateTime -> Int -> StateT (Array Transaction) m Unit
deposit nowDateTime amount = do
ts <- lift nowDateTime
let t = Deposit { timestamp: ts, amount: amount }
modify_ \ts -> ts <> [t]
withdraw :: forall m. Monad m => m DateTime -> Int -> StateT (Array Transaction) m Unit
withdraw nowDateTime amount = do
ts <- lift nowDateTime
let t = Withdraw { timestamp: ts, amount: amount }
modify_ \ts -> ts <> [t]
printStatement :: forall m. Monad m => (String -> m Unit) -> StateT (Array Transaction) m Unit
printStatement logger = do
s <- gets toStatement
lift $ logger s
toStatement :: Array Transaction -> String
toStatement =
fst <<< foldl fnc (Tuple "" 0)
where
fnc (Tuple s i) (Deposit d) =
Tuple (s <> "\n" <> joinWith " " [ show d.timestamp, show d.amount, show $ i + d.amount]) (i + d.amount)
fnc (Tuple s i) (Withdraw w) =
Tuple (s <> "\n" <> joinWith " " [ show w.timestamp, "-" <> show w.amount, show $ i - w.amount]) (i - w.amount)
main :: Effect Unit
main = do
flip evalStateT [] do
deposit nowDateTime 500
withdraw nowDateTime 100
printStatement log
```

Tests:

```
main :: Effect Unit
main = do
testDeposit
testWithdraw
testPrintStatementNoTransactions
testPrintStatementWithTransactions
testDeposit :: Effect Unit
testDeposit = do
timestamp <- nowDateTime
let amount = 1
expected = Identity [ Deposit { amount: amount, timestamp: timestamp } ]
actual = execStateT (deposit (Identity timestamp) amount) []
assertEqual { actual: actual, expected: expected }
testWithdraw :: Effect Unit
testWithdraw = do
timestamp <- nowDateTime
let amount = 1
expected = Identity [ Withdraw { amount: amount, timestamp: timestamp } ]
actual = execStateT (withdraw (Identity timestamp) amount) []
assertEqual { actual: actual, expected: expected }
testPrintStatementNoTransactions :: Effect Unit
testPrintStatementNoTransactions = do
let expected = ""
actual = execWriter (evalStateT (printStatement \s -> tell s) [])
assertEqual { actual: actual, expected: expected }
testPrintStatementWithTransactions :: Effect Unit
testPrintStatementWithTransactions = do
timestamp <- nowDateTime
let d = Deposit { amount: 500, timestamp: timestamp }
w = Withdraw { amount: 100, timestamp: timestamp }
state = [ d, w ]
expected = "expected string"
actual = execWriter (evalStateT (printStatement \s -> tell s) state)
assertEqual { actual: actual, expected: expected }
```

If you liked the post and want to help spread the word, please make some noise 🤘 But only if you really liked it. Otherwise, please feel free to comment or tweet me with any suggestions or feedback. And please do cause I need help with my FP!

I suck at FP and I desperately need some feedback from you. So please, do not get mad at the code. And double please share feedback if you got any!!

Let’s first introduce the kata by copy / pasting from the awesome Kata-Log:

Write a class Account that offers the following methods void deposit(int) void withdraw(int) String printStatement()

An example statement would be:

```
Date Amount Balance
24.12.2015 +500 500
23.8.2016 -100 400
```

`void deposit(int)`

and `void withdraw(int)`

are impure functions. In fact, they accept an `int`

and return `void`

. The only way they can do anything useful is to mutate some state.

`String printStatement()`

is impure too. As a matter of fact, it returns a string out of nothing. The only way for it to do anything useful is to access some state. In this post, I’ll implement `printStatement`

as if it was `void printStatement()`

. That is, the function will print the statement in the console. The reason is that I don’t know how to code it otherwise.

One way to read / write state in PureScript is using the state monad transformer (`StateT`

).

Therefore, we will use the following types:

```
deposit :: Int -> StateT (Array Transaction) Effect Unit
withdraw :: Int -> StateT (Array Transaction) Effect Unit
printStatement :: StateT (Array Transaction) Effect Unit
```

In other words, our three functions will do their thing in the `StateT (Array Transaction) Effect Unit`

environment. In simpler words, each function will be able to manipulate an array of transactions (state), write to console or get datetimes (monadic operations in `Effect`

) and return nothing (`Unit`

) at the end.

And here we have the type for `Transaction`

:

```
data Transaction
= Deposit Info
| Withdraw Info
type Info =
{ timestamp :: DateTime
, amount :: Int
}
```

Let’s start with `deposit`

:

```
deposit :: Int -> StateT (Array Transaction) Effect Unit
deposit amount = do
ts <- lift nowDateTime
let t = Deposit { timestamp: ts, amount: amount }
modify_ \ts -> ts <> [t]
```

Since we are in a monadic environment (`StateT (Array Transaction) Effect Unit`

), we open the function with a `do`

.

Then we use `nowDateTime :: Effect DateTime`

to get the current datetime. The only catch here is that we need to first `lift nowDateTime`

in `StateT (Array Transaction) Effect Unit`

. That is because in a `do`

block each monadic operation (i.e. non `let`

s) must all use the same monad. In this case, that means that both `lift nowDateTime`

and `modify_ \ts -> ts <> [t]`

have type `StateT (Array Transaction) Effect a`

.

After that, a deposit with correct `timestamp`

and `amount`

is assigned to `t`

.

Lastly, `modify_`

is used to access the current state `ts`

(array of transactions) by appending the new transaction `t`

.

`withdraw`

is almost the same:

```
withdraw :: Int -> StateT (Array Transaction) Effect Unit
withdraw amount = do
ts <- lift nowDateTime
let t = Withdraw { timestamp: ts, amount: amount }
modify_ \ts -> ts <> [t]
```

Finally, we have `printStatement`

:

```
printStatement :: StateT (Array Transaction) Effect Unit
printStatement = do
s <- gets toStatement
lift $ log s
```

The first line uses `gets`

to take the state (array of transactions) and run it through `toStatement :: Array Transaction -> String`

. That means `gets toStatement`

has type `Effect String`

and `s`

has type `String`

.

The last line lifts `log s :: Effect Unit`

in `StateT (Array Transaction) Effect Unit`

. In other words, it prints `s`

to the console.

The implementation of `toStatement`

is not that important. Here is an example of that:

```
toStatement :: Array Transaction -> String
toStatement =
fst <<< foldl fnc (Tuple "" 0)
where
fnc (Tuple s i) (Deposit d) =
Tuple (s <> "\n" <> joinWith " " [show d.timestamp, show d.amount, show $ i + d.amount]) (i + d.amount)
fnc (Tuple s i) (Withdraw w) =
Tuple (s <> "\n" <> joinWith " " [show w.timestamp, "-" <> show w.amount, show $ i - w.amount]) (i - w.amount)
```

Now we can write something like

which has type `StateT (Array Transaction) Effect Unit`

. And we can run that computation with `evalStateT`

. Notice that the following code returns `Effect Unit`

.

And here we have all the code

```
data Transaction
= Deposit Info
| Withdraw Info
type Info =
{ timestamp :: DateTime
, amount :: Int
}
deposit :: Int -> StateT (Array Transaction) Effect Unit
deposit amount = do
ts <- lift nowDateTime
let t = Deposit { timestamp: ts, amount: amount }
modify_ \ts -> ts <> [t]
withdraw :: Int -> StateT (Array Transaction) Effect Unit
withdraw amount = do
ts <- lift nowDateTime
let t = Withdraw { timestamp: ts, amount: amount }
modify_ \ts -> ts <> [t]
printStatement :: StateT (Array Transaction) Effect Unit
printStatement = do
s <- gets toStatement
lift $ log s
toStatement :: Array Transaction -> String
toStatement =
fst <<< foldl fnc (Tuple "" 0)
where
fnc (Tuple s i) (Deposit d) =
Tuple (s <> "\n" <> joinWith " " [ show d.timestamp, show d.amount, show $ i + d.amount]) (i + d.amount)
fnc (Tuple s i) (Withdraw w) =
Tuple (s <> "\n" <> joinWith " " [ show w.timestamp, "-" <> show w.amount, show $ i - w.amount]) (i - w.amount)
main :: Effect Unit
main = do
flip evalStateT [] do
deposit 500
withdraw 100
printStatement
```

If you liked the post and want to help spread the word, please make some noise 🤘 But only if you really liked it. Otherwise, please feel free to comment or tweet me with any suggestions or feedback.

Thanks to Liam Griffin who inspired me to try this exercise in PureScript with his post in Haskell.

Finally, I want to give a shoutout to BusConf and to all the people I’ve met there that showed so much support for my PureScript journey. You are awesome!

If you are hungry for more, see how we can test the code in the followup: Testing Bank Kata in PureScript.