Haskell Quiz/Text Munger/Solution Stoltze

Breaks on pure-punctuation words

module Main where

import Random
import List
import Char

-- Reads a line, splits it into words, parses them and prints the new line
main :: IO ()
main = getLine >>= (parseEach . words) >>= (putStrLn . unwords)

-- Loops over each word, building up a list of parsed words
parseEach :: [String] -> IO [String]
parseEach [] = return []
parseEach (x:xs) = do word <- parse x
                      result <- parseEach xs
                      return (word : result)

-- Parses a word. Removes punctuation from start and end and makes a random permutation of the letters in the word, then adds the punctuation back
parse :: String -> IO String
parse word | length word == 1 = return word
           | otherwise = do let (startPunctuation, stripped, endPunctuation) = parsePunc word
                            scramble <- randomPermutation $ tail $ init stripped
                            return (startPunctuation ++ head stripped : scramble ++ last stripped : endPunctuation)

-- Finds the start and end punctuation of the word and strips it
parsePunc word = let start    = takeWhile (not . isAlpha) word
                     end      = reverse $ takeWhile (not . isAlpha) $ reverse word
                     stripped = reverse $ snd $ break isAlpha $ reverse $ snd $ break isAlpha word
                 in (start, stripped, end)

-- Makes a random permutation of the word passed in.
randomPermutation :: (Eq a) => [a] -> IO [a]
randomPermutation [] = return []
randomPermutation list = do number <- randomRIO (0, (length list) - 1)
                            let elem = list !! number
                            result <- randomPermutation (delete elem list)
                            return (elem : result)