tricu/src/REPL.hs

module REPL where

import Eval
import FileEval
import Lexer
import Parser
import Research

import Control.Exception         (SomeException, catch)
import Control.Monad.IO.Class    (liftIO)
import Control.Monad.Catch (handle, MonadCatch)
import Data.Char                 (isSpace)
import Data.List                 (dropWhile, dropWhileEnd, intercalate)
import System.Console.Haskeline

import qualified Data.Map as Map

repl :: Env -> IO ()
repl env = runInputT defaultSettings (withInterrupt (loop env))
  where
    loop :: Env -> InputT IO ()
    loop env = handle (interruptHandler env) $ do
      minput <- getInputLine "tricu < "
      case minput of
        Nothing -> outputStrLn "Exiting tricu"
        Just s
          | strip s == "!exit" -> outputStrLn "Exiting tricu"
          | strip s == "" -> loop env
          | strip s == "!import" -> do
              path <- getInputLine "File path to load < "
              case path of
                Nothing -> do
                  outputStrLn "No input received; stopping import."
                  loop env
                Just p -> do
                  loadedEnv <- liftIO $ evaluateFileWithContext env 
                    (strip p) `catch` \e -> errorHandler env e
                  loop $ Map.delete "!result" (Map.union loadedEnv env)
          | take 2 s == "--" -> loop env
          | otherwise -> do
              newEnv <- liftIO $ processInput env s `catch` errorHandler env
              loop newEnv

    interruptHandler :: Env -> Interrupt -> InputT IO ()
    interruptHandler env _ = do
      outputStrLn "Interrupted with CTRL+C\n\
                  \You can use the !exit command or CTRL+D to exit"
      loop env

    processInput :: Env -> String -> IO Env
    processInput env input = do
      let asts   = parseTricu input
          newEnv = evalTricu env asts
      if
        | Just r <- Map.lookup "!result" newEnv -> do
          putStrLn $ "tricu > " ++ decodeResult r
        | otherwise -> return ()
      return newEnv
    
    errorHandler :: Env -> SomeException -> IO (Env)
    errorHandler env e = do
      putStrLn $ "Error: " ++ show e
      return env
    
    strip :: String -> String
    strip = dropWhileEnd isSpace . dropWhile isSpace