Mike's same five digits solution

{-# LANGUAGE NoMonomorphismRestriction #-}

# See http://kernelbob.wordpress.com/2011/03/20/same-five-digits/#about for problem
# statement.
import qualified Data.Map as M
import qualified Data.Set as S

squares = map (show . (^2)) [1..]
fiveLong = takeWhile (\ s -> length s < 6) . dropWhile (\ s -> length s < 5)

combinationsOf 0 _ = [[]]
combinationsOf _ [] = []
combinationsOf k (x:xs) = map (x:) (combinationsOf (k-1) xs) ++ combinationsOf k xs

countMap :: [String] -> ([String], M.Map Char Char)
countMap triplet = (triplet, M.map (head . show) . M.fromListWith (+) $
                             zip (concat triplet) (repeat 1))

counted n = map countMap . combinationsOf n . fiveLong

fiveChars  = filter (\ (_, m) -> (== 5) $ M.size m)
diffChars  = filter (\ (_, m) -> (== 5) . S.size . S.fromList $ M.elems m)
sameDigits = filter (\ (_, m) -> S.fromList (M.elems m) == S.fromList (M.keys m))
notSelf    = filter (\ (_, m) -> (== 0) . M.size $ M.filterWithKey (==) m)
findUnique = M.filter (\ t -> length t == 3) . flipSingles . getSingles
  where
    getSingles = map (\ (t, m) -> (t, head . M.keys $ M.filter (== '1') m))
    flipSingles = M.fromListWith (++) . map (\ (t, m) -> (m, t))

filterSeq = findUnique . notSelf . sameDigits . diffChars . fiveChars

main = do
  (putStrLn . show . head . M.elems . filterSeq . counted 3) squares