Introduced lenses and got rid of all traces of overloaded record plugin

#1

package.yaml

@@ -45,10 +45,12 @@ library:
   - parsec
   - pretty-simple
   - text == 2.0.2
+  - lens
   - large-generics == 0.2.2
   - large-records == 0.4.1
   - record-hasfield
   - free == 5.2
+  - effectful
 
 
 executables:

src/Card.hs

@@ -8,39 +8,39 @@ pool :: [Card]
 pool = [dummy, dumber, triDummy, dumbo, bigDumbo, kingDumbo]
 
 defCard :: Card
-defCard = Card {cardName = PlaceHolder, cardTier = -1, baseCost = -1, attack = -1, health = -1, deathrattle = []}
+defCard = Card {_cardName = PlaceHolder, _cardTier = -1, _baseCost = -1, _attack = -1, _health = -1, _deathrattle = []}
 
 skeleton :: Card
-skeleton = defCard {cardName = Skeleton, cardTier = 1, baseCost = error "Skeleton has no base cost.", attack = 1, health = 1}
+skeleton = defCard {_cardName = Skeleton, _cardTier = 1, _baseCost = error "Skeleton has no base cost.", _attack = 1, _health = 1}
 
 harmlessBonehead :: Card
 harmlessBonehead =
   defCard
-    { cardName = HarmlessBonehead,
-      cardTier = 1,
-      baseCost = 3,
-      attack = 1,
-      health = 1,
-      deathrattle = [Summon (SpecificCard skeleton), Summon (SpecificCard skeleton)]
+    { _cardName = HarmlessBonehead,
+      _cardTier = 1,
+      _baseCost = 3,
+      _attack = 1,
+      _health = 1,
+      _deathrattle = [Summon (SpecificCard skeleton), Summon (SpecificCard skeleton)]
     }
 
 dummy :: Card
-dummy = defCard {cardName = Dummy, cardTier = 1, baseCost = 3, attack = 1, health = 1}
+dummy = defCard {_cardName = Dummy, _cardTier = 1, _baseCost = 3, _attack = 1, _health = 1}
 
 dumber :: Card
-dumber = defCard {cardName = Dumber, cardTier = 2, baseCost = 3, attack = 2, health = 2}
+dumber = defCard {_cardName = Dumber, _cardTier = 2, _baseCost = 3, _attack = 2, _health = 2}
 
 triDummy :: Card
-triDummy = defCard {cardName = TriDummy, cardTier = 3, baseCost = 3, attack = 3, health = 3}
+triDummy = defCard {_cardName = TriDummy, _cardTier = 3, _baseCost = 3, _attack = 3, _health = 3}
 
 dumbo :: Card
-dumbo = defCard {cardName = Dumbo, cardTier = 4, baseCost = 3, attack = 4, health = 4}
+dumbo = defCard {_cardName = Dumbo, _cardTier = 4, _baseCost = 3, _attack = 4, _health = 4}
 
 bigDumbo :: Card
-bigDumbo = defCard {cardName = BigDumbo, cardTier = 5, baseCost = 3, attack = 5, health = 5}
+bigDumbo = defCard {_cardName = BigDumbo, _cardTier = 5, _baseCost = 3, _attack = 5, _health = 5}
 
 kingDumbo :: Card
-kingDumbo = defCard {cardName = KingDumbo, cardTier = 6, baseCost = 3, attack = 6, health = 6}
+kingDumbo = defCard {_cardName = KingDumbo, _cardTier = 6, _baseCost = 3, _attack = 6, _health = 6}
 
 dummyWithALongNameItKeepsGoing :: Card
-dummyWithALongNameItKeepsGoing = defCard {cardName = DummyWithALongNameItKeepsGoing, cardTier = 1, baseCost = 3, attack = 1, health = 1}
+dummyWithALongNameItKeepsGoing = defCard {_cardName = DummyWithALongNameItKeepsGoing, _cardTier = 1, _baseCost = 3, _attack = 1, _health = 1}

src/Combat.hs

@@ -1,16 +1,10 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE OverloadedRecordUpdate #-}
-{-# LANGUAGE RebindableSyntax #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
 module Combat where
 
+import Control.Lens hiding (Index)
 import Control.Monad.Random
 import Data.Bifunctor (Bifunctor (second))
 import Data.List (findIndex, mapAccumL)
 import Data.Maybe (fromJust)
-import Data.Record.Overloading
 import Debug.Trace (trace)
 import Logic (genId)
 import Model hiding (turn)
@@ -30,55 +24,57 @@ fight p1 p2 gs = do
   let sim = CombatSimulation [] sequence result
   case result of
     Tie -> return (gs, sim)
-    Loss fighter dmg ->
+    Loss fighter dmg -> do
       let loser = case fighter of
             One -> Player
             Two -> AI
           loserState = selectPlayer loser gs
-          (hp', armor') = dealDmg dmg (loserState.hp, loserState.armor)
-          loserState' = loserState {hp = hp', armor = armor', alive = hp' > 0}
-       in return (updatePlayer loser loserState' gs, sim)
+          (hp', armor') = dealDmg dmg (loserState ^. hp, loserState ^. armor)
+          loserState' = loserState & hp .~ hp'
+                                 & armor .~ armor'
+                                 & alive .~ (hp' > 0)
+      return (updatePlayer loser loserState' gs, sim)
 
 simulateCombat :: (MonadRandom m) => Player -> Player -> GameState -> m CombatHistory
 simulateCombat p1 p2 gs = do
   let (p1State, p2State) = (selectPlayer p1 gs, selectPlayer p2 gs)
-  initialAttacker <- initAttacker p1State.board p2State.board
+  initialAttacker <- initAttacker (p1State ^. board) (p2State ^. board)
   go
-    (CombatState initialAttacker (FighterState p1State 0) (FighterState p2State 0) gs.config)
+    (CombatState initialAttacker (FighterState p1State 0) (FighterState p2State 0) (gs ^. config))
     [] -- initial board is part of state
   where
     go :: (MonadRandom m) => CombatState -> CombatHistory -> m CombatHistory
     go combatState history = do
       if combatEnded combatState
         then return history
         else do
-          let defendingBoard = case combatState.attacker of
-                One -> combatState.two.playerState.board
-                Two -> combatState.one.playerState.board
+          let defendingBoard = case combatState ^. attacker of
+                One -> combatState ^. two . fplayerState . board
+                Two -> combatState ^. one . fplayerState . board
           defenderIndex <- getRandomR (0, length defendingBoard - 1)
           let (combatState', newHistorySlices) = turn defenderIndex combatState
           go combatState' (history ++ newHistorySlices)
 
     combatEnded :: CombatState -> Bool
-    combatEnded combatState = null combatState.one.playerState.board || null combatState.two.playerState.board
+    combatEnded combatState = 
+      null (combatState ^. one . fplayerState . board) || 
+      null (combatState ^. two . fplayerState . board)
 
 turn ::
   DefenderIndex -> -- Since the caller of `turn` specifies the `di`, testing single turns is easy.
   CombatState ->
   (CombatState, CombatHistory)
 turn di cs = (cs''', history)
   where
-    (attackingState, _) = case cs.attacker of
-      One -> (cs.one, cs.two)
-      Two -> (cs.two, cs.one)
-    cs' = trade attackingState.nextAttackIndex di cs
+    (attackingState, _) = case cs ^. attacker of
+      One -> (cs ^. one, cs ^. two)
+      Two -> (cs ^. two, cs ^. one)
+    cs' = trade (attackingState ^. nextAttackIndex) di cs
     (cs'', snapshots) = handleDeaths cs' -- `handleDeath` does not clean the battleground (clear deaths)
-    cs''' =
-      cs''
-        { attacker = alternate cs''.attacker,
-          one.playerState.board = clearDeath cs''.one.playerState.board,
-          two.playerState.board = clearDeath cs''.two.playerState.board
-        }
+    cs''' = cs''
+      & attacker .~ alternate (cs'' ^. attacker)
+      & one . fplayerState . board .~ clearDeath (cs'' ^. one . fplayerState . board)
+      & two . fplayerState . board .~ clearDeath (cs'' ^. two . fplayerState . board)
     history = map extractBoards [cs, cs'] ++ [extractBoards cs'' | not (null snapshots)] ++ [extractBoards cs''']
 
 -- handleDeaths is recursive because certain deathrattles cause other minions to die.
@@ -95,57 +91,59 @@ handleDeaths cs =
     prepareDeathrattles = undefined
 
 extractBoards :: CombatState -> (Board, Board)
-extractBoards cs = (cs.one.playerState.board, cs.two.playerState.board)
+extractBoards cs = (cs ^. one . fplayerState . board, cs ^. two . fplayerState . board)
 
 interpCombatEffect :: CombatEffectContext -> CardEffect -> CombatState
 interpCombatEffect (CombatEffectContext cs fighter minionId) (Summon (SpecificCard card)) = case fighter of
-  One -> cs {one = fs'}
-  Two -> cs {two = fs'}
+  One -> cs & one .~ fs'
+  Two -> cs & two .~ fs'
   where
     fs = case fighter of
-      One -> cs.one
-      Two -> cs.two
-    aliveCount = countAlive fs.playerState.board
-    summonerInd = dIndex minionId fs.playerState.board -- Summoner is the one who issued the summoning
+      One -> cs ^. one
+      Two -> cs ^. two
+    aliveCount = countAlive (fs ^. fplayerState . board)
+    summonerInd = dIndex minionId (fs ^. fplayerState . board) -- Summoner is the one who issued the summoning
     fs'
       | aliveCount < 7 =
           fs
-            { playerState.board = insertAt (summonerInd + 1) (CardInstance card id) fs.playerState.board,
-              playerState.idGen = idGen'
-            }
+            & fplayerState . board .~ insertAt (summonerInd + 1) (CardInstance card id) (fs ^. fplayerState . board)
+            & fplayerState . idGen .~ idGen'
       | otherwise = fs
       where
-        (idGen', id) = genId fs.playerState.idGen
+        (idGen', id) = genId (fs ^. fplayerState . idGen)
 interpCombatEffect _ cf = error $ "Effect `" ++ show cf ++ "` is not yet implemented"
 
 countAlive :: Board -> Int
 countAlive = undefined
 
 -- deterministically find a minion's index and its index through its id
 dIndex :: MinionID -> Board -> Index
-dIndex id = fromJust . findIndex (\ci -> ci.id == id)
+dIndex mId = fromJust . findIndex (\ci -> ci ^. Model.id == mId)
 
 clearDeath :: Board -> Board
-clearDeath = filter (\ci -> ci.card.health > 0)
+clearDeath = filter (\ci -> ci ^. card . health > 0)
 
 -- A single attack, only the involved minions are updated. Cleave logic is handled here.
 trade :: AttackerIndex -> DefenderIndex -> CombatState -> CombatState
 trade ai di cs = cs'
   where
-    (attackingBoard, defendingBoard) = case cs.attacker of
-      One -> (cs.one.playerState.board, cs.two.playerState.board)
-      Two -> (cs.two.playerState.board, cs.one.playerState.board)
+    (attackingBoard, defendingBoard) = case cs ^. attacker of
+      One -> (cs ^. one.fplayerState.board, cs ^. two.fplayerState.board)
+      Two -> (cs ^. two.fplayerState.board, cs ^. one.fplayerState.board)
+
     (attackingMinion, defendingMinion) = (attackingBoard !! ai, defendingBoard !! di)
     (attackingMinion', defendingMinion') = dmgOther (attackingMinion, defendingMinion)
-    (attackingBoard', defendingBoard') = (setAt ai attackingMinion' attackingBoard, setAt di defendingMinion' defendingBoard)
-    cs' = case cs.attacker of
-      One -> cs {one.playerState.board = attackingBoard', two.playerState.board = defendingBoard'}
-      Two -> cs {one.playerState.board = defendingBoard', two.playerState.board = attackingBoard'}
+
+    cs' = case cs ^. attacker of
+      One -> cs & one.fplayerState.board .~ attackingBoard
+                & two.fplayerState.board .~ defendingBoard
+      Two -> cs & one.fplayerState.board .~ defendingBoard
+                & two.fplayerState.board .~ attackingBoard
 
     dmgOther :: (CardInstance, CardInstance) -> (CardInstance, CardInstance)
     dmgOther (attacker, defender) =
-      ( attacker {card.health = attacker.card.health - defender.card.attack},
-        defender {card.health = defender.card.health - attacker.card.attack}
+      ( attacker & card . health .~ attacker ^. card . health - defender ^. card . attack,
+        defender & card . health .~ defender ^. card . health - attacker ^. card . attack
       )
 
 alternate :: Fighter -> Fighter
@@ -162,8 +160,8 @@ initAttacker board1 board2
 
 calculateResult :: (Board, Board) -> CombatResult
 calculateResult (board1, board2)
-  | not (null board1) && null board2 = Loss Two (sum $ map (\ci -> ci.card.cardTier) board1)
-  | null board1 && not (null board2) = Loss One (sum $ map (\ci -> ci.card.cardTier) board2)
+  | not (null board1) && null board2 = Loss Two (sum $ map (\ci -> ci ^. card . cardTier) board1)
+  | null board1 && not (null board2) = Loss One (sum $ map (\ci -> ci ^. card . cardTier) board2)
   | otherwise = Tie
 
 setAt :: Int -> a -> [a] -> [a]

src/Controller.hs

@@ -1,15 +1,4 @@
 -- Controller: Handles input, game loop
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE OverloadedRecordUpdate #-}
-{-# LANGUAGE RebindableSyntax #-}
-{-# OPTIONS_GHC -fplugin=Data.Record.Plugin #-}
 
 module Controller (module Controller) where
 
@@ -28,6 +17,7 @@ import Text.Parsec.String (Parser)
 import Text.Pretty.Simple (pPrint, pShow)
 import Text.Read (readMaybe)
 import View
+import Control.Lens
 
 -- START: Functions for ingesting terminal input as PlayerAction --
 -- Examples:
@@ -89,28 +79,30 @@ playArgParser = do
 -- END --
 
 initGameState :: GameState
-initGameState = GameState {playerState = defPlayerState, aiState = tutorialAI, turn = 0, config = Config {maxBoardSize = 7, maxHandSize = 10}}
+initGameState = GameState {_playerState = defPlayerState, _aiState = tutorialAI, _turn = 0, _config = Config {_maxBoardSize = 7, _maxHandSize = 10}}
 
 tutorialAI :: PlayerState
-tutorialAI = mainPlayerState {board = [CardInstance bigDumbo 0], hp = 5}
+tutorialAI = mainPlayerState 
+  & board .~ [CardInstance bigDumbo 0]
+  & hp .~ 5
 
 mainPlayerState :: PlayerState
 mainPlayerState =
   PlayerState
-    { tier = 1,
-      maxGold = 300, -- By `enter`ing into the first turn, this becomes 3 as required.
-      curGold = 2,
-      tierUpCost = 6, -- By `enter`ing into the first turn, this becomes 5 as required.
-      rerollCost = 1,
-      shop = [],
-      board = [],
-      hand = [],
-      frozen = False,
-      hp = 20,
-      armor = 0,
-      alive = True,
-      phase = Recruit,
-      idGen = IdGen 0
+    { _tier = 1,
+      _maxGold = 300, -- By `enter`ing into the first turn, this becomes 3 as required.
+      _curGold = 2,
+      _tierUpCost = 6, -- By `enter`ing into the first turn, this becomes 5 as required.
+      _rerollCost = 1,
+      _shop = [],
+      _board = [],
+      _hand = [],
+      _frozen = False,
+      _hp = 20,
+      _armor = 0,
+      _alive = True,
+      _phase = Recruit,
+      _idGen = IdGen 0
     }
 
 runGame :: IO ()
@@ -122,30 +114,33 @@ runGame = do
     loop :: (MonadIO m, MonadRandom m) => m GameState -> m GameState
     loop mgs = do
       gs <- mgs
-      -- Go to EndScreen if applicable
-      let gs' = gs {playerState.phase = if isGameOver gs then EndScreen else gs.playerState.phase}
-      -- trace (TL.unpack $ pShow gs)
-      case gs'.playerState.phase of
+      let gs' = gs & playerState.phase %~ \p -> if isGameOver gs then EndScreen else p
+
+      case gs' ^. playerState.phase of
         Recruit -> do
-          replenishedPlayer <- replenish gs'.playerState
-          replenishedAI <- replenish gs'.aiState
-          let gs'' = gs' {playerState = replenishedPlayer, aiState = replenishedAI}
+          replenishedPlayer <- replenish (gs' ^. playerState)
+          replenishedAI <- replenish (gs' ^. aiState)
+          let gs'' = gs' & playerState .~ replenishedPlayer 
+                        & aiState .~ replenishedAI
           recruitLoop gs'' >>= (loop . return)
+
         Combat -> do
           (gs'', sim) <- fight Player AI gs'
           liftIO $ replayCombat 1 sim
-          liftIO flushInput -- ignore input entered during combat phase
+          liftIO flushInput
           liftIO $ putStrLn "finished playing"
-          loop $ return gs'' {playerState.phase = Recruit, aiState.phase = Recruit}
+          loop $ return $ gs'' & playerState.phase .~ Recruit 
+                              & aiState.phase .~ Recruit
+
         EndScreen -> do
-          -- Note EndScreen doesn't invoke `loop`. Game logic stops here.
           liftIO $ putStrLn $ endScreenMsg gs'
           return gs
+
         _ -> error "Other phases not yet implemented"
 
 recruitLoop :: (MonadIO m, MonadRandom m) => GameState -> m GameState
 recruitLoop gs
-  | gs.playerState.phase == Recruit = do
+  | gs ^. playerState.phase == Recruit = do
       liftIO $ putStrLn $ fmtRecruit gs Player
       liftIO $ putStr "> "
       liftIO $ hFlush stdout