DailyProgrammer Challenge #220i Solution (It's Go time!)

c-go.hs

import Control.Monad
import Data.Array
import Data.Char
import Data.List
import Data.Ord

data Cell = Player | Opponent | None | Oob deriving Eq
data Color = Black | White deriving Eq
type Grid = Array Int (Array Int Cell)

-- Convert a character in the input to a Cell enum
charToCell :: Color -> Char -> Cell
charToCell _ ' ' = None
charToCell k c   = if (k == Black) == (c == 'b') then Player else Opponent

-- Create a zero-indexed array from a list
listArrayZ :: [a] -> Array Int a
listArrayZ as = listArray (0, length as - 1) as

-- Convert a string to a grid row
strToRow :: Color -> String -> Array Int Cell
strToRow k s = listArrayZ $ map (charToCell k) s

-- Get a cell from a grid
getCell :: Grid -> (Int, Int) -> Cell
getCell g (x, y) | x < 0 || x > snd (bounds $ g ! 0) ||
               y < 0 || y > snd (bounds g) = Oob
             | otherwise = g ! y ! x

-- Read a grid from input
readGrid :: Color -> Int -> IO Grid
readGrid k height = liftM listArrayZ $ replicateM height $ liftM (strToRow k) getLine

-- Read grid dimensions from input
readDims :: IO (Int, Int)
readDims = liftM ((\(w:h:_) -> (w, h)) . map read . words) getLine

-- Gets the cells enclosed and removed in the specified group if the specified new point is added
getEnclosed :: (Grid, Int, Int) -> (Int, Int) -> (Int, Int) -> [(Int, Int)]
getEnclosed (g, w, h) np p = getEnclosedR (getCell g p) [p] [] where
    getEnclosedR _ [] v = v
    getEnclosedR k (p'@(x, y):ps) v
        | p' `elem` v || p' == np ||
          k' == Oob  = getEnclosedR k ps v
        | k' == k    = getEnclosedR k ((x + 1, y):(x - 1, y):(x, y - 1):(x, y + 1):ps) $ p':v
        | k' == None = []
        | otherwise  = getEnclosedR k ps v
        where k' = getCell g p'

-- Gets the cells enclosed and removed if the specified new point is added
getRemoved :: (Grid, Int, Int) -> (Int, Int) -> Int
getRemoved b@(g, w, h) p@(x, y) = length $ foldl union [] $ map (getEnclosed b p) $
                                  filter ((== Opponent) . (getCell g)) $
                                  [(x - 1, y), (x + 1, y), (x, y - 1), (x, y + 1)]

-- Gets the output of this solution, containing the location resulting in the best removal
getOutput :: (Grid, Int, Int) -> String
getOutput b@(g, w, h) = if change == 0 then "No constructive move." else show p where
    (p, change) = maximumBy (comparing snd) [((x, y), getRemoved b (x, y)) |
                                             x <- [0..w - 1],
                                             y <- [0..h - 1]]

main :: IO ()
main = do (width, height) <- readDims
          player          <- liftM (\s -> if s == "b" then Black else White) getLine
          grid            <- readGrid player height
          putStrLn $ getOutput (grid, width, height)
          return ()