Conways game of life in Haskell

Question

I started with Haskell some months ago, but didn't really use it since then. As a simple training I implemented Conways game of life. What/How could it be improved?

module Main where
import Control.Monad.State
data CellState = Dead | Alive deriving (Eq)
data Cell = Cell CellState Int deriving (Eq)
data Row = Row [Cell] Int deriving (Eq)
data Grid = Grid [Row]
data NextError = EmptyListError
type GridState a = State Grid a
instance Show Grid where
 show (Grid rows) = unlines $ map show rows
instance Show Row where
 show (Row cells n) = (show n) ++ ": " ++ (unwords $ map show cells)
instance Show Cell where
 show (Cell color _) = show color
instance Show CellState where
 show c = case c of
 Dead -> "_"
 Alive -> "#"
main::IO()
main = print $ run (execState initializeGrid (createGrid 20 20)) 100
run :: Grid -> Int -> [Grid]
run g n = scanl (\s f -> f s) g $ replicate n playRound
initializeGrid :: GridState ()
initializeGrid = do
 setPositionToColor 0 0 Alive
 setPositionToColor 1 1 Alive
 setPositionToColor 1 2 Alive
 setPositionToColor 2 0 Alive
 setPositionToColor 2 1 Alive
 setPositionToColor 4 4 Alive
 setPositionToColor 5 4 Alive
 setPositionToColor 6 4 Alive
 setPositionToColor 5 5 Alive
 setPositionToColor 5 4 Alive
 setPositionToColor 5 6 Alive
createGrid :: Int -> Int -> Grid
createGrid x y = Grid $ map createRow (take x [0,1..]) where
 createRow = Row (map createCell (take y [0,1..]))
 createCell = Cell Dead
setPositionToColor :: Int -> Int -> CellState -> GridState ()
setPositionToColor x y color = do
 grid <- get
 let rows = getRows grid
 cells = getCells (rows !! x)
 newState = Grid $ replaceListElement rows x $ Row (replaceListElement cells y $ Cell color y) x
 put newState
getCells :: Row -> [Cell]
getCells (Row c _) = c
getRows :: Grid -> [Row]
getRows (Grid r) = r
replaceListElement :: [a] -> Int -> a -> [a]
replaceListElement list position replacement =
 let (x, _:xs) = splitAt position list
 in x ++ replacement : xs
playRound :: Grid -> Grid
playRound (Grid rows) = Grid $ map (updateRow rows) rows
updateRow :: [Row] -> Row -> Row
updateRow rows row@(Row cells p) = Row (map (updateCell rows row) cells) p
updateCell :: [Row] -> Row -> Cell -> Cell
updateCell rows row cell@(Cell _ position) =
 let upperRowCells = getCells $ previous rows row
 upperCell = upperRowCells !! position
 lowerRowCells = getCells $ next rows row
 lowerCell = lowerRowCells !! position
 neighbourCells = [upperCell, lowerCell] ++
 getNextPrevious (getCells row) cell ++
 getNextPrevious upperRowCells upperCell ++
 getNextPrevious lowerRowCells lowerCell
 countLivingNeighbours = length $ filter (==Alive) $ map getCellColor neighbourCells
 isLiving = getCellColor cell == Alive
 in Cell (calcCellState isLiving countLivingNeighbours) position
getCellColor :: Cell -> CellState
getCellColor (Cell c _) = c
calcCellState :: Bool -> Int -> CellState
calcCellState living livingNeighbours
 | living && livingNeighbours < 2 = Dead
 | living && livingNeighbours <= 3 = Alive
 | living && livingNeighbours > 3 = Dead
 | not living && livingNeighbours == 3 = Alive
 | otherwise = Dead
getNextPrevious :: Eq a => [a] -> a -> [a]
getNextPrevious l e = [next l e, previous l e]
next :: Eq a => [a] -> a -> a
next l@(x:_) e = case dropWhile (/= e) l of
 (_:y:_) -> y
 _ -> x
previous :: Eq a => [a] -> a -> a
previous l e = case takeWhile (/=e) l of
 [] -> last l
 x -> last x

Answer 1

A few things which came to my mind while reading your code:

• The Show instance for CellState might be a bit nicer by not writing out the case expression manually but rather using

  instance Show CellState where
   show Dead = "_"
   show Alive = "#"
  

• You could shorten initializeGrid by using mapM_:

  initializeGrid :: GridState ()
  initializeGrid = mapM_ (\(x, y) -> setPositionToColor x y Alive)
   [(0,0),(1,1),(1,2),(2,0),(2,1),(4,4),(5,4),(6,4),(5,5),(5,4),(5,6)]
  

• take n [0,1..] is the same as [0,1..n] (looking at createGrid).

• callCellState could be shortened by only explicitely testing the conditions determining whether the cell becomes (or remains) alive:

  calcCellState :: Bool -> Int -> CellState
  calcCellState living livingNeighbours
   | living && livingNeighbours `elem` [2,3] = Alive
   | not living && livingNeighbours == 3 = Alive
   | otherwise = Dead
  

On a more general note, seeing how long the updateCell function is and how you had to roll your own next and previous function I do suspect that lists are not the most appropriate data structure for this kind of problem. A vector may be easier to work with.