Snake program

--Simple Snake Program
--Designed by Kyle McKean
import System.IO
import System.Random
import Control.Concurrent

type Pos  = (Int,Int)
type Food = Pos

type Snake = [Pos]

data Direction = L | R | D | U deriving (Show, Eq)

data Game = Game Direction Food Snake StdGen

leftBound   = 0
rightBound  = 70
bottomBound = 0
topBound    = 23

move :: Direction -> Snake -> Snake
move (L) s@((x,y):_) = (x-1,y  ):init s
move (R) s@((x,y):_) = (x+1,y  ):init s
move (D) s@((x,y):_) = (x  ,y+1):init s
move (U) s@((x,y):_) = (x  ,y-1):init s

isValid :: Snake -> Bool
isValid s = isInsideWalls s && not (collidesWithSelf s)
    where isInsideWalls ((x,y):_) = leftBound < x && x < rightBound && bottomBound < y && y < topBound
          collidesWithSelf (first:snake)    = first `elem` snake

ateFood :: Game -> Bool
ateFood (Game _ food (x:_) _) = food == x

toDirection :: Char -> Maybe Direction
toDirection c = if null direction then Nothing else Just (snd . head $ direction)
    where dircList  = [('a',L),('d',R),('s',D),('w',U)]
          direction = filter (\(k,_) -> k == c) dircList

checkDirection :: Direction -> Maybe Direction -> Direction
checkDirection (L) (Just R ) = L
checkDirection (R) (Just L ) = R
checkDirection (U) (Just D ) = U
checkDirection (D) (Just U ) = D
checkDirection  _  (Just c ) = c
checkDirection  c  (Nothing) = c

makeNewFood :: (RandomGen g) => g -> (Food, g)
makeNewFood gen = ((x,y), newGen')
    where (x,newGen ) = randomR (leftBound   + 1,rightBound - 1) gen
          (y,newGen') = randomR (bottomBound + 1,topBound   - 1) newGen

addFood :: Game -> Game
addFood (Game direction food snake gen)
    | newFood `elem` snake = addFood (Game direction food snake newGen)
    | otherwise            = Game direction newFood snake newGen
    where (newFood,newGen) = makeNewFood gen

checkFood :: Game -> Game
checkFood game
    | ateFood game = addFood game
    | otherwise    = game

growSnake :: Snake -> Snake
growSnake snake = snake ++ [last snake]

checkForGrowth :: Game -> Game
checkForGrowth game@(Game direction food snake gen)
    | ateFood game = Game direction food (growSnake snake) gen
    | otherwise    = game


--Displaying Game--

makeDisplayString :: Snake -> Pos -> String
makeDisplayString snake food = unlines $ [(replicate (rightBound+1) '#')]
                                         ++ (makeInsideString snake food)
                                         ++ [(replicate (rightBound+1) '#')]


makeInsideString :: Snake -> Food -> [String]
makeInsideString snake food = map addHashtags strs
    where addHashtags str = '#':str ++ "#"
          strs = [[(makeChar (x,y) snake food) | x <- [(leftBound+1)..(rightBound-1)]] | y <- [(bottomBound+1)..(topBound-1)]]
          makeChar p s f
            | p `elem` s = 'X'
            | p   ==   f = '@'
            | otherwise  = ' '

printGame :: Game -> IO ()
printGame (Game _ food snake _) = putStrLn $ makeDisplayString snake food

quit :: IO ()
quit = putStrLn "Game Over"

pause :: Game -> IO ()
pause = undefined

--Main Loops--

initalizeGame :: StdGen -> Maybe Game
initalizeGame gen = Just $ Game initalDirection initalFood initalSnake newGen
    where initalDirection     = L
          (initalFood,newGen) = makeNewFood gen
          initalSnake         = [(10,10),(11,10),(12,10),(13,10),(14,10),(15,10)]

updateGame :: Game -> Maybe Game
updateGame (Game direction food snake gen)
    | isValid movement = Just . checkFood . checkForGrowth $ Game direction food movement gen
    | otherwise        = Nothing
    where movement = move direction snake

updateGame' :: Char -> Game -> Maybe Game
updateGame' key (Game direction food snake gen) = updateGame (Game newDirection food snake gen)
    where newDirection = checkDirection direction (toDirection key)

parseKeyValue :: Char -> Game -> MVar Char -> IO ()
parseKeyValue 'q' _    _  = quit
parseKeyValue 'p' game _  = pause game
parseKeyValue  c  game mv = gameLoop (updateGame' c game) mv

gameLoop :: Maybe Game -> MVar Char -> IO ()
gameLoop (Just game) mv = do
    printGame game
    key <- getChar
    parseKeyValue key game mv
gameLoop (Nothing  ) _  = quit

getInput :: MVar Char -> IO ()
getInput mv = do
    char <- getChar
    putMVar mv char

main :: IO ()
main = do
    hSetEcho stdin False
    hSetBuffering stdin NoBuffering
    hSetBuffering stdout NoBuffering
    mv <- newEmptyMVar
    initalGen <- getStdGen
    --forkIO (getInput mv)
    gameLoop (initalizeGame initalGen) mv