Haskell Quiz/Count and Say/Solution Dolio

While reading the description for this quiz, I thought it was a perfect problem to make use of the handy clusterBy function Tom Moertel recently discussed on his blog. So, I whipped up this solution to see how it'd work.

module Main (main, say, search) where

import Data.Char
import Data.List
import Data.Maybe
import qualified Data.Map as M

import Control.Arrow
import Control.Monad
import System.Environment

clusterBy :: Ord b => (a -> b) -> [a] -> [[a]]
clusterBy p = M.elems . M.map reverse . M.fromListWith (++) . map (p &&& return)

cluster :: Ord a => [a] -> [[a]]
cluster = clusterBy id

speak :: Int -> String
speak 1  = "ONE"
speak 2  = "TWO"
speak 3  = "THREE"
speak 4  = "FOUR"
speak 5  = "FIVE"
speak 6  = "SIX"
speak 7  = "SEVEN"
speak 8  = "EIGHT"
speak 9  = "NINE"
speak 10 = "TEN"
speak 11 = "ELEVEN"
speak 12 = "TWELVE"
speak 13 = "THIRTEEN"
speak 15 = "FIFTEEN"
speak 18 = "EIGHTEEN"
speak 20 = "TWENTY"
speak 30 = "THIRTY"
speak 40 = "FORTY"
speak 50 = "FIFTY"
speak 60 = "SIXTY"
speak 70 = "SEVENTY"
speak 80 = "EIGHTY"
speak 90 = "NINETY"
speak n | n < 20    = speak (n - 10) ++ "TEEN"
        | n < 100   = speak (n - m) ++ speak m
        | otherwise = error "Unanticipated number."
 where m = n `mod` 10

say :: String -> String
say = intercalate " " . map (\c -> speak (length c) ++ " " ++ take 1 c)
        . cluster . filter isAlpha

search :: String -> Int
search = (1+) . fromJust . search' []
 where search' l s = elemIndex s l `mplus` search' (s:l) (say s)

main = print . search . map toUpper . head =<< getArgs