Suboptimal, quick and dirty Haskell mastermind solver

mastermind.hs

 import Control.Applicative ((<$>))

type Code = [Char]

universe :: [Code]
universe = universe' (4 :: Int)
  where
    universe' 0 = [[]]
    universe' n = [x : xs | x <- ['0' .. '9'], xs <- universe' (n - 1)]

feedback :: Code        -- ^ True value
         -> Code        -- ^ Guess
         -> (Int, Int)  -- ^ (Right, Wrong place)
feedback code guess =
    let (r, code', guess') = right code guess
        m                  = misplaced code' guess'
    in (r, m)
  
right :: Code -> Code -> (Int, Code, Code)
right []       _        = (0, [], [])
right _        []       = (0, [], [])
right (x : xs) (y : ys)
    | x == y            = (n + 1, xs', ys')
    | otherwise         = (n, x : xs', y : ys')
  where
    (n, xs', ys') = right xs ys

misplaced :: Code -> Code -> Int
misplaced _    []       = 0
misplaced code (x : xs) = case break (== x) code of
    (a, (_ : b)) -> 1 + misplaced (a ++ b) xs
    _            -> misplaced code xs

search :: IO ()
search = do
    putStrLn "=> 0011"
    search' "0011" universe

search' :: Code -> [Code] -> IO ()
search' code possible = do
    putStrLn $ show (length possible) ++ " possibilities remaining"
    [r, m] <- map read . words <$> getLine
    let possible' = filter (\x -> feedback x code == (r, m)) possible
        guess     = head possible'
    putStrLn $ "=> " ++ guess
    case possible' of
        []   -> putStrLn "Impossible!"
        [_]  -> return ()
        _    -> search' guess possible'

main :: IO ()
main = search