http://haskell98.blogspot.ru/2013/02/2013.html nub можно убрать использовав Data.Set, но на малых размерах N^2 не проблема. solN можно тоже переписать так, чтобы не проводилить двойные вычисления, но мне лень :)

mouse.hs

import Data.Function
import Data.List
import Control.Monad
import Debug.Trace
import Data.Set (Set)
import qualified Data.Set as S

type History = [Int]
type Mouse = Int
type Size = Int
type State = ([Mouse],History)

initial :: Size  -> State
initial n = ([1..n],[])



game :: Size -> Set [Mouse] -> [State] -> [State]
game _ _ [] = []
game n vis is = let ns = filter (flip S.notMember vis . fst) $ concatMap step is 
                in is ++ ns ++ game n (vis `S.union` (S.fromList $ map fst ns)) ns
  where 
    step :: State -> [State]
    step ([],_) = [] -- no more steps ^_^
    step (ms,h) = flip map [1..n] $ \i -> -- cat`s move
                         let h' = i:h              -- next step
                             ms' = filter (/=i) ms -- mices that are alive
                             ms'' = sort . nub $ filter inBounds $ liftM2 (+) [1,-1] ms' -- next mice step
                         in (ms'',h')
    inBounds x | x >= 1 && x <= n = True
               | otherwise        = False

sol1 n = reverse . snd . head . (filter isSolution) $ game n S.empty [initial n]
solN n = map (reverse . snd) sls
  where s1  = head $ filter isSolution $ game n S.empty [initial n]
        sls = filter isSolution $ takeWhile f 
                                $ dropWhile (not . f)
                                $ game n S.empty [initial n]
        f = on (==) (length . snd) s1

isSolution = null . fst