Haskell Example of ErrorT STArray ST

It counts whether a given word is spellable using the letters one has (and a certain number of blanks). It throws an exception, eventually converted into nothing, if it fails, and returns the remaining tiles if it succeeds.

{- compile with "ghc -fglasgow-exts -package mtl example.hs" -} import Data.Array.MArray(freeze, thaw, writeArray, readArray); import Control.Monad.Trans(lift); import Data.Array(Array); import Data.STRef(readSTRef, newSTRef, STRef, writeSTRef); import Data.Array.ST(STArray); import Control.Monad.Error(runErrorT, throwError, ErrorT, Error(noMsg)); import Control.Monad.ST(runST, ST); type Underflow = (); instance Error Underflow where { noMsg = () } ; process_letter :: STRef s Int -> STArray s Char Int -> Char -> ErrorT Underflow (ST s )(()); process_letter pnum_blanks letters c = (do{ num_that_letter :: Int <- (lift (readArray letters c)); (case num_that_letter of { (0)-> (do{ x_num_blanks :: Int <- (lift (readSTRef pnum_blanks)); (case x_num_blanks of { (0)-> (throwError ()); (num_blanks)-> (lift((writeSTRef pnum_blanks)(pred(num_blanks)))) }); }); (_)-> (lift((writeArray letters c)(pred(num_that_letter)))) }); }); process_word :: Int -> Array Char Int -> String -> Maybe((Int, Array Char Int )); process_word num_blanks letters w = (case (runST(runErrorT((do{ pnum_blanks :: STRef s Int <- (lift (newSTRef num_blanks)); pletters :: STArray s Char Int <- (lift (thaw letters)); (mapM_ (process_letter pnum_blanks pletters) w); blanks_left :: Int <- (lift (readSTRef pnum_blanks)); letters_left :: Array Char Int <- (lift (freeze pletters)); (return (blanks_left, letters_left)); })))) of { (Left(_))-> Nothing; (Right(x))-> (Just x) }); main = undefined

process_word 0 (accumArray undefined 0 ('a','z') []) (repeat 'x') shows it works correctly on infinite input, stopping as soon as it reaches the underflow condition.