module Main where
import Text.ParserCombinators.Parsec
import System.Environment
import System.IO
import Control.Monad

-- Lisp Value Data Type
data LispVal = Atom String
             | List [LispVal]

instance Show LispVal where show = showVal

showVal :: LispVal -> String
showVal (Atom name) = name
showVal (List contents) = "(" ++ (unwords $ map show contents) ++ ")"

-- Parsers
readExpr :: String -> LispVal
readExpr input = case (parse parseExpr "lisp" input) of
  Left err  -> Atom $ "No match: " ++ show err
  Right val -> val

parseExpr :: Parser LispVal
parseExpr = parseAtom
        <|> parseList

symbol :: Parser Char
symbol = oneOf "!#$%&|*+-/:<=>?@^_~"

parseAtom :: Parser LispVal
parseAtom = do {
    first <- (letter <|> symbol);
    rest <- many (letter <|> digit <|> symbol);
    return $ Atom (first:rest);
}

parseList :: Parser LispVal
parseList = do {
    char '(';
    xs <- sepBy parseExpr (skipMany1 space);
    char ')';
    return $ List xs;
}

-- Evaluator
eval :: LispVal -> LispVal
eval lispVal = lispVal

-- Repl
readPrompt :: String -> IO String
readPrompt prompt = putStr prompt >> hFlush stdout >> getLine

readEvalPrint :: String -> IO()
readEvalPrint = putStrLn . show . eval . readExpr

loopUntil :: (a -> Bool) -> IO a -> (a -> IO ()) -> IO ()
loopUntil pred prompt action = do {
    x <- prompt;
    if pred x
      then return ()
      else (action x >> loopUntil pred prompt action)
}

-- main
main :: IO ()
main = loopUntil (== "quit") (readPrompt ">> ") readEvalPrint