MIU puzzle in Haskell

miu.hs

import Data.List
import Text.Regex.Posix

rule :: Int -> String -> ((String, String, String, [String]) -> String) -> ([Int],String) -> ([Int],String)
rule x pat f (routes,s) =
	 let 
	 	res = s =~~ pat :: Maybe (String, String, String, [String])
	 in case res of
	 	Just r -> (x:routes, f r)
	 	Nothing -> (routes,[])

rule1 = rule 1 "(\\w)I"        (\(b,m,a,as) -> b++as!!0++"IU"++a)
rule2 = rule 2 "M([M|I|U]?)"   (\(b,m,a,as) -> b++m++as!!0++a)
rule3 = rule 3 "(\\w)III(\\w)" (\(b,m,a,as) -> b++as!!0++"U"++as!!1++a)
rule4 = rule 4 "(\\w)UU(\\w)"  (\(b,m,a,as) -> b++as!!0++as!!1++a)

generate :: ([Int],String) -> [([Int],String)]
generate str = (str:) $ filter (not . null . snd) $ map ($ str) [rule1, rule2, rule3, rule4]

gen :: ([Int],String) -> [([Int],String)]
gen s = (s:) $ concat $ map generate (gen s)

main = putStrLn $ show $ find ((=="MU") . snd) $ gen ([],"MI")