gistfile1.txt

module Main where

import Control.Monad.Random
import Data.Char

-- | Get all word ranges in string
accumWords :: (Char -> Bool) -> String -> [String]
accumWords pred str = allWords
  where (last, others, _) = foldl accumWords' ("", [], True) str
        allWords = others ++ [last]
        accumWords' (cur, all, wasWordChar) c
          | pred c == wasWordChar = (cur ++ [c], all, pred c)
          | otherwise             = ([c], all ++ [cur], pred c)

-- | Shuffles a string
shuffle :: RandomGen g => String -> Rand g String
shuffle = foldr shuffle' (pure "")
  where shuffle' char boxedStr = do
        str <- boxedStr
        idx <- getRandomR (0, length str)
        pure $ take idx str ++ [char] ++ drop idx str

-- | Shuffles any words in a string according to a predicate
shuffleWords :: RandomGen g => (Char -> Bool) -> String -> Rand g String
shuffleWords inWord str = concat <$> mapM shuffleWordMiddle (accumWords inWord str)
  where isWord = foldr (&&) True . map inWord
        shuffleWordMiddle w
          | isWord w  = do
              let start = [head w]
              scrambled <- shuffle . drop 1 . take (length w - 1) $ w
              let end = if length w > 1 then [last w] else []
              pure $ start ++ scrambled ++ end
          | otherwise = pure w

-- | Test whether a character is part of a word
-- Change this to include other characters in words
isWordChar :: Char -> Bool
isWordChar c = isAlpha c || isDigit c || c == '\''

-- | The sample text
sampleText :: String
sampleText =
  unlines [ "Humpty Dumpty sat on a wall,"
          , "Humpty Dumpty had a great fall."
          , "All the king's horses and all the king's men"
          , "Couldn't put Humpty together again."
          ]

-- | Usage
main :: IO ()
main = do
  rng <- newStdGen
  let shuffledText = evalRand (shuffleWords isWordChar sampleText) rng
  putStrLn shuffledText

-- ghci> main
-- Hmupty Dmputy sat on a wall,
-- Htmpuy Dmputy had a gaert flal.
-- All the k'ngis heorss and all the k'gnis men
-- C'uolndt put Htumpy tethgoer agian.