Zainab Ali
I should code this
festivalAction :: StateT Game IO ()
festivalAction =
plusActions 2
>> plusBuy 1
>> plusGold 2
A representation that interprets to
Syntax
Semantics
Design a domain specific language that is embedded in Haskell.
Interpret this to
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)"
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’
class IntSYM repr where
lit :: Int -> repr
(+) :: repr -> repr -> repr
-- 1 + 2 + 3
expr :: IntSYM repr => repr
expr = (lit 1 + lit 2) + lit 3
class MinusSYM repr where
(-) :: repr -> repr -> repr
-- 1 - 2 + 3
expr :: (IntSYM repr, MulSYM repr) => repr
expr = (lit 1 - lit 2) + (lit 3)
instance IntSYM Int where
lit = id
(+) = (Prelude.+)
eval :: Int -> Int
eval = id
eval expr
-- 6
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
class ResourceSYM repr where
action :: repr
buy :: repr
gold :: repr
plusTwoActions :: (IntSYM repr,
ResourceSYM repr) => repr
plusTwoActions = action + lit 2
instance IntSYM (StateT Game IO ()) where
lit i = ?nonsense
lit 1
gold + gold
lit 1 + 1
A modification is a resource and a function that modifies it
lit 1 :: repr Int
(+ lit 1) :: repr Int -> repr Int
action + lit 1 :: repr ()
action :: repr ?hmm
action :: repr (Lens Game Int)
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
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 ()
(<>) :: 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
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
pick a card that costs less than 5 from the supply pile and put it into the discard pile
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 =
put discard
(pick
(cost < lit 4)
supply)
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