Haksell is great for writing domain specific languages (DSLs) and Bluefin.DslBuilder provides an easy way to write DSLs using Bluefin.

Here's an example of the use of Bluefin.DslBuilder. Suppose we have a data type that represents the location of robots and obstacles in a two-dimensional square arena:

data Arena = MkArena
 { arenaRobots :: [RobotEntry],
   arenaObstacles :: [ObstacleEntry]
 }

Each RobotEntry stores the robot's name, coordinates on the 2d grid, facing direction, and instructions for robot to carry out

type RobotEntry = (String, (Int, Int), Direction, [Instruction])

The instructions that a robot can perform are to wait for a given number of time units, move forward, turn left and turn right.

data Instruction = Wait Int | Forward | TurnLeft | TurnRight
data Direction = N | E | S | W

The ObstacleEntrys store the type of each obstacle and its coordinates on the 2d grid.

type ObstacleEntry = (Obstacle, (Int, Int))

data Obstacle = Sand | Rock | Iron

Suppose we want an Arena with a red robot which moves towards a sand obstacle, and a blue robot that is stuck behind iron obstacles and can only turn around on the spot. Here's an ASCII diagram of the initial position we want, where r is the red robot, S is a sand obstacle, b is the blue robot and I is an iron obstacle:

5|
4|  III
3|  IbI
2|  III
1|
0|r    S
 +------
  012345

We can define such an Arena by hand like this:

myArena :: Arena
myArena =
  MkArena
    { arenaRobots =
        [ ("red", (0, 0), E, [Wait 100, Forward, Forward, Forward, Forward]),
          ("blue", (3, 3), N, [TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight, TurnRight])
        ],
      arenaObstacles = [(Sand, (5, 0)), (Iron, (2, 2)), (Iron, (2, 3)), (Iron, (2, 4)), (Iron, (3, 2)), (Iron, (3, 4)), (Iron, (4, 2)), (Iron, (4, 3)), (Iron, (4, 4))]
    }

That's messy and contains a lot of repetition! We can use Haskell constructs to do a bit better:

myArena2 :: Arena
myArena2 =
  MkArena
    { arenaRobots =
        [ ("red", (0, 0), E, Wait 100 : replicate 4 Forward),
          ("blue", (3, 3), N, replicate 20 TurnRight)
        ],
      arenaObstacles =
        (Sand, (5, 0))
          : [ (Iron, (x, y))
              | x <- [2 .. 4],
                y <- [2 .. 4],
                (x, y) /= (3, 3)
            ]
    }

That's more compressed but it doesn't describe our intent clearly.

Let's use Bluefin.DslBuilder to write a DSL that allows us to express our intent more clearly. Before we define the DSL, let's look at what it will allow us to write. In myDslArena below I can define the red robot and its obstacles separately from the blue robot and its obstacles, and I can use for_ loops to conveniently define the blue robot's iron cage.

myDslArena :: Arena
myDslArena = buildArena $ do
  -- 5|
  -- 4|
  -- 3|
  -- 2|
  -- 1|
  -- 0|R    S
  --  +------
  --   012345
  robot "red" (0, 0) E $ do
    wait 100
    forward 4

  obstacle Sand (5, 0)

  -- 5|
  -- 4|  III
  -- 3|  IBI
  -- 2|  III
  -- 1|
  -- 0|
  --  +------
  --   012345
  robot "blue" (3, 3) N $ do
    replicateM_ 10 aboutFace

  for_ [2 .. 4] $ \x -> do
    for_ [2 .. 4] $ \y -> do
      unless ((x, y) == (3, 3)) $ do
        obstacle Iron (x, y)

So what are the definitions of the components that go into building an Arena?

Firstly, what does buildArena do? It's going to have this type:

buildArena :: ArenaBuilder -> Arena

ArenaBuilder is the type of the do block which contains the robot and obstacle entries, and is a convenience type synonym:

type ArenaBuilder = ArenaBuilder_ ()

ArenaBuilder_ is a Monad and is the first component we are going to build using Bluefin.DslBuilder:

newtype ArenaBuilder_ r
  = MkArenaBuilder (DslBuilder ArenaH r)
  deriving (Functor, Applicative, Monad)

DslBuilder ArenaH is a Monad that allows us access to the effects inside the handle ArenaH (and no others). So what is ArenaH? It is defined like this:

data ArenaH e = MkArenaH (Stream RobotEntry e) (Stream ObstacleEntry e)
  deriving Generic
  deriving Handle via OneWayCoercibleHandle ArenaH

instance (e :> es) => OneWayCoercible (ArenaH e) (ArenaH es) where
  oneWayCoercibleImpl = gOneWayCoercible

What does that mean? Well, ArenaH is defined according to one of the recipes from Bluefin.Compound, and gives the ability to yield to a Stream of RobotEntrys and a stream of ObstacleEntrys, i.e. the components that make up an Arena. The only things we can do with the ArenaH then are to give it RobotEntrys or ObstacleEntrys. How do we get them?

To get an ObstacleEntry we use the obstacle command. It has type

obstacle :: Strength -> (Int, Int) -> ArenaBuilder

When calling obstacle we specify the strength of the obstacle and its coordinates in the arena. In fact, having those gives us exactly what we need to yield an ObstacleEntry to the Stream ObstacleEntry inside the ArenaBuilder:

obstacle o coord =
  MkArenaBuilder $ dslBuilder $ (MkArenaH _ yobstacle) -> do
    yield yobstacle (o, coord)

To get a RobotEntry we use the robot component. It has type

robot ::
  String -> (Int, Int) -> Direction -> InstructionsBuilder -> ArenaBuilder

When calling robot we specify the name, coordinates, and facing direction for our robot. We also specify the instructions for the robot by providing an InstructionsBuilder? What's that? It's another Monad defined in terms of DslBuilder:

type InstructionsBuilder = InstructionsBuilder_ ()

newtype InstructionsBuilder_ r
  = MkInstructionsBuilder (DslBuilder InstructionsH r)
  deriving (Functor, Applicative, Monad)

Like with ArenaBuilder, to define the Monad we define a handle, this time InstructionsH:

data InstructionsH e = MkInstructionsH (Stream Instruction e)
  deriving Generic
  deriving Handle via OneWayCoercibleHandle InstructionsH

instance (e :> es) => OneWayCoercible (InstructionsH e) (InstructionsH es) where
  oneWayCoercibleImpl = gOneWayCoercible

InstructionsH allows us to yield to a sequence of Instructions, i.e. the type of robot instructions defined above and used in Arena via RobotEntry. In fact, the job of robot is exactly to allow us to define a RobotEntry and yield it to the Stream RobotEntry of Arena:

robot name coords dir (MkInstructionsBuilder ibuilder) =
  MkArenaBuilder $ dslBuilder $ \(MkArenaH yrobot _) -> do
    (insns, ()) <- yieldToList $ \yinsns -> do
      runDslBuilder (MkInstructionsH (mapHandle yinsns)) ibuilder

    yield yrobot (name, coords, dir, insns)

In a do block of type InstructionsBuilder we want to be able to write things like wait 100, forward 4 and aboutFace. What are they? To define commands of type InstructionsBuilder we use this convenience function:

instructionsBuilder :: Instruction -> InstructionsBuilder
instructionsBuilder insn =
  MkInstructionsBuilder $ dslBuilder $ \(MkInstructionsH yinsn) -> do
    yield yinsn insn

which we can use as follows to define commands as follows:

wait :: Int -> InstructionsBuilder
wait n = instructionsBuilder (Wait n)

turnLeft :: InstructionsBuilder
turnLeft = instructionsBuilder TurnLeft

turnRight :: InstructionsBuilder
turnRight = instructionsBuilder TurnRight

aboutFace :: InstructionsBuilder
aboutFace = do
  turnRight
  turnRight

forward :: Int -> InstructionsBuilder
forward n = replicateM_ n (instructionsBuilder Forward)

We're now ready to implement buildArena. We create a Stream RobotEntry and a Stream ObstacleEntry to pass to the MkArenaH constructor, and use runDslBuilder to run the ArenaBuilder provided. (This is a lot like some of the approaches in Bluefin.Compound.)

buildArena :: ArenaBuilder -> Arena
buildArena (MkArenaBuilder arenaBuilder) = runPureEff $ do
  (robots, obstacles) <- yieldToList $ \yrobots -> do
    (obstacles, ()) <- yieldToList $ \yobstacles -> do
      runDslBuilder
        (MkArenaH (mapHandle yrobots) (mapHandle yobstacles))
        arenaBuilder

    pure obstacles

  pure
    MkArena
      { arenaRobots = robots,
        arenaObstacles = obstacles
      }

And that's all we need to support the implementation of myDslArena :: Arena given above!