{-# LANGUAGE DoAndIfThenElse #-}
module Main where
import System.Environment
import System.Console.Readline
import System.IO
import Control.Monad
import Parse
import Eval
import AST
import Error

main :: IO ()
main = do
  args <- getArgs
  if null args then runRepl else runOne $ args

flushStr :: String -> IO ()
flushStr str = putStr str >> hFlush stdout

readPrompt :: String -> IO String
-- readPrompt prompt = flushStr prompt >> getLine
readPrompt prompt = do l <- readline prompt
                       case l of
                         Just line -> do addHistory line
                                         return line
                         Nothing -> readPrompt prompt

evalString :: Env -> String -> IO String
evalString env expr = runIOThrows $ liftM show $ (liftThrows $ readExpr expr) >>=
                      eval env

evalAndPrint :: Env -> String -> IO ()
evalAndPrint env expr = evalString env expr >>= putStrLn

until_ :: Monad m => (a -> Bool) -> m a -> (a -> m ()) -> m ()
until_ p prompt action = do
  result <- prompt
  if p result
  then return ()
  else action result >> until_ p prompt action


runOne :: [String] -> IO ()
runOne args = do
  env <- primitiveBindings >>= flip bindVars [("args", List $ map String $ drop 1 args)]
  (runIOThrows $ liftM show $ eval env (List [Atom "load", String (args !! 0)]))
  >>= hPutStrLn stderr

runRepl :: IO ()
runRepl = primitiveBindings >>= until_ (== "quit") (readPrompt "Lisp>>> ") . evalAndPrint
