Bump to lts-22.19 and brick-2.1.1

snake.cabal

@@ -24,6 +24,8 @@ executable snake
                      , extra
                      , linear
                      , lens
+                     , mtl
                      , random
                      , transformers
                      , vty
+                     , vty-crossplatform

src/Snake.hs

@@ -12,14 +12,16 @@ module Snake
   ) where
 
 import Control.Applicative ((<|>))
-import Control.Monad (guard)
+import Control.Monad (guard, void)
 import Data.Maybe (fromMaybe)
 
-import Control.Lens hiding ((<|), (|>), (:>), (:<))
+import Control.Lens hiding ((<|), (|>), (:>), (:<), index)
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.State.Class (MonadState, modify, get)
 import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.State
-import Control.Monad.Extra (orM)
-import Data.Sequence (Seq(..), (<|))
+import Control.Monad.Trans.State (execState)
+import Control.Monad.Extra (orM, unlessM)
+import Data.Sequence (Seq(..), (<|), index)
 import qualified Data.Sequence as S
 import Linear.V2 (V2(..), _x, _y)
 import System.Random (Random(..), newStdGen)
@@ -62,35 +64,36 @@ width = 20
 -- Functions
 
 -- | Step forward in time
-step :: Game -> Game
-step s = flip execState s . runMaybeT $ do
+step :: MonadState Game m => m ()
+step = void . runMaybeT $ do
 
   -- Make sure the game isn't paused or over
   MaybeT $ guard . not <$> orM [use paused, use dead]
 
   -- Unlock from last directional turn
   MaybeT . fmap Just $ locked .= False
 
-  -- die (moved into boundary), eat (moved into food), or move (move into space)
-  die <|> eatFood <|> MaybeT (Just <$> modify move)
+  -- die (moved into self), eat (moved into food), or move (move into space)
+  die <|> eatFood <|> MaybeT (Just <$> move)
 
 -- | Possibly die if next head position is in snake
-die :: MaybeT (State Game) ()
+die :: MonadState Game m => MaybeT m ()
 die = do
-  MaybeT . fmap guard $ elem <$> (nextHead <$> get) <*> (use snake)
+  MaybeT . fmap guard $ elem <$> nextHead <*> (use snake)
   MaybeT . fmap Just $ dead .= True
 
 -- | Possibly eat food if next head position is food
-eatFood :: MaybeT (State Game) ()
+eatFood :: MonadState Game m => MaybeT m ()
 eatFood = do
-  MaybeT . fmap guard $ (==) <$> (nextHead <$> get) <*> (use food)
+  MaybeT . fmap guard $ (==) <$> nextHead <*> (use food)
   MaybeT . fmap Just $ do
     modifying score (+ 10)
-    get >>= \g -> modifying snake (nextHead g <|)
+    nh <- nextHead
+    modifying snake (nh <|)
     nextFood
 
 -- | Set a valid next food coordinate
-nextFood :: State Game ()
+nextFood :: MonadState Game m => m ()
 nextFood = do
   (f :| fs) <- use foods
   foods .= fs
@@ -99,34 +102,36 @@ nextFood = do
     False -> food .= f
 
 -- | Move snake along in a marquee fashion
-move :: Game -> Game
-move g@Game { _snake = (s :|> _) } = g & snake .~ (nextHead g <| s)
-move _                             = error "Snakes can't be empty!"
+move :: MonadState Game m => m ()
+move = do
+  nh <- nextHead
+  modifying snake $ \(s :|> _) -> nh <| s
 
 -- | Get next head position of the snake
-nextHead :: Game -> Coord
-nextHead Game { _dir = d, _snake = (a :<| _) }
-  | d == North = a & _y %~ (\y -> (y + 1) `mod` height)
-  | d == South = a & _y %~ (\y -> (y - 1) `mod` height)
-  | d == East  = a & _x %~ (\x -> (x + 1) `mod` width)
-  | d == West  = a & _x %~ (\x -> (x - 1) `mod` width)
-nextHead _ = error "Snakes can't be empty!"
+nextHead :: MonadState Game m => m Coord
+nextHead = get <&> \(Game {_snake = (a :<| _), _dir = d}) -> case d of
+  North -> a & _y %~ (\y -> (y + 1) `mod` height)
+  South -> a & _y %~ (\y -> (y - 1) `mod` height)
+  East  -> a & _x %~ (\x -> (x + 1) `mod` width)
+  West  -> a & _x %~ (\x -> (x - 1) `mod` width)
 
 -- | Turn game direction (only turns orthogonally)
 --
 -- Implicitly unpauses yet locks game
-turn :: Direction -> Game -> Game
-turn d g = if g ^. locked
-  then g
-  else g & dir %~ turnDir d & paused .~ False & locked .~ True
+turn :: MonadState Game m => Direction -> m ()
+turn d = do
+  unlessM (use locked) $ do
+    modifying dir (turnDir d)
+    assign paused False
+    assign locked True
 
 turnDir :: Direction -> Direction -> Direction
 turnDir n c | c `elem` [North, South] && n `elem` [East, West] = n
             | c `elem` [East, West] && n `elem` [North, South] = n
             | otherwise = c
 
 -- | Initialize a paused game with random food location
-initGame :: IO Game
+initGame :: MonadIO m => m Game
 initGame = do
   (f :| fs) <-
     fromList . randomRs (V2 0 0, V2 (width - 1) (height - 1)) <$> newStdGen
@@ -142,7 +147,7 @@ initGame = do
         , _paused = True
         , _locked = False
         }
-  return $ execState nextFood g
+  pure $ execState nextFood g
 
 fromList :: [a] -> Stream a
 fromList = foldr (:|) (error "Streams must be infinite")

src/UI.hs

@@ -3,20 +3,21 @@ module UI where
 
 import Control.Monad (forever, void)
 import Control.Monad.IO.Class (liftIO)
+import Control.Monad.State.Class (put)
 import Control.Concurrent (threadDelay, forkIO)
 import Data.Maybe (fromMaybe)
 
 import Snake
 
 import Brick
-  ( App(..), AttrMap, BrickEvent(..), EventM, Next, Widget
+  ( App(..), AttrMap, BrickEvent(..), EventM, Widget
   , customMain, neverShowCursor
-  , continue, halt
+  , halt
   , hLimit, vLimit, vBox, hBox
   , padRight, padLeft, padTop, padAll, Padding(..)
   , withBorderStyle
   , str
-  , attrMap, withAttr, emptyWidget, AttrName, on, fg
+  , attrName, attrMap, withAttr, emptyWidget, AttrName, on, fg
   , (<+>)
   )
 import Brick.BChan (newBChan, writeBChan)
@@ -25,6 +26,8 @@ import qualified Brick.Widgets.Border.Style as BS
 import qualified Brick.Widgets.Center as C
 import Control.Lens ((^.))
 import qualified Graphics.Vty as V
+import qualified Graphics.Vty.CrossPlatform
+import qualified Graphics.Vty.Config
 import Data.Sequence (Seq)
 import qualified Data.Sequence as S
 import Linear.V2 (V2(..))
@@ -50,7 +53,7 @@ app :: App Game Tick Name
 app = App { appDraw = drawUI
           , appChooseCursor = neverShowCursor
           , appHandleEvent = handleEvent
-          , appStartEvent = return
+          , appStartEvent = pure ()
           , appAttrMap = const theMap
           }
 
@@ -61,26 +64,26 @@ main = do
     writeBChan chan Tick
     threadDelay 100000 -- decides how fast your game moves
   g <- initGame
-  let builder = V.mkVty V.defaultConfig
-  initialVty <- builder
-  void $ customMain initialVty builder (Just chan) app g
+  let buildVty = Graphics.Vty.CrossPlatform.mkVty Graphics.Vty.Config.defaultConfig
+  initialVty <- buildVty
+  void $ customMain initialVty buildVty (Just chan) app g
 
 -- Handling events
 
-handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game)
-handleEvent g (AppEvent Tick)                       = continue $ step g
-handleEvent g (VtyEvent (V.EvKey V.KUp []))         = continue $ turn North g
-handleEvent g (VtyEvent (V.EvKey V.KDown []))       = continue $ turn South g
-handleEvent g (VtyEvent (V.EvKey V.KRight []))      = continue $ turn East g
-handleEvent g (VtyEvent (V.EvKey V.KLeft []))       = continue $ turn West g
-handleEvent g (VtyEvent (V.EvKey (V.KChar 'k') [])) = continue $ turn North g
-handleEvent g (VtyEvent (V.EvKey (V.KChar 'j') [])) = continue $ turn South g
-handleEvent g (VtyEvent (V.EvKey (V.KChar 'l') [])) = continue $ turn East g
-handleEvent g (VtyEvent (V.EvKey (V.KChar 'h') [])) = continue $ turn West g
-handleEvent g (VtyEvent (V.EvKey (V.KChar 'r') [])) = liftIO (initGame) >>= continue
-handleEvent g (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt g
-handleEvent g (VtyEvent (V.EvKey V.KEsc []))        = halt g
-handleEvent g _                                     = continue g
+handleEvent :: BrickEvent Name Tick -> EventM Name Game ()
+handleEvent (AppEvent Tick)                       = step
+handleEvent (VtyEvent (V.EvKey V.KUp []))         = turn North
+handleEvent (VtyEvent (V.EvKey V.KDown []))       = turn South
+handleEvent (VtyEvent (V.EvKey V.KRight []))      = turn East
+handleEvent (VtyEvent (V.EvKey V.KLeft []))       = turn West
+handleEvent (VtyEvent (V.EvKey (V.KChar 'k') [])) = turn North
+handleEvent (VtyEvent (V.EvKey (V.KChar 'j') [])) = turn South
+handleEvent (VtyEvent (V.EvKey (V.KChar 'l') [])) = turn East
+handleEvent (VtyEvent (V.EvKey (V.KChar 'h') [])) = turn West
+handleEvent (VtyEvent (V.EvKey (V.KChar 'r') [])) = initGame >>= put
+handleEvent (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt
+handleEvent (VtyEvent (V.EvKey V.KEsc []))        = halt
+handleEvent _                                     = pure ()
 
 -- Drawing
 
@@ -136,9 +139,9 @@ theMap = attrMap V.defAttr
   ]
 
 gameOverAttr :: AttrName
-gameOverAttr = "gameOver"
+gameOverAttr = attrName "gameOver"
 
 snakeAttr, foodAttr, emptyAttr :: AttrName
-snakeAttr = "snakeAttr"
-foodAttr = "foodAttr"
-emptyAttr = "emptyAttr"
+snakeAttr = attrName "snakeAttr"
+foodAttr = attrName "foodAttr"
+emptyAttr = attrName "emptyAttr"

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-17.9
+resolver: lts-22.19
 packages:
 - '.'
 extra-deps: []

stack.yaml.lock

@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 567037
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/9.yaml
-    sha256: d7d8d5106e53d1669964bd8bd2b0f88a5ad192d772f5376384b76738fd992311
-  original: lts-17.9
+    sha256: e5cac927cf7ccbd52aa41476baa68b88c564ee6ddc3bc573dbf4210069287fe7
+    size: 713340
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/19.yaml
+  original: lts-22.19