Zainab Ali
I should code this
festivalAction :: StateT Game IO ()
festivalAction =
plusActions 2
>> plusBuy 1
>> plusGold 2A 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
-- 6pretty :: 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 3class 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 = ideval expr
-- 6instance IntSYM String where
lit = show
x + y = "(" ++ x ++ " + " ++ y ++ ")"
pretty :: String -> String
pretty = idpretty expr
-- "((1 + 2) + 3)"action + lit 2buy + lit 1gold + lit 2class ResourceSYM repr where
action :: repr
buy :: repr
gold :: reprplusTwoActions :: (IntSYM repr,
ResourceSYM repr) => repr
plusTwoActions = action + lit 2instance IntSYM (StateT Game IO ()) where
lit i = ?nonsenselit 1
gold + goldlit 1 + 1
A modification is a resource and a function that modifies it
lit 1 :: repr Int(+ lit 1) :: repr Int -> repr Intaction + lit 1 :: repr ()action :: repr ?hmmaction :: 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 compileinstance 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 -> reprplusTwoActions
<> plusOneBuy
<> plusTwoGoldfestival :: (
ResourceSYM (repr (Lens Game Int)),
IntSYM (repr Int),
StatementSYM repr,
Semigroup (repr ())) => repr ()
festival =
plusTwoActions
<> plusOneBuy
<> plusTwoGoldclass (
ResourceSYM ...
Semigroup (repr ())) => ActionSYM reprfestival :: ActionSYM repr => reprpick 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 Boolclass 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 reprcardpEval :: (Card -> Bool) -> (Card -> Bool)
cardPEval = idexp :: CardPSYM repr => repr Bool
exp = cost < lit 5forall repr. CardPSYM repr => repr Booldata 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 cardworkshop =
put discard
(pick
(cost < lit 4)
supply)
pick :: ... repr stack -> repr (Card, stack)put :: repr (Card, stack) -> repr stackTrack a stack of cards we in flight
class VarSYM repr where
z :: repr (m, h) m
s :: repr m a -> repr (any, m) aRefer to cards within the stack
exp :: repr (Card, a) Card
exp = z -- The card to testexp :: 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 amine :: 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) handAdditional type safety