part1.hs

#!/usr/bin/env runghc

import Data.Array

data Cell = Open | Tree
  deriving (Eq)

charToCell '.' = Open
charToCell '#' = Tree

isValidCell '.' = True
isValidCell '#' = True
isValidCell _ = False

instance Read Cell where
  readsPrec _ (c:rest) = [(charToCell c, rest)]
  readList input =
    let (valid, rest) = span isValidCell input
     in [(map charToCell valid, rest)]

cellToChar Open = '.'
cellToChar Tree = '#'

instance Show Cell where
  show cell = [cellToChar cell]
  showList = (++) . map cellToChar

main = interact (show . solve . map (read :: String -> [Cell]) . lines)

solve rows = count (==Tree) $ map at path
  where
    board = toArray $ map toArray rows
    (_, y) = fmap (+1) $ bounds board
    (_, x) = fmap (+1) $ bounds $ board ! 0
    xIdx i = mod i x
    yIdx i = mod i y
    deltaY = 1
    deltaX = 3
    at (x', y') = (board ! (yIdx y')) ! (xIdx x')
    path = [(i*3, i) | i <- [0..y]]

count predicate xs = length $ filter predicate xs

toArray l = listArray (0, length l - 1) l