Game of life in Haskell

gol.hs

data Aliveness = Alive | Dead deriving (Show, Eq)

survives :: Aliveness -> Int -> Aliveness
survives _     3 = Alive
survives Alive 2 = Alive
survives _     _ = Dead

data Point = Point { px :: Int, py :: Int } deriving (Show, Eq)
data Cell = Cell { pt :: Point } deriving (Show, Eq)
data Grid = Grid { cells :: [Cell] } deriving (Show)

neighbors :: Point -> Grid -> [Cell]
neighbors p g = [ c | c <- cells g, inrange c p, pt c /= p ]
  where inrange  c p = inxrange c p && inyrange c p
        inxrange c p = (px $ pt c) `elem` map (+(px p)) box
        inyrange c p = (py $ pt c) `elem` map (+(py p)) box
        box          = [-1, 0, 1]

numNeighbors :: Point -> Grid -> Int
numNeighbors p g = length $ neighbors p g

aliveCells :: Grid -> [Cell]
aliveCells g = survivingCells ++ newCells
  where survivingCells = [ c | c <- cells g, (survives Alive (numNeighbors (pt c) g)) == Alive]
        newCells       = [ Cell (Point x y) | x <- [minX..maxX], y <- [minY..maxY], (survives Dead (numNeighbors (Point x y) g)) == Alive, not ((Cell (Point x y)) `elem` survivingCells)]
        minX = (minimum $ xs) - 1
        minY = (minimum $ ys) - 1
        maxX = (maximum $ xs) + 1
        maxY = (maximum $ ys) + 1
        xs   = [ px $ pt c | c <- cells g ]
        ys   = [ py $ pt c | c <- cells g ]

transmuteGrid :: Grid -> Grid
transmuteGrid g = Grid $ aliveCells g

makeGrid :: [String] -> Grid
makeGrid board = Grid $ cellsFrom board
  where cellsFrom board = [ Cell (Point x y) | y <- ys board, x <- xs board, (board !! y !! x) == 'X']
        ys board        = [0..((length board) - 1)]
        xs board        = [0..((length $ head board) - 1)]

-----------------------------------------------------------------------------------------
gridToString :: [Cell] -> String
gridToString cs = concat $ map (++"\n") $ [ row y | y <- [(minY)..(maxY)] ]
  where minX      = -10 -- minimum $ xs
        minY      = -10 -- minimum $ ys
        maxX      = maximum $ xs
        maxY      = maximum $ ys
        points    = [ (px (pt c), py (pt c)) | c <- cs ]
        xs        = [ px $ pt c | c <- cs ]
        ys        = [ py $ pt c | c <- cs ]
        row y     = [ rep ((x,y) `elem` (points)) | x <- [(minX)..(maxX)] ]
        rep True  = 'X'
        rep False = '.'

displayGrid :: Grid -> IO ()
displayGrid grid = displayCells $ cells grid

displayCells :: [Cell] -> IO ()
displayCells cs = putStr $ "-------------------\n" ++ (gridToString cs)

-----------------------------------------------------------------------------------------
grid = makeGrid
  ["...X...",
   "..X.X..",
   "..X.X..",
   "...X.X."]

main :: IO ()
main = mapM_ displayGrid $ take 20 $ iterate transmuteGrid grid