I wrote a partial implementation of Snake in Haskell. As of now, it only supports the movement of the snake. However, since the code is getting complex, I'm requesting for a review of the code before I add on the food, growing and scoring functions.
I'd be glad to hear any suggestions on how this code could be written in a more idiomatic and simpler way (namely, stepSnake
and step
are long and messy).
-- Snake implementation in Haskell.
module Snake (
newGame
) where
import Control.Lens (set, ix)
import Data.Foldable (toList)
import qualified Data.Sequence as S
-- Size of the grid
n :: Int
n = 5
data Marking = Empty | Food | Snake
deriving (Show, Read, Eq)
type Grid = [[Marking]]
emptyGrid :: Int -> Grid
emptyGrid n = replicate n $ replicate n Empty
type Coord = (Int, Int)
data Direction = N | E | W | S
deriving (Show, Read, Eq)
stepCoord :: Coord -> Direction -> Coord
stepCoord (i, j) dir = case dir of
N -> (i - 1, j)
E -> (i, j + 1)
W -> (i, j - 1)
S -> (i + 1, j)
setCoord :: Marking -> Coord -> Grid -> Grid
setCoord mark (i, j) grid = set (ix i . ix j) mark grid
validCoord :: Coord -> Bool
validCoord (i, j) = i > 0 && j > 0 && i < n && j < n
type Snake = S.Seq Coord
newSnake :: Int -> Snake
newSnake n = S.fromList [c, c', c'']
where c = (n `div` 2, n `div` 2)
c' = stepCoord c E
c'' = stepCoord c' E
stepSnake :: Snake -> Direction -> Maybe (Coord, Snake, Coord)
stepSnake snake dir = if validCoord tail' && not (tail' `elem` toList snake')
then Just (head, snake'', tail')
else Nothing
where (head, snake') = case S.viewl snake of
S.EmptyL -> error "snake is empty"
x S.:< xs -> (x, xs)
tail = case S.viewr snake of
S.EmptyR -> error "snake is empty"
_ S.:> x -> x
tail' = stepCoord tail dir
snake'' = snake' S.|> tail'
data Game = Game {
grid :: Grid,
snake :: Snake
} deriving Show
newGame :: Game
newGame = Game {
grid = foldl (flip $ setCoord Snake) (emptyGrid n) (toList snake),
snake = snake
} where snake = newSnake n
step :: Game -> Direction -> Maybe Game
step (Game grid snake) dir = case stepSnake snake dir of
Nothing -> Nothing
Just (head, snake', tail') -> Just $ Game (foldl f grid [(head, Empty), (tail', Snake)]) snake'
where f grid (coord, mark) = setCoord mark coord grid