Haskell Quiz/Text Munger/Solution Tel

A somewhat naive solution using State transformers to pass StdGen through the process. Doesn't handle punctuation correctly.

{-# OPTIONS -fglasgow-exts #-}

module Main where

import System.Random
import Data.Ord (comparing)
import Data.List (sortBy)
import Control.Monad.State.Lazy

main :: IO ()
main = getStdGen >>= evalStateT loop

{-
loop :: (MonadState StdGen m, MonadIO m) => m ()
loop = do l <- liftIO getLine
          munge <- mungeLine l
          liftIO $ putStrLn munge
          loop -}

loop :: (MonadState StdGen m, MonadIO m) => m ()
loop = do l <- liftIO getLine
          munge <- mungeLine l
          liftIO $ putStrLn munge
          loop

mungeLine :: MonadState StdGen m => String -> m String
mungeLine = liftM unwords . mapM mungeWord . words

mungeWord :: MonadState StdGen m => String -> m String
mungeWord str = do gen <- splitST
                   let (randPairs :: [(Int, Char)]) = evalState (zipWithRand (,) mid) gen
                   return (first ++ map snd (sortBy (comparing fst) randPairs) ++ last)
    where (first, mid, last) = splitEnds str

splitEnds :: Eq a => [a] -> ([a], [a], [a])
splitEnds (x:[]) = ([x], [], [])
splitEnds xs = ([head xs], (init . tail) xs, [last xs]) 

-- zip across a list, passing a (Random t => t) in
zipWithRand :: (Random a, MonadState StdGen m) => (a -> b -> c) -> [b] -> m [c]
zipWithRand fn xs = do rands <- sequence $ map (const randomST) xs 
                       return $ zipWith fn rands xs

-- random promoted inside some MonadState for threading the StdGen
randomST :: (MonadState StdGen m, Random a) => m a
randomST = do gen <- get
              let (x, gen2) = random gen
              put gen2
              return x

-- split promoted inside some MonadState for generating new a StdGen
splitST :: MonadState StdGen m => m StdGen
splitST = do gen <- get
             let (newgen, gen2) = split gen
             put gen2
             return newgen