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 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 (loop env)
  where
    loop :: Env -> InputT IO ()
    loop env = do
      minput <- getInputLine "tricu < "
      case minput of
        Nothing -> outputStrLn "Exiting tricu"
        Just s -> case strip s of 
          "!exit" -> outputStrLn "Exiting tricu"
          "!load" -> do
            path <- getInputLine "File path to load < "
            case path of
              Nothing -> do
                outputStrLn "No input received; stopping import."
                loop env
              Just path -> do
                loadedEnv <- liftIO $ evaluateFileWithContext env (strip path)
                loop $ Map.delete "__result" (Map.union loadedEnv env)
          "" -> do
            outputStrLn ""
            loop env
          input -> do
            case (take 2 input) of 
              "--" -> loop env
              _ -> do
                newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
                loop newEnv
  
    processInput :: Env -> String -> IO Env
    processInput env input = do
      let asts = parseTricu input
          newEnv = evalTricu env asts
      case Map.lookup "__result" newEnv of
        Just r -> do
          putStrLn $ "tricu > " ++ decodeResult r
        Nothing -> 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

decodeResult :: T -> String
decodeResult tc = case toNumber tc of
  Right num -> show num
  Left _ -> case toString tc of
    Right str -> "\"" ++ str ++ "\""
    Left _ -> formatResult TreeCalculus tc