A Dominion of Domains

Zainab Ali

@_zainabali_

I should code this

Jam Time!

festivalAction :: StateT Game IO ()
festivalAction =
  plusActions 2
    >> plusBuy 1
    >> plusGold 2

How can we —

  • Generate the description?
  • Validate that it is playable?
  • Ensure it preserves cards?
  • Ensure it is unique?

One repr to rule them all

A representation that interprets to

  • An evaluator
  • A description
  • A data type
  • The evaluator
  • The description
  • The data type

Syntax

Semantics

Towards an eDSL

Design a domain specific language that is embedded in Haskell.

Interpret this to

  • An evaluator
  • A description

An Initial Attempt

data Exp = Lit Int | Add Exp Exp
-- 1 + 2 + 3
exp = Add (Add (Lit 1) (Lit 2)) (Lit 3)
eval :: Exp -> Int
eval (Lit i) = i
eval (Add x y) = eval x + eval y

eval exp
-- 6
pretty :: Exp -> String
pretty (Lit i) = show i
pretty (Add x y) = "("
  ++ pretty x ++ " + "
  ++ pretty y ++ ")"

pretty exp
-- "((1 + 2) + 3)"

Subtraction

data MinusExp = Minus MinusExp MinusExp | Wrap Exp
-- (1 - 2) + 3
exp = Add (Minus (Wrap (Lit 1)) (Wrap (Lit 2)))
          (Lit 3)
 -- Couldn't match expected type ‘Exp’ with 
 -- actual type ‘MinusExp’

A Final Attempt

class IntSYM repr where
  lit :: Int -> repr
  (+) :: repr -> repr -> repr
-- 1 + 2 + 3
expr :: IntSYM repr => repr
expr = (lit 1 + lit 2) + lit 3

Subtraction

class MinusSYM repr where
  (-) :: repr -> repr -> repr
-- 1 - 2 + 3
expr :: (IntSYM repr, MulSYM repr) => repr
expr = (lit 1 - lit 2) + (lit 3)

A Final Interpreter

instance IntSYM Int where
  lit = id
  (+) = (Prelude.+)

eval :: Int -> Int
eval = id
eval expr
-- 6

Pretty printer

instance IntSYM String where
  lit = show
  x + y = "(" ++ x ++ " + " ++ y ++ ")"

pretty :: String -> String
pretty = id
pretty expr
-- "((1 + 2) + 3)"
action + lit 2
buy + lit 1
gold + lit 2

Resources

class ResourceSYM repr where
  action :: repr
  buy :: repr
  gold :: repr
plusTwoActions :: (IntSYM repr,
                   ResourceSYM repr) => repr
plusTwoActions = action + lit 2

Evaluator

instance IntSYM (StateT Game IO ()) where
   lit i = ?nonsense

Invalid Expressions

lit 1
gold + gold
lit 1 + 1

A modification is a resource and a function that modifies it

Types

lit 1 :: repr Int
(+ lit 1) :: repr Int -> repr Int
action + lit 1 :: repr ()
action :: repr ?hmm

Optics

action :: repr (Lens Game Int)

Composition

class StatementSYM repr where
  modify :: repr (Lens Game Int)
            -> (repr Int -> repr Int)
            -> repr ()
modify action (+ lit 1)
modify (lit 1) (+ lit 1)
modify gold gold 
  -- do not compile

Evaluation

instance IntSYM (StateT Game IO Int) where
   lit i = pure i
   ...
instance ResourceSYM
          (StateT Game IO (Lens Game Int)) where
   action = pure actionLens
   ...
instance StatementSYM (StateT Game IO) where
    modify mlens f = do lens <- mlens
                         next <- f (use lens)
                         S.modify (set lens next)
plusTwoActions :: (
  ResourceSYM (repr (Lens Game Int)),
  IntSYM (repr Int),
  StatementSYM repr) => repr ()
plusTwoActions = modify action (+ lit 2)
eval plusTwoActions 
 -- StateT Game IO ()

Semigroup

(<>) :: repr -> repr -> repr
plusTwoActions
  <> plusOneBuy
  <> plusTwoGold
festival :: (
  ResourceSYM (repr (Lens Game Int)),
  IntSYM (repr Int),
  StatementSYM repr,
  Semigroup (repr ())) => repr ()
festival =
  plusTwoActions
    <> plusOneBuy
    <> plusTwoGold
class (
  ResourceSYM ...
  Semigroup (repr ())) => ActionSYM repr
festival :: ActionSYM repr => repr

So far —

  • eDSLs
  • Using data types
  • Using type classes
  • Extension
  • Composition
  • Types
  • Existing type classes

Moving cards

pick a card that costs less than 5 from the supply pile and put it into the discard pile

class MoveSYM repr where
  pick :: repr (Lens Game [Card])
          -> (repr Card -> repr Bool)
          -> repr Card

  put :: repr Card
         -> repr (Lens Game [Card])
         -> repr ()
class BoolSYM repr where
  (<) :: repr Int -> repr Int -> repr Bool
class CardSYM repr where
  cost :: repr Int
  ...
class PileSYM repr where
  supply :: repr
  discard :: repr
  ...
instance IntSYM (StateT Game IO Int) ...
instance BoolSYM (StateT Game IO a) ...
instance CardSYM (StateT Game IO a) ...

These should not be stateful

Embedded languages

pick a card that costs less than 5 from the supply pile and put it into the discard pile

Card Predicates

class (CardSYM repr, 
       BoolSYM repr, 
       IntSYM (repr Int)) => CardPSYM repr
cardpEval :: (Card -> Bool) -> (Card -> Bool)
cardPEval = id
exp :: CardPSYM repr => repr Bool
exp = cost < lit 5
forall repr. CardPSYM repr => repr Bool
data CardPSYMSelf = 
     CardPSYMSelf (forall p. CardPSYM p => p Bool)
class MoveSYM repr where
  pick :: CardPSYMSelf 
          -> repr (Lens Game [Card])
          -> repr Card
  ...
data PileSYMSelf =
     PileSYMSelf (forall p. PileSYM p => p)
instance MoveSYM (StateT Game IO) where
  pick (CardPSelf p) (PileSYMSelf pile) =
    do cards <- use pile
       let selection = filter p cards
       card <- chooseOne selection
       pile %= delete card
       return card

Workshop

workshop = 
  put discard 
    (pick
       (cost < lit 4)
        supply)

So far —

  • eDSLs
  • Using type classes
  • Extension & composition
  • Types
  • Embedded terms
  • Pick a Treasure card from your hand.
  • Pick another card that has the value of less than 3 plus the cost of that card
  • Put the card into your hand
  • Put the first card into the trash pile.

 

Variables

pick :: ... repr stack -> repr (Card, stack)
put :: repr (Card, stack) -> repr stack

Track a stack of cards we in flight

class VarSYM repr where
  z :: repr (m, h) m
  s :: repr m a -> repr (any, m) a

Refer to cards within the stack

exp :: repr (Card, a) Card
exp = z -- The card to test
exp :: repr (Card, (Card, a)) Card
exp = s z -- The previous card
exp :: CardPSYM repr => repr (Card, (Card, m)) Bool
exp = cost z < (cost (s z) + lit 4)
class MoveSYM repr where
  pick :: CardPSYMSelf (Card, m)
          -> PileSYMSelf 
          -> repr m a
          -> repr (Card, m) a
  put :: PileSYMSelf 
         -> repr (Card, m) a
         -> repr m a
mine :: MoveSYM repr => repr m () -> repr m ()
mine =
  put trash .
  put hand .
  pick (cost z < (cost (s z) + lit 4)) supply .
  pick (cardType z == cardTypeOf Treasure) hand

Additional type safety

What next?

  • Recursion
  • Control flow
  • Switching context
  • Contextual interpreters
  • Transformations

Read on

Thank you

A Dominion of DomainsA Dominion of Domains

By Zainab Ali

A Dominion of DomainsA Dominion of Domains

This talk explores the domain specific language (DSL) of the deck-building card game Dominion. We will see how actions in the game have their own language, and can be decomposed into many smaller languages. Using Tagless-Final encoding, we will define these each of these DSLs and compose them to create the larger language. We will explore two different mechanisms of composition: extension and embedding. Finally, we will enrich the DSL with a type system that enforces game-specific constraints.

  • 317

More from Zainab Ali