module Repl (repl, showEnvEntry) where import Data.Functor (void) import Data.List (isPrefixOf) import qualified Data.Map as M import qualified Data.Text as T import Eval import Expr import Parser import System.Console.Haskeline import System.Directory (createDirectoryIfMissing, getHomeDirectory) import System.FilePath (()) data ReplCommand = Quit | DumpEnv | TypeQuery String | Input String deriving (Show) parseCommand :: Maybe String -> Maybe ReplCommand parseCommand Nothing = Nothing parseCommand (Just ":q") = Just Quit parseCommand (Just ":e") = Just DumpEnv parseCommand (Just input) | ":t" `isPrefixOf` input = case words input of [":t", rest] -> Just $ TypeQuery rest _ -> Nothing | otherwise = Just $ Input input showEnvEntry :: T.Text -> Expr -> String showEnvEntry k v = T.unpack k ++ " : " ++ prettyS v dumpEnv :: Env -> InputT IO () dumpEnv = void . M.traverseWithKey ((outputStrLn .) . showEnvEntry) handleInput :: GlobalState -> String -> InputT IO GlobalState handleInput env input = let (res, env') = parseDefEmpty env (T.pack input) in case res of Left err -> outputStrLn err >> pure env' Right () -> pure env' repl :: IO GlobalState repl = do home <- getHomeDirectory let basepath = home ".cache" "perga" let filepath = basepath "history" createDirectoryIfMissing True basepath runInputT (defaultSettings{historyFile = Just filepath}) (loop GS{_defs = M.empty, _types = M.empty}) where loop :: GlobalState -> InputT IO GlobalState loop env = do minput <- getInputLine "> " case parseCommand minput of Nothing -> pure env Just Quit -> pure env Just DumpEnv -> dumpEnv (_types env) >> loop env Just (TypeQuery input) -> ( case M.lookup (T.pack input) (_types env) of Nothing -> outputStrLn (input ++ " unbound") Just expr -> outputStrLn $ prettyS expr ) >> loop env Just (Input input) -> do env' <- handleInput env input loop env'