第23回オフラインリアルタイムどう書くの問題をHaskellで解く

import qualified Data.Map as Map
import Data.Char

type Position = Int
type Value = Int
type Board = Map.Map Position Value

makeMap :: String -> Board
makeMap = foldl insert Map.empty
    where
        insert :: Board -> Char -> Board
        insert m c | c == '/' = m
                   | otherwise = Map.insert (Map.size m) (digitToInt c) m


nextPosition :: Board -> Position -> [Position]
nextPosition b p = [p' | p' <- around p, b Map.! p' > b Map.! p]
    where
        around :: Position -> [Position]
        around p | p `mod` 5 == 0 = [p' | p' <- [p - 5, p + 1, p + 5], p' >= 0, p' <= 24]
        around p | p `mod` 5 == 4 = [p' | p' <- [p - 5, p + 5, p - 1], p' >= 0, p' <= 24]
        around p | otherwise = [p' | p' <- [p - 5, p + 1, p + 5, p - 1], p' >= 0, p' <= 24]


search :: Board -> Int
search b = maximum $ map (search' b) [0..24]
    where 
        search' :: Board -> Position -> Int
        search' b p | nextPosition b p == [] = 1
                    | otherwise = 1 + (maximum $ map (search' b) (nextPosition b p))

main = do
    input <- getContents
    mapM test (lines input)
    where
        test :: String -> IO ()
        test s = do
            --putStr s
            let (x:y:[]) = words s
            putStr $ x ++ " "
            let out = (search . makeMap) x
            putStr $ show out ++ " "
            putStr $ y ++ " "
            putStrLn $ show (out == read y)