Difference between revisions of "Haskell Quiz/Text Munger/Solution Tel"
< Haskell Quiz | Text Munger
Jump to navigation
Jump to search
m |
m |
||
(3 intermediate revisions by one other user not shown) | |||
Line 16: | Line 16: | ||
main = getStdGen >>= evalStateT loop |
main = getStdGen >>= evalStateT loop |
||
− | loop :: |
+ | loop :: (MonadState StdGen m, MonadIO m) => m () |
− | loop = do l <- |
+ | loop = do l <- liftIO getLine |
− | + | munge <- mungeLine l |
|
− | + | liftIO $ putStrLn munge |
|
− | + | loop |
|
+ | |||
− | lift $ putStrLn munge |
||
⚫ | |||
− | loop |
||
− | |||
⚫ | |||
mungeLine = liftM unwords . mapM mungeWord . words |
mungeLine = liftM unwords . mapM mungeWord . words |
||
− | mungeWord :: String -> |
+ | mungeWord :: MonadState StdGen m => String -> m String |
− | mungeWord str = do |
+ | mungeWord str = do (randPairs :: [(Int, Char)]) <- zipWithRand (,) mid |
− | + | return (first ++ map snd (sortBy (comparing fst) randPairs) ++ last) |
|
− | put gen2 |
||
− | return ([first]++(map snd $ sortBy (comparing fst) randPairs)++last) |
||
where (first, mid, last) = splitEnds str |
where (first, mid, last) = splitEnds str |
||
− | splitEnds :: Eq a => [a] -> (a, [a], [a]) |
+ | splitEnds :: Eq a => [a] -> ([a], [a], [a]) |
− | splitEnds (x:[]) = (x, [], []) |
+ | splitEnds (x:[]) = ([x], [], []) |
− | splitEnds xs = (head xs, (init . tail) xs, [last xs]) |
+ | splitEnds xs = ([head xs], (init . tail) xs, [last xs]) |
-- zip across a list, passing a (Random t => t) in |
-- zip across a list, passing a (Random t => t) in |
||
− | zipWithRand :: (Random a) => (a -> b -> c) -> [b] -> |
+ | zipWithRand :: (Random a, MonadState StdGen m) => (a -> b -> c) -> [b] -> m [c] |
− | zipWithRand fn xs = do rands <- |
+ | zipWithRand fn xs = do rands <- mapM (const randomST) xs |
return $ zipWith fn rands xs |
return $ zipWith fn rands xs |
||
− | -- random promoted inside |
+ | -- random promoted inside some MonadState for threading the StdGen |
− | randomST :: Random a => |
+ | randomST :: (MonadState StdGen m, Random a) => m a |
randomST = do gen <- get |
randomST = do gen <- get |
||
let (x, gen2) = random gen |
let (x, gen2) = random gen |
||
put gen2 |
put gen2 |
||
− | return x |
+ | return x</haskell> |
− | </haskell> |
Latest revision as of 06:04, 21 February 2010
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
mungeLine :: MonadState StdGen m => String -> m String
mungeLine = liftM unwords . mapM mungeWord . words
mungeWord :: MonadState StdGen m => String -> m String
mungeWord str = do (randPairs :: [(Int, Char)]) <- zipWithRand (,) mid
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 <- mapM (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