trigram.hs

import Data.Char
import System.Random

main = do
  randomGen <- newStdGen
  let getR = getRandom randomGen
  contents <- getContents
  outputStory . (generateStory 10 getR) $ contents
  putStrLn ""

outputStory :: [String] -> IO ()
outputStory [] = return ()
outputStory (x:[]) = putStr x
outputStory (x:xs) = do
  putStr x 
  putStr " "
  outputStory xs

getSets :: [String] -> [(String, String, String)]
getSets (x0:x1:x2:xs) = (x0,x1,x2):getSets(x1:x2:xs)
getSets _ = []

triSetMatches w0 w1 (a0,a1,a2) 
    | a0 == w0 && a1 == w1 = True
    | otherwise = False

getNextWord :: String -> String -> [(String,String,String)] -> String
getNextWord w0 w1 triSets = 
  let matchingSet = take 1 $ filter (triSetMatches w0 w1) triSets
      [(_,_,nextWord)] = matchingSet
  in nextWord

getThird (_,_,third) = third

getRandom gen x = 
  let randResult = randomR(0,x-1)(gen)
  in
    case randResult of (r,_) -> r

getRandomWord getR xs = 
  let dropAmount = getR $ length xs
  in head . (drop dropAmount) $ xs

getWords :: String -> String -> [(String,String,String)] -> (Int -> Int) -> [String]
getWords w0 w1 triSets getR =
  let matchingSet = map getThird $ filter (triSetMatches w0 w1) triSets 
  in
    case matchingSet of [] -> [w0,w1]
                        (xs) -> 
                          let w2 = (getRandomWord getR xs)
                          in w0:(getWords w1 w2 triSets getR)
                
    

getTriSets :: String -> [String]
getTriSets input = words input

getInitialWords getR xs = 
  head (drop (getR (length xs)) xs)

generateStory :: Int -> (Int -> Int) -> String -> [String]
generateStory maxWords getR input = 
  let triSets = getSets (words input)
      (firstWord, secondWord, _) = (getInitialWords getR) triSets
      storyWords = getWords firstWord secondWord triSets getR
  in take maxWords storyWords