Haskell Quiz/Text Munger/Solution Tel
< Haskell Quiz | Text Munger
Jump to navigation
Jump to search
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 :: StateT StdGen IO ()
loop = do l <- lift getLine
gen <- get
let (munge, gen2) = runState (mungeLine l) gen
put gen2
lift $ putStrLn munge
loop
mungeLine :: String -> State StdGen String
mungeLine = liftM unwords . mapM mungeWord . words
mungeWord :: String -> State StdGen String
mungeWord str = do gen <- get
let (randPairs :: [(Int, Char)], gen2) = runState (zipWithRand (,) mid) gen
put gen2
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) => (a -> b -> c) -> [b] -> State StdGen [c]
zipWithRand fn xs = do rands <- sequence $ map (const randomST) xs
return $ zipWith fn rands xs
-- random promoted inside the State monad for threading the StdGen
randomST :: Random a => State StdGen a
randomST = do gen <- get
let (x, gen2) = random gen
put gen2
return x