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
                              , isPrefixOf)
import System.Console.Haskeline

import qualified Data.Map as Map

repl :: Env -> IO ()
repl env = runInputT defaultSettings (withInterrupt (loop env True))
  where
    loop :: Env -> Bool -> InputT IO ()
    loop env decode = handle (interruptHandler env decode) $ do
      minput <- getInputLine "tricu < "
      case minput of
        Nothing -> outputStrLn "Exiting tricu"
        Just s
          | strip s == "" -> loop env decode
          | strip s == "!exit" -> outputStrLn "Exiting tricu"
          | strip s == "!decode" -> do
              outputStrLn $ "Decoding " ++ (if decode then "disabled" else "enabled")
              loop env (not decode)
          | "!import" `isPrefixOf` strip s -> do
              let afterImport = dropWhile (== ' ') $ drop (length ("!import" :: String)) (strip s)
              if not (null afterImport)
                then outputStrLn "Warning: REPL imports are interactive; \
                                  \additional arguments are ignored."
                else pure ()
              path <- getInputLine "File path to load < "
              case path of
                Nothing -> do
                  outputStrLn "No input received; stopping import."
                  loop env decode
                Just p -> do
                  loadedEnv <- liftIO $ evaluateFileWithContext env
                    (strip p) `catch` \e -> errorHandler env e
                  loop (Map.delete "!result" (Map.union loadedEnv env)) decode
          | take 2 s == "--" -> loop env decode
          | otherwise -> do
              newEnv <- liftIO $ processInput env s decode `catch` errorHandler env
              loop newEnv decode

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

    processInput :: Env -> String -> Bool -> IO Env
    processInput env input decode = do
      let asts   = parseTricu input
          newEnv = evalTricu env asts
      case Map.lookup "!result" newEnv of
        Just r -> do
          putStrLn $ "tricu > " ++ 
            if decode 
              then decodeResult r
              else show r
        Nothing -> pure ()
      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