Intermediate #95: Filler Text

-- As seen here: http://www.reddit.com/r/dailyprogrammer/comments/za9tu/9032012_challenge_95_intermediate_filler_text/c633fn2

module Intermediate95 where

import Data.Char (toUpper)
import Data.Random.Extras (choice)
import Data.Random (runRVar)
import Data.Random.Source.DevRandom (DevRandom (DevURandom))
import Data.RVar (RVar)
import System.Environment (getArgs)
import System.Random (randomRIO)

-- Prints filler text given the number of sentences to be printed.
main :: IO ()
main = fmap (read . head) getArgs >>= sentences >>= join >>= putStrLn

-- Returns a list of n sentences.
sentences :: Int -> IO [String]
sentences 0 = return []
sentences n = do
    (s, l) <- sentence

    case compare n l of
        LT -> (return . take n) s
        _  -> do
            rest <- sentences (n - l)

            if null rest then
                (return . return . unwords) s
            else
                (return . (unwords s :)) rest

-- Concats the list of sentences while inserting line breaks and paragraph breaks.
-- There is a 15% chance of a line break to follow a sentence.
-- There is a further 50% chance of those line breaks to be paragraph breaks instead.
join :: [String] -> IO String
join []       = return ""
join [x]      = return $ x ++ "."
join (x : xs) = do
    rest <- join xs
    eol  <- chance 15
    eop  <- chance 50

    return $ x ++ ". " ++
        if eol then
            "\n" ++
                if eop then
                    "\n" ++ rest
                else
                    rest
        else
            rest

-- Returns a boolean given a probability.
chance :: Int -> IO Bool
chance n = (rvar . choice . distribution) [
    (True, n),
    (False, 100 - n)]

-- Generates a tuple of a random sentence and its length.
sentence :: IO ([String], Int)
sentence = do
    n        <- randomRIO (3, 8)
    (x : xs) <- randomWords n

    return (capitalise x : xs, n)

capitalise :: String -> String
capitalise (x : xs) = toUpper x : xs

randomWords :: Int -> IO [String]
randomWords 0 = return []
randomWords n = do
    w    <- randomRIO (1, 12) >>= randomWord
    rest <- randomWords (n - 1)

    return (w : rest)

randomWord :: Int -> IO String
randomWord 0 = return []
randomWord n = do
    c    <- randomChar
    rest <- randomWord (n - 1)

    return (c : rest)

randomChar :: IO Char
randomChar = (rvar . choice) english

-- Source: http://en.wikipedia.org/wiki/Letter_frequency#Relative_frequencies_of_letters_in_the_English_language
english :: String
english = distribution [
    ('a',  8167),   ('n',  6749),
    ('b',  1492),   ('o',  7507),
    ('c',  2782),   ('p',  1929),
    ('d',  4253),   ('q',    95),
    ('e', 12702),   ('r',  5987),
    ('f',  2228),   ('s',  6327),
    ('g',  2015),   ('t',  9056),
    ('h',  6094),   ('u',  2758),
    ('i',  6966),   ('v',  1037),
    ('j',   153),   ('w',  2365),
    ('k',   747),   ('x',   150),
    ('l',  4025),   ('y',  1974),
    ('m',  2406),   ('z',    74)]

distribution :: [(a, Int)] -> [a]
distribution = concatMap (uncurry (flip replicate))

rvar :: RVar a -> IO a
rvar f = runRVar f DevURandom