Day11.hs

module Day11 where

import Data.Array

data Cell = Empty | Occupied | Floor
  deriving (Eq, Show)

isCell 'L' = True
isCell '#' = True
isCell '.' = True
isCell _ = False

toCell 'L' = Empty
toCell '#' = Occupied
toCell '.' = Floor

instance Read Cell where
  readsPrec _ (c:rest) = [(toCell c, rest)]
  readList input = [(map toCell cells, rest)]
    where (cells, rest) = span isCell input

toChar Empty = 'L'
toChar Occupied = '#'
toChar Floor = '.'

type State = Array (Int, Int) Cell

parse :: String -> State
parse input = listArray ((1, 1), (width, height)) $ concat lists
  where
    lists :: [[Cell]]
    lists = map read $ lines input
    width = length $ head lists
    height = length lists

render :: State -> String
render state = unlines chunks
  where
    (_, (width, _)) = bounds state
    chars = map toChar $ elems state
    chunks = chunk width chars


chunk n [] = []
chunk n xs = curr:(chunk n rest)
  where
    (curr, rest) = splitAt n xs

n (x, y) = (x, y-1)
s (x, y) = (x, y+1)
w (x, y) = (x-1, y)
e (x, y) = (x+1, y)
ne = n . e
nw = n . w
se = s . e
sw = s . w

directions x = map ($ x) [n, ne, e, se, s, sw, w, nw]

(!?) arr ix =
  if inRange (bounds arr) ix
     then Just (arr ! ix)
     else Nothing

tick :: State -> State
tick curr = array (bounds curr) $ map nextCell $ assocs curr
  where
    occupiedAdjacent ix =
      length $ filter (== (Just Occupied)) $ map ((!?) curr) $ directions ix
    nextCell c@(ix, Empty)
      | occupiedAdjacent ix == 0 = (ix, Occupied)
    nextCell c@(ix, Occupied)
      | occupiedAdjacent ix >= 4 = (ix, Empty)
    nextCell x = x