Following the “Book of Monads“, Chapter 13 steps us through various options for building “Custom Monads”, working through an example for the game of TicTacToe. I was excited to play with it a bit and try to understand it better, so I started a repo and threw together a couple versions of implementations. In this post I’ll walk through some of the code. The snippets below are basically copied directly from the repo, based on the state of things at this commit, so you can get full imports and things (and more comments!) if you’re inspired.
Importantly: while I present some things below that work, I’m still very much learning all of this. If you see code below (or in the repo) that could still be simplified or otherwise usefully re-organized, be it in the overall patterns or my use of cats
(or any of the other libraries), or you think there’s a theme or pattern that I’m mis-understanding, please feel encouraged to respond on this post or, even better, put up a PR!
Overall setup
Generally the idea is to have some helper types for the board and players, and then define a custom monad that has two methods:
info
, which allows you to inspect one position in the board and see if a player owns it, and if so, which playertake
, which assigns a position on the board to a player. Intriguingly the position is an argument to this method, but the player is not.
A few different things can happen if you try to take
a position, namely the game could be over (before or after you play), or the spot could be taken, or you could successfully take the position and it’d be the next player’s turn. We’ll capture that with a Return
data type below.
While I was playing with things, I ended up altering the above slightly, and adding to it. In particular, I call the intended take
method forceTake
, to indicate that it is not responsible for checking if the spot is already taken, or if the game is done even, just to assign that spot to the player. This is then paired with a genTake
, which relies on info
and forceTake
, which does all of that checking. The reason for this is that I didn’t want each implementation’s take
to have to worry about all of that logic, which would be the same across implementations.
Additionally, one of the questions I had throughout this exercise was around the state of which player’s turn it was. I *think* that the setup above actually only captures or is intended to capture and manage the board state, leaving it up to a secondary layer to worry about the player and/or game state. However, in my implementation, I’ve lumped them all together, so end up adding two more methods (some implementations don’t add the switchPlayer
, though there’s no particularly good reason for it, and hopefully the inconsistency there isn’t too distracting):
turn
to tell us which player’s turn it isswitchPlayer
to change which player’s turn it is
In my repo, the exploration that I did began with the book’s two monad styles (Final and Initial/Free). I also added more of an “object oriented”-looking implementation, and then sort of an analogous typeclass-based one, and finally, just for fun, one using a “record of functions” approach. I’ll walk through some of these in this post, in more or less detail, but each is also represented by it’s own file in the repo, and there’s hopefully enough useful comments you can poke around there too.
For the various implementations, I generally ended up writing the following library methods, built out of the primitives above:
genTake
, described above, as sort of a “safe”take
, wrapping the implementation’sforceTake
runRandom
to generate random game play and return the final board state and winning player (if there was one)gameEnded
which relies onwinner
, to tell if the game has ended, and if so, which player won
Ok, enough, let’s look at some code.
“Common” code
The code in this section is used throughout the various monadic implementations, setting up the types that they all deal with.
First up, we need to define the shape of the game board, a 3×3 grid. I’ll use the following, where rows and columns are indexed independently with “F”irst, “S”econd, and “T”hird components:
sealed trait BoardIndex
object BoardIndex {
case object F extends BoardIndex
case object S extends BoardIndex
case object T extends BoardIndex
}
case class Position(row: BoardIndex, col: BoardIndex)
Another implementation might have just made 9 positions directly, with names like “UL” for upper-left. But here we are.
When I first started seeing code like that, with the sealed trait
and then an object
with the same name with the various extensions in it, I wondered why you’d bother putting the extensions in the object
. I think the benefit is that it keeps the namespace somewhat cleaner, to only have BoardIndex
, instead of that and all of its children. If you want to import the children you’re welcome to, but they don’t, by default, clobber the namespace.
We also have the notion of the two players (X and O), and set up some more types to represent the overall state of a game, and a helper for the default initial state of a game.
sealed trait Player
object Player {
case object X extends Player
case object O extends Player
}
type Board = Map[Position, Player]
case class GameState(player: Player, board: Board)
val StartingGame = GameState(Player.X, Map.empty)
Finally, some additional utilities around positions to just conveniently access all the available positions, and define what a winning set of positions means. The cats
-provided mapN
creates all pairs of indices
and then pushes them all through the Position
constructor – these lines are a little silly here, because there’s only 9 positions to write out, but part of this exercise was an excuse to play with the cats
library, so I had to try it (see the “List” portion of this section in “Scala with Cats”)
val allPositions = {
import cats.implicits._
val indices = List(BoardIndex.F, BoardIndex.S, BoardIndex.T)
(indices, indices).mapN(Position.apply)
}
def randomPosition(exceptions: Set[Position]): Position =
scala.util.Random.shuffle((allPositions.toSet -- exceptions).toList).head
val winningCombos = {
import BoardIndex._
List(
(Position(F, F), Position(F, S), Position(F, T)),
(Position(S, F), Position(S, S), Position(S, T)),
(Position(T, F), Position(T, S), Position(T, T)),
(Position(F, F), Position(S, F), Position(T, F)),
(Position(F, S), Position(S, S), Position(T, S)),
(Position(F, T), Position(S, T), Position(T, T)),
(Position(F, F), Position(S, S), Position(T, T)),
(Position(T, F), Position(S, S), Position(F, T))
)
}
I know the Random
bit there has side-effects which should be represented, but I decided not to worry about that for this implementation, at least in part because I figured there should be some library I was supposed to use that had it all set up (vs writing just my own ~one method), and I haven’t found said library yet. Also, the “exceptions” there are a list of positions not to return, which are just sort of handy for things like not trying to take a spot you know is taken.
Finally, we set up a custom type to work as the Result
of our genTake
method that we’re going to implement, described in the first section above. This type lets you know what happen when you try to take a position on the board, which can either be that the game is over, the position was already occupied, or the position is now taken by the player and it’s the next player’s turn:
sealed trait Result
object Result {
final case class AlreadyTaken(by: Player) extends Result
final case object NextTurn extends Result
final case class GameEnded(winner: Option[Player]) extends Result
}
A fun extension somewhere in here would aim to set up types so that you couldn’t even call take
(or forceTake
or genTake
) on a game that was already completed. But I haven’t set that up.
“OO” style
While in the repo I wrote the “Final” and “Initial” (and “Free”) bits before an “object oriented” version, in this writeup let’s start with the OO style, to see things that are maybe more familiar. Since I started with those other implementations, my implementations for OO-style were copied over and then made to work, to try minimize differences, so might not look like what you might write without that inspiration, but are still reasonable.
So, to begin, we set up our “interface” for a TicTacToe
class:
trait TicTacToe {
def info(p: Position): Option[Player]
def forceTake(p: Position): Unit
def turn(): Player
}
Returning Unit
from forceTake
isn’t very functional, and it’s one of the entertaining differences to look at in the various implementations we’ll see in a bit.
It’s relatively easily to implement this class, if we allow ourselves mutable variables:
class EmbeddedVarTicTacToe(var gs: GameState = StartingGame) extends TicTacToe {
override def info(pos: Position): Option[Player] =
gs.board.get(pos)
override def forceTake(pos: Position): Unit =
gs = gs.copy(player = Player.other(gs.player), board = gs.board + (pos -> gs.player))
override def turn(): Player =
gs.player
}
Alternatively, we could have forceTake
return a new TicTacToe
, and then we wouldn’t need an inner var
, we could use a val
. The OOTypeclass
implementation (next section) basically does this, and eliminates the need for the wrapper class, and just use GameState
directly. As we’ll see, in the Final style, that’s bundled up in a monad wrapping the return type, so returning Unit
there is still functional.
So, let’s have a look at an implementation of how to check if there’s a winner. We have the “common” winningCombos
, so basically just need to loop through each, and see if, for a given tuple of positions, if each position is occupied, and occupied by the same player. I think the inner playerWins
method can probably still be shortened with some cats
built-in, but I haven’t found it yet. Anyway, here’s some code:
def winner(ttt: TicTacToe): Option[Player] = {
def playerWins(op1: Option[Player], op2: Option[Player], op3: Option[Player]): Option[Player] =
for {
p1 <- op1
p2 <- op2
p3 <- op3 if p1 == p2 && p2 == p3
} yield {
p3
}
def comboWinner(pos1: Position, pos2: Position, pos3: Position): Option[Player] =
playerWins(ttt.info(pos1), ttt.info(pos2), ttt.info(pos3))
winningCombos
.map(t => comboWinner(t._1, t._2, t._3)) // List[Option[Player]]
.flatten.headOption
}
We need to be able to calculate winners as part of telling if a game is over, which we want to do when somebody tries to take a position. So here’s some logic to check if a game is done and, if it is, return the winner (or None
if it was a draw). Roughly, we check first if there’s a winner, using the method above, and if not, we check for a draw (meaning all positions are occupied):
def gameEnded(ttt: TicTacToe): Option[Result.GameEnded] = {
def isDraw: Boolean =
allPositions
.traverse(pos => ttt.info(pos)) // List[Option[Player]] traversed to Option[List[Player]]
.isDefined
def drawResult: Option[Result.GameEnded] =
if (isDraw) {
Some(Result.GameEnded(None))
} else {
None
}
def result(op: Option[Player], or: Option[Result.GameEnded]): Option[Result.GameEnded] =
op.map(p => Result.GameEnded(Some(p))).orElse(or)
result(winner(ttt), drawResult)
}
Finally, with those methods, we’re able to define our genTake
, which is responsible for checking if a game is over, or a spot is taken, before allowing a player to take a position, and then returning a Result
(from the “Common” bit above):
def genTake(ttt: TicTacToe)(pos: Position): Result = {
def forceTakeAndCheck: Result = {
ttt.forceTake(pos)
gameEnded(ttt).getOrElse(Result.NextTurn)
}
def takeSinceNotDone: Result =
ttt.info(pos)
.fold(forceTakeAndCheck)(p => Result.AlreadyTaken(p))
gameEnded(ttt).getOrElse(takeSinceNotDone)
}
“OO Typeclass”
As a quick sub-section of the OO implementation, I tried setting up a typeclass, instead of using “normal” inheritance, just to see. As mentioned above, it inspires the forceTake
to not return Unit
. Besides that, once you add some “bedazzling“, the methods above work as is (the type signature changes to put the typeclass constraint in, but that’s it). Here’s the setup for that code:
trait TicTacToe[T] {
def info(t: T, p: Position): Option[Player]
def forceTake(t: T, p: Position): T // this is sort of a major difference to the OO version
def turn(t: T): Player
}
object TicTacToe {
implicit case object GameStateIsTicTacToe extends TicTacToe[GameState] {
override def info(gs: GameState, p: Position): Option[Player] =
gs.board.get(p)
override def forceTake(gs: GameState, p: Position): GameState =
gs.copy(player = Player.other(gs.player), board = gs.board + (p -> gs.player))
override def turn(gs: GameState): Player =
gs.player
}
implicit class TicTacToeOps[T: TicTacToe](t: T) {
def info(p: Position): Option[Player] =
implicitly[TicTacToe[T]].info(t, p)
def forceTake(p: Position): T =
implicitly[TicTacToe[T]].forceTake(t, p)
def turn(): Player =
implicitly[TicTacToe[T]].turn(t)
}
}
winner
and gameEnded
, like I said, don’t change, and the changes to genTake
are primarily because of the not-returning-Unit
bit of forceTake
:
def genTake[T: TicTacToe](ttt: T)(pos: Position): (T, Result) = {
def forceTakeAndCheck: (T, Result) = {
val nt = ttt.forceTake(pos)
(nt, gameEnded(nt).getOrElse(Result.NextTurn))
}
def takeSinceNotDone: (T, Result) =
ttt.info(pos)
.fold(forceTakeAndCheck)(p => (ttt, Result.AlreadyTaken(p)))
gameEnded(ttt).map((ttt, _)).getOrElse(takeSinceNotDone)
}
“Record of Functions” approach
Eschewing inheritance all together, we can also choose an implementation with a class whose val
s are what we’d normally represent with an object’s methods in an OO style. So instead of extending the class and overloading the method, you just instantiate the class with the methods defined. Here’s what that looks like:
case class TicTacToe(
info: Position => Option[Player],
forceTake: Position => TicTacToe,
turn: () => Player
)
def embeddedVarTicTacToe(gs: GameState = StartingGame): TicTacToe =
TicTacToe(
gs.board.get,
p => embeddedVarTicTacToe(gs.copy(player = Player.other(gs.player), board = gs.board + (p -> gs.player))),
gs.player _
)
The implementations of the methods are all exactly the same as the typeclass bit above (most of which were the same as the original OO code), so I won’t show them. I’d just like to note that this seemed to be a fun and easy pattern.
“Final”, our first monad-style
This is actually the first style discussed in the book. It took me a bit of working through to get any comfort with it, but it was all fun and worthwhile. In this style, we have basically the same starting trait
as in the OO version above (though have the explicit switchUser
– again, forgive this minor distraction), just we wrap each result type with an unknown F
wrapper. We don’t require anything about F
, just that it take one type parameter, so that we can use it as a wrapper:
trait TicTacToe[F[_]] {
def info(p: Position): F[Option[Player]]
def forceTake(p: Position): F[Unit]
def turn(): F[Player]
def switchPlayer(): F[Unit]
}
For convenience, I also define (and subsequently import) some syntax methods:
object TicTacToeSyntax {
def info[F[_]](p: Position)(implicit ev: TicTacToe[F]): F[Option[Player]] =
ev.info(p)
def forceTake[F[_]](p: Position)(implicit ev: TicTacToe[F]): F[Unit] =
ev.forceTake(p)
def turn[F[_]]()(implicit ev: TicTacToe[F]): F[Player] =
ev.turn()
def switchPlayer[F[_]]()(implicit ev: TicTacToe[F]): F[Unit] =
ev.switchPlayer()
}
Let’s have a look at our first “library” method based off the primitives – trying to determine if a TicTacToe
has a winner:
def winner[F[_] : TicTacToe : Applicative]: F[Option[Player]] = {
def playerWins(op1: Option[Player], op2: Option[Player], op3: Option[Player]): Option[Player] =
for {
p1 <- op1
p2 <- op2
p3 <- op3 if p1 == p2 && p2 == p3
} yield {
p3
}
def comboWinner(pos1: Position, pos2: Position, pos3: Position): F[Option[Player]] =
(info(pos1), info(pos2), info(pos3)).mapN(playerWins)
winningCombos
.traverse(t => comboWinner(t._1, t._2, t._3))
.map(_.flatten.headOption)
}
The structure is set up to look as much like the OO implementation above as I could. Indeed, playerWins
is the exact same method. The comboWinner
helper is different only because it relies on the mapN
– since we list the Applicative
constraint on F
, this option basically takes a (F[Z], F[Z], F[Z])
and flips it to a F[(Z, Z, Z)]
, and then since Applicative
implies Functor
it can .map
the playerWins
method in. And then the final statement uses an extra traverse
and map
that aren’t required in the OO version. The fun thing for me in all this was that even though you don’t, in theory, know much about this wrapper F
, with these reasonable assumptions (e.g. Applicative
) you can still write almost the same thing as in the OO style, you just end up relying on some of the machinery (again, Applicative
assumptions).
I’ll note that we expect that we should be able to write the method above using only Applicative
and not Monad
, because what we’re doing is inspecting the board a bunch of times, but we never use the results of one of those inspections as the input for a subsequent inspection. In fact, I’ll note that I originally used the Monad
assumption, and then realized I shouldn’t have to, and you can see the corresponding changes in this diff.
So, that was fun. And basically the story continues for the gameEnded
and genTake
methods – you can get away with almost the same implementation as the OO code above, you just sometimes have to use some of the Applicative
(/Traversable
) or Monad
-ic machinery (for
-comprehensions). Here’s gameEnded
which, again, only needs Applicative
, and again differs from the OO in a few traverse
and mapN
calls:
def gameEnded[F[_] : TicTacToe : Applicative]: F[Option[Result.GameEnded]] = {
def isDraw: F[Boolean] =
allPositions
.traverse(pos => info(pos))
.map(_.traverse(x => x).isDefined)
def drawResult: F[Option[Result.GameEnded]] =
isDraw.map(d =>
if (d) {
Some(Result.GameEnded(None))
} else {
None
}
)
def result(op: Option[Player], or: Option[Result.GameEnded]): Option[Result.GameEnded] =
op.map(p => Result.GameEnded(Some(p))).orElse(or)
(winner, drawResult).mapN(result)
}
And here’s genTake
, where we do need Monad
because we’re sequencing operations and using prior results:
def genTake[F[_] : TicTacToe : Monad](pos: Position): F[Result] = {
def forceTakeAndCheck(pos: Position): F[Result] =
for {
_ <- forceTake(pos)
ge <- gameEnded.map(_.getOrElse(Result.NextTurn))
_ <- switchPlayer()
} yield {
ge
}
def takeSinceNotDone(pos: Position): F[Result] =
for {
op <- info(pos) // op is an Option[Player]
res <- op.fold(forceTakeAndCheck(pos))(p => (Result.AlreadyTaken(p) : Result).pure[F])
} yield {
res
}
for {
ge <- gameEnded
res <- ge.fold(takeSinceNotDone(pos))(r => (r: Result).pure[F])
} yield {
res
}
}
One of the funny differences between this and the OO style is that in the OO style, in scala, we’re able to sequence operations by just putting them on different lines and making a val
, which in some sense gets bundled up in the for
-comprehension’s separate lines. This is some of the intuition for how monad / bind are like the semicolon (that scala doesn’t require, but you could put between lines if you were inspired). The usual caveat that all (mental) models are wrong but some are useful applies.
So, all of the above is still basically setting up a TicTacToe
library, but there’s no implementation yet! Our first implementation will use the State
monad provided by cats
. This is nice, because it means we don’t have to implement our own Monad
, as that’s already done for us in cats
. For convenience, I create the SGS
type alias, fixing the first parameter (the inner state type) of a State
to be GameState
. This abbreviation will show up again later. In this implementation, you can see all the same GameState
machinations we had in the OO version, just all “deferred” because we do them in the context of the State
wrapper.
type SGS[X] = State[GameState, X]
implicit case object SGSIsTicTacToe extends TicTacToe[SGS] {
override def info(p: Position): State[GameState, Option[Player]] =
for {
game <- State.get[GameState]
} yield {
game.board.get(p)
}
override def forceTake(pos: Position): State[GameState, Unit] =
for {
game <- State.get[GameState]
nb = game.board + (pos -> game.player)
_ <- State.set(game.copy(board = nb))
} yield { () }
override def turn(): State[GameState, Player] =
for {
game <- State.get[GameState]
} yield {
game.player
}
override def switchPlayer(): State[GameState, Unit] =
for {
game <- State.get[GameState]
_ <- State.set(game.copy(player = Player.other(game.player)))
} yield { () }
}
This was my first time actually using the State
monad, so it took some getting used to, both the syntax (I’m finding I like the for
-comprehensions above, but originally started with some State.apply
versions which were given functions) and how to use it later. I just had to remember that State
is really a function, so the methods above are building up a composed function, and eventually at some point you have to .run
it on a starting state (and then extract the .value
depending on how you’re using it).
I didn’t show it for the OO version above, but I also wrote a runRandom
method for each implementation, which would generate random gameplay and return who won. Here’s what that looks like:
def runRandom[F[_] : TicTacToe : Monad](exceptions: Set[Position] = Set.empty): F[Option[Player]] = {
val rpos = randomPosition(exceptions)
def cont(r: Result): F[Option[Player]] =
r match {
case Result.GameEnded(op) => op.pure[F]
case _ => runRandom(exceptions + rpos)
}
genTake(rpos).flatMap(cont)
}
Now, just as an example, here’s how you could actually use that with the SGS
type above (if that SGSIsTicTacToe
is in scope):
println(runRandom[SGS]().run(StartingGame).value)
Property-based tests with an F-wrapper
I was thinking about property-based tests while working on this, so took a little diversion to write some. There’s a few for the “Common” code above, and the “OO” implementation, but I was even more interested to see how things went with the Final-style monadic version, because there’s this F
-wrapper in the way all the time. The complete implementation (with links to things to read, and in a project with a build.sbt
where things seem to work, which wasn’t trivial), is here, but I’ll talk through some of it in this section too.
To begin, what property or properties do we think we should test? The main one I was interested in trying for was that genTake
“does what it’s supposed to.” That means that if the game was already done, you don’t do anything and report that the game was done. And if it wasn’t done, but you asked to take a position that was already taken, you get an AlreadyTaken
Result
back, and the state hasn’t changed. And, finally, if you do take the position, then the state does change, and wins are checked appropriately.
Translating all of that text to code, basically we’re going to: inspect the state before we call genTake
, inspect the state afterwards, and then work through the various scenarios of what could have happened. The following is a version of that which works (though it is a bit involved, and I should move the case class
to the containing scope):
def infoThenGenTakeIsBehaved(pos: Position): IsEq[F[Boolean]] = true.pure[F] <-> {
case class TestState(maybeEnded: Option[TTTResult],
originalPosPlayer: Option[Player],
currentPlayer: Player,
takeRes: TTTResult,
afterTurnPosPlayer: Option[Player],
afterTurnCurPlayer: Player)
def gameIsAlreadyOver(ts: TestState) =
ts.maybeEnded.nonEmpty
def alreadyTakenDoneCorrectly(ts: TestState) =
ts.originalPosPlayer.isDefined && ts.takeRes == TTTResult.AlreadyTaken(ts.originalPosPlayer.get) && ts.currentPlayer == ts.afterTurnCurPlayer && ts.originalPosPlayer == ts.afterTurnPosPlayer
def playerGetsPosition(ts: TestState) =
ts.originalPosPlayer.isEmpty && ts.afterTurnPosPlayer == Some(ts.currentPlayer)
def gameEndsInDraw(ts: TestState) =
ts.takeRes == TTTResult.GameEnded(None)
def playerGetsWin(ts: TestState) =
ts.takeRes == TTTResult.GameEnded(Some(ts.currentPlayer))
def nextTurnAndStateUpdates(ts: TestState) =
ts.takeRes == TTTResult.NextTurn && ts.afterTurnCurPlayer == Player.other(ts.currentPlayer)
for {
maybeEnded <- gameEnded
originalPosPlayer <- info(pos)
currentPlayer <- turn
takeRes <- genTake(pos)
afterTurnPosPlayer <- info(pos)
afterTurnCurPlayer <- turn
testState = TestState(maybeEnded, originalPosPlayer, currentPlayer, takeRes, afterTurnPosPlayer, afterTurnCurPlayer)
} yield {
gameIsAlreadyOver(testState) ||
alreadyTakenDoneCorrectly(testState) ||
(playerGetsPosition(testState) &&
(gameEndsInDraw(testState) || playerGetsWin(testState) || nextTurnAndStateUpdates(testState)))
}
}
I decided to define the various helper def
s inside to make it a little more readable, so that the final yield basically matches the text description above. The funny little hidden bit in there is the true.pure[F] <-> {
hiding at the top. The reason for it is that the for
-comprehension yields an F[Boolean]
, and we have to give scalacheck a Prop
, and so the property we’re giving it is “the F
-wrapped boolean is always an F
-wrapped true”. This relies on somebody else passing us a way to compare F
-wrapped booleans, which we provide for our SGS
type (with Final implementation above) with the following implicit val
:
implicit val eqSQS: Eq[SGS[Boolean]] = new Eq[SGS[Boolean]] {
def eqv(a: SGS[Boolean], b: SGS[Boolean]): Boolean =
List.fill(200)(genGameState.sample).flatten.forall(s => {
val ans = a.runA(s).value == b.runA(s).value
if (!ans) {
println(s"Failed on:\n$s")
}
ans
})
}
Recalling that SGS
is our type alias for State[GameState, _]
, basically, we show here that two State
s are the same if they evaluate to the same value for any (sample of) same inputs. Effectively, we’ve pushed a generator into our comparison method. I don’t feel like this is necessarily the “right” way to set things up with this testing framework, but I haven’t seen a different way yet. Note the println
which helps show what input state it failed on, which I’d rather not have to include explicitly, but am note sure how to avoid, but still get some insight into which cases fail.
Initial and Free styles
The second part of the chapter in “Book of Monads” pivoted toward the Initial and (various) Free styles. Here we look at Initial, which got the least attention from me as I read more and realized Free did everything Initial aimed for, just better. But let’s see how that evolves. Initial is interesting in that it’s the only version we’ll see where we actually have to provide our own evidence that the type is a Monad
.
Initial Style
So, to begin, the idea with the Initial (and Free) style is to encode the methods of your monad as data types. Basically each method becomes it’s own type (case class
es here). Each input parameter becomes a constructor argument, and the result argument corresponds to another constructor argument, except we wrap it in a “continuation”. That is, instead of returning a Result
, we let somebody tell us what they’d do to pick up work after we gave them a Result
. It probably helps to look at the code:
sealed abstract class TicTacToe[A]
case class Info[A](p: Position, k: Option[Player] => TicTacToe[A]) extends TicTacToe[A]
case class Take[A](p: Position, k: Result => TicTacToe[A]) extends TicTacToe[A]
case class Done[A](a: A) extends TicTacToe[A]
Note the additional Done
type. If we only had a way for people to keep telling us what they’d do once we produced an answer, but no way for anybody to say we were done, we’d never stop. So the Done
gives you that way to stop, because it has no continuation.
Now, that TicTacToe
takes a type parameter, which means we can ask if it is a Functor
, Applicative
, or Monad
. Indeed, it is, and writing out the evidence of it being a Functor
isn’t too bad (you .map
the result of the continuations), nor is Monad
(you .flatMap
the continuations, which sorta feels like cheating because you’re trying to define flatMap
at the time, but recursion is a funny thing). However, Applicative
took me a long time to stare at, to write out all the types of things I had in each case and try to jam them all together to return a thing I needed. After I got through a few examples, the remaining cases clicked a bit, and the pattern emerged. I’ll spare you all the code here, but you can check it out in the repo. Also, I never worked out the tail recursive flatMap
implementation – so it goes.
Like I said, there seems to be little point writing your own Initial style monad, because Free bundles it all up for you, so let’s look at that.
Free monads! Come get your free monads!
The idea here is to set up case classes for your methods, like in the Initial style above, though they actually look a little more reasonable, hiding the continuation:
sealed abstract class TicTacToeA[A]
case class Info(p: Position) extends TicTacToeA[Option[Player]]
case class Take(p: Position) extends TicTacToeA[Unit]
case object Turn extends TicTacToeA[Player]
Here, the result types of the “methods” show up on the right, which sorta matches where we (in scala anyway) tend to look for result types, so that’s nice. If you change extends
to :
, and case class
to def
, you get basically the Final-style trait
we set up. There’s a bit of funniness with the A
at the end of the name, TicTacToeA
. That’s because this thing we’re defining is an “algebra” (for some meaning). We then use the cats
-provided Free
machinery to make a monad out of that:
type TicTacToe[A] = Free[TicTacToeA, A]
We also define some convenience methods that bring us back to “normal” looking def
s, of the same shape as the methods in the original Final-style trait
:
def info(p: Position): TicTacToe[Option[Player]] =
liftF[TicTacToeA, Option[Player]](Info(p))
def take(p: Position): TicTacToe[Unit] =
liftF[TicTacToeA, Unit](Take(p))
def turn(): TicTacToe[Player] =
liftF[TicTacToeA, Player](Turn)
After that, the implementations of the methods are the same as in Final style, and the only thing that changes is the method signature, where we don’t need the generic type parameter for the method, because we know the wrapper type is the TicTacToe
type we just made. For example, here’s the signatures for winner
(very similar to the difference between the typeclass and OO styles):
// Final style
def winner[F[_] : TicTacToe : Applicative]: F[Option[Player]]
// Free style
def winner: TicTacToe[Option[Player]]
It’s not really surprising that the implementations wouldn’t have to change. After all, the info
, take
, and turn
methods for the Free implementation above are basically our evidence that this Free TicTacToe
monad is in the Final-style TicTacToe
typeclass. Again, cats
does all the hard work of showing that, since it’s a Free
, it’s a monad, so we’re off the hook for having to do that ourselves.
If I may be permitted to blabber a bit, I’ll note that when I think about “Free” things, I think about there being a (smallish) set of generators (like Info
, Take
, and Turn
), and the free construction corresponds to lists of those generators. That is, I can do [Take, Take]
, or [Take, Turn, Info, Info, Take]
, or whatever. The Free monad’s job is to remember that whole sequence. Additionally, free things are supposed to be adjoint (which I won’t define) to “forgetful” things. In this case, we could “forget” the monad structure, and only remember the functor structure. The things we will have forgotten are the pure
(captured by the Done
from initial style, and hidden in the Free
machinery) and the flatMap
(which, again, Free
‘s giving us by chaining together the generators). Certainly others have written this all up better than I am. Category Theory for Programmers, from Bartosz Milewski’s blog, is great. A post related to some of the current topic is this one on F-algebras. Returning, though, to the code at hand…
Now that we’ve set up our tic tac toe library in the Free style, we still need an implementation. This chain of generators, any combination of calls to the info
, take
, and turn
methods, has to actually be used somewhere. Let’s convert it all into some State
manipulations, following our Final style implementation:
def freeState: TicTacToeA ~> SGS =
new (TicTacToeA ~> SGS) {
def apply[A](fa: TicTacToeA[A]): SGS[A] =
fa match {
case Info(p) => {
// A must be Option[Player]
for {
game <- State.get[GameState]
} yield {
game.board.get(p)
}
}
case Take(pos) => {
for {
game <- State.get[GameState]
nb = game.board + (pos -> game.player)
ng = GameState(Player.other(game.player), nb)
_ <- State.set(ng)
} yield { () }
}
case Turn => {
for {
game <- State.get[GameState]
} yield {
game.player
}
}
}
}
That code converts each of the generator types into the corresponding state manipulation, exactly the same chunks of State
-based code as we had in the Free style. What the above allows us to do is to convert a TicTacToe[A]
(coming out of the Free[TicTacToeA, _]
) into an SGS[A]
(again, SGS[A]=State[GameState, A]
).
Just for grins, here’s what it looks like to “run” it with random play:
println(runRandom().foldMap(freeState).run(StartingGame).value)
The runRandom
produces a (Free) TicTacToe
, which we then run through the conversion to SGS
with .foldMap(freeState)
, at which point we can .run
it with a StartingGame
, and then finally extract the .value
.
So… everything’s the same?
After all that, we have ~5 different copies of basically the same code, with some slightly different type signatures. So why bother? I only have vague ideas, because I’m still learning a lot here, but I’ll try to write it out anyway:
Going from OO to Final style, the thing we pick up is the ability to more carefully track other “effects” we might want to expose from an implementation. In the OO style, and in scala in particular, we aren’t required to note that things might throw exceptions or do IO. Going to Final style doesn’t make it a requirement either, but it does make it feasible. We’ll look at this property a little more in the last section of this post, below.
Going from Final to Free is entertaining, bundling up your methods as data objects you can pass around and manipulate. One of the things I haven’t done, but believe should be do-able somehow, is this sort of “compilation” step which might take a Free-style TicTacToe
and compress it down so that all calls to info
and turn
that happen next to each-other boil down to a single call of either (well, collapsing info
s that ask about the same Position
). The idea there is that calling info
on the same position 10 times in a row is really supposed to be exactly the same as doing it once (I guess besides other side effects, like logging or something). Having the whole sequence of operations available to analyze, I think, is supposed to make this sort of compression possible. And then you’d map the smaller thing over to State
or whatever other monad as desired. Talking about compressing and compiling a Free TicTacToe
reminds me of a recent John de Goes tweet:
I didn’t play with the other next extensions from “Book of Monads”. There’s a freestyle library which makes it easier to combine various free monads (and probably does lots of other useful things). There’s also the Eff
monad which, as best I understood it in my relatively quick glance so far, has relatively similar goals. But I learned a lot implementing these other variants, so probably some day I should return to these. And I still haven’t played with zio at all yet…
Other Final wrappers – doobie
Let’s return to Final style briefly. We should be able to provide other implementations of the TicTacToe
trait based on other “effects”. So far, we’ve only implemented one based on State
transitions. But databases are good too, so let’s try a thing with doobie. Actually, let’s make two. doobie has a notion of a ConnectionIO
which, in my relatively limited experience so far, I roughly translate to “an ability to do a query and return some things, if you give me a Transactor
“. The Transactor
type itself is parametrized on it’s effect, but if we just assume cats-effect
‘s IO
, then when we give a ConnectionIO
a Transactor
, we get back an IO
, which is still not the thing itself (the result we’re trying to get out of the database), but a basically complete description of how to get the thing itself. Eventually we have to unsafeRunSync
it to extract the thing, which we’re only encouraged to do “at the end of the world”, as far out in the edges of our code as we can.
Because I’m lazy, I cheated a bit and didn’t set up a particularly rigorous database for this exercise. Here’s a utility I wrote to do the ConnectionIO
to IO
conversion, as well as a method to initialize some silly database tables:
object Doo {
def run[A, T <: Transactor[IO]](transactor: Resource[IO, T])(cio: ConnectionIO[A]): IO[A] =
transactor.use { xa => cio.transact(xa) }
def initializeDB[T <: Transactor[IO]](transactor: Resource[IO, T]): Unit = {
run(transactor)(sql"""DROP TABLE turn IF EXISTS""".update.run).unsafeRunSync
run(transactor)(sql"""DROP TABLE bps IF EXISTS""".update.run).unsafeRunSync
run(transactor)(sql"""CREATE TABLE turn (ps VARCHAR)""".update.run).unsafeRunSync
run(transactor)(sql"""CREATE TABLE bps (rs VARCHAR, cs VARCHAR, ps VARCHAR)""".update.run).unsafeRunSync
run(transactor)(sql"""INSERT INTO turn (ps) VALUES ('X')""".update.run).unsafeRunSync
}
}
Then, some case classes and helper methods to do some of the conversions and unpacking (note that these rely on some methods in the “Common” code this post started with, which I didn’t show – they’re all in the repo):
case class Turn(ps: String)
def player(t: Turn): Player =
Player(t.ps(0))
case class BoardPositionState(rs: String, cs: String, ps: String)
def position(bps: BoardPositionState): Position =
Position(s"${bps.rs}${bps.cs}").get // sinner
def player(bps: BoardPositionState): Player =
Player(bps.ps(0))
Given that setup, we can describe some database queries that would reasonably correspond to the methods of the Final style monad:
object Queries {
// get the current player owning a position
def info(p: Position): ConnectionIO[Option[Player]] =
sql"select rs, cs, ps from bps where rs = ${p.row.toString} and cs = ${p.col.toString}"
.query[BoardPositionState] // Query0[BoardPositionState]
.option // ConnectionIO[Option[BoardPositionState]]
.map(_.map(player)) // ConnectionIO[Option[Player]]
def take(pos: Position): ConnectionIO[Unit] =
for {
curPlayer <- turn
_ <- sql"delete from bps where rs = ${pos.row.toString} and cs = ${pos.col.toString}".update.run
_ <- sql"insert into bps (rs, cs, ps) values (${pos.row.toString}, ${pos.col.toString}, ${curPlayer.toString})".update.run
} yield { () }
def turn(): ConnectionIO[Player] =
sql"select ps from turn"
.query[Turn] // Query0[Turn]
.unique // ConnectionIO[Turn]
.map(player) // ConnectionIO[Player]
def switchPlayer(): ConnectionIO[Unit] =
for {
curPlayer <- turn
nextPlayer = Player.other(curPlayer)
_ <- sql"update turn set ps = ${nextPlayer.toString}".update.run
} yield { () }
}
Indeed, the conversion from there to a Final style implementation of TicTacToe
is direct:
implicit case object DoobieConnectionIOTicTacToe extends TicTacToe[ConnectionIO] {
override def info(p: Position): ConnectionIO[Option[Player]] =
Queries.info(p)
override def forceTake(pos: Position): ConnectionIO[Unit] =
Queries.take(pos)
override def turn(): ConnectionIO[Player] =
Queries.turn
override def switchPlayer(): ConnectionIO[Unit] =
Queries.switchPlayer
}
Now, another reasonable thing we could do, if we had a Transactor
sitting around, would be to implement a TicTacToe[IO]
, roughly similarly to the TicTacToe[ConnectionIO]
we just defined:
val t: Transactor = ???
implicit case object DoobieIOTicTacToe extends TicTacToe[IO] {
override def info(p: Position): IO[Option[Player]] =
Doo.run(transactor)(Queries.info(p))
override def forceTake(pos: Position): IO[Unit] =
Doo.run(transactor)(Queries.take(pos))
override def turn(): IO[Player] =
Doo.run(transactor)(Queries.turn)
override def switchPlayer(): IO[Unit] =
Doo.run(transactor)(Queries.switchPlayer)
}
Permit me a moment to cheat a little bit and assume all the implicits can be made to work (even if they have to be explicit), and we can demonstrate how to use these two implementations:
{ // ConnectionIO version
val transactor: Transactor = ???
println(Doo.run(transactor)(runRandom[ConnectionIO]()).unsafeRunSync)
}
{ // IO version
println(runRandom[IO]().unsafeRunSync)
}
There’s no real surprise there. The IO
version already has the Doo.run
and a Transactor
provided elsewhere, so we don’t need them down here. But I think the ConnectionIO
version is better, because it has delayed who needs to have the Transactor
a bit more.
What is surprising (or was to me, anyway, when I started playing with all this), is that the IO
version is actually noticeably slow, and the ConnectionIO
version is not. Even just in this tiny board, with an in-memory h2 database (which, admittedly, probably wasn’t set up incredibly well), it takes literal seconds for the runRandom[IO]
above (on my machine). The runRandom[ConnectionIO]
takes no real perceptible time. My understanding of the difference, and again demonstrating the value of ConnectionIO
and deferring the decision of the Transactor
, is that in the ConnectionIO
one, we’re bundling every single manipulation up into one transaction, where in the IO
version we might get a few bundled up next to each other, but we still end up making lots of transactions.
It’s really entertaining (to me, with what I know right now), to still try to wrap my head around what’s going on here. We’re generating random moves every step of game play, which affect exactly which database manipulations we make and how many and such, but through the organization above, we’re still able to bundle it all up into one chunk of code that gets executed with one database transaction. I think. Good times.