Week 11 code dojo with @MikeHeaton

Week11.hs

import qualified Data.Map.Strict as Map
import qualified Data.Set        as Set

import Data.Map.Strict ((!))
import Data.List       (partition)

getNeighbours list i j = let
    possible = [(i-1, j-1),(i-1, j), (i-1, j+1), (i, j-1), (i, j+1), (i+1, j-1), (i+1, j), (i+1, j+1)]
    actual   = filter (\(x, y) -> x >=0 && y >= 0 && x < length list && y < length (head list)) possible
    results  = filter (\(x, y) -> (list !! x) !! y == 1) actual
    in results

range list = [0..length list - 1]

adjacency graph = Map.fromList $ concatMap (\i -> map (\j -> let
    neighbours = Set.fromList $ getNeighbours graph i j
    in ((i, j), neighbours)) (range (head graph))) (range graph)

ones graph adj = filter (\(i, j) -> ((graph !! i) !! j == 1)) (Map.keys adj)

mergeSets adj coord sets = let
    parted = partition (not . Set.null . Set.intersection (adj ! coord)) sets
    merged = foldr Set.union (Set.singleton coord) $ fst parted 
    in merged : snd parted

mainFn input = let
    adj        = adjacency input
    singles    = ones input adj
    singletons = map Set.singleton singles
    connected  = foldr (mergeSets adj) singletons singles
    in maximum $ map Set.size connected

main = do
    rows <- fmap read getLine :: IO Int
    cols <- getLine
    text <- mapM (\_ -> fmap words getLine) [1..rows]
    let graph = map (map (\c -> read c :: Int)) text
    print (mainFn graph)