79 lines
3.1 KiB
Haskell
79 lines
3.1 KiB
Haskell
module Repl (repl, showEnvEntry) where
|
|
|
|
import Check (findType)
|
|
import Data.List (stripPrefix)
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Text (pack)
|
|
import Errors (Result)
|
|
import Eval
|
|
import Expr
|
|
import Parser
|
|
import System.Console.Haskeline
|
|
import System.Directory (createDirectoryIfMissing, getHomeDirectory)
|
|
import System.FilePath ((</>))
|
|
|
|
data ReplCommand
|
|
= Quit
|
|
| DumpEnv
|
|
| TypeQuery String
|
|
| ValueQuery String
|
|
| Normalize String
|
|
| WeakNormalize String
|
|
| Input String
|
|
| LoadFile 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 = TypeQuery <$> stripPrefix ":t " input
|
|
| ":v " `isPrefixOf` input = ValueQuery <$> stripPrefix ":v " input
|
|
| ":n " `isPrefixOf` input = Normalize <$> stripPrefix ":n " input
|
|
| ":w " `isPrefixOf` input = WeakNormalize <$> stripPrefix ":w " input
|
|
| ":l " `isPrefixOf` input = LoadFile <$> stripPrefix ":l " input
|
|
| otherwise = Just $ Input input
|
|
|
|
handleInput :: Env -> String -> InputT IO Env
|
|
handleInput env input =
|
|
let (res, env') = parseDefEmpty env (pack input)
|
|
in case res of
|
|
Left err -> outputStrLn err >> pure env'
|
|
Right () -> pure env'
|
|
|
|
actOnParse :: Env -> String -> (Expr -> InputT IO ()) -> InputT IO ()
|
|
actOnParse env input action = case parseExpr env (pack input) of
|
|
Left err -> outputStrLn err
|
|
Right expr -> action expr
|
|
|
|
printErrorOrResult :: Env -> (Expr -> ReaderT Env Result Expr) -> Expr -> InputT IO ()
|
|
printErrorOrResult env action expr = putTextLn $ either toText pretty $ runReaderT (action expr) env
|
|
|
|
parseActPrint :: Env -> String -> (Expr -> ReaderT Env Result Expr) -> InputT IO ()
|
|
parseActPrint env input action = actOnParse env input (printErrorOrResult env action)
|
|
|
|
lookupAct :: Env -> String -> (Definition -> InputT IO ()) -> InputT IO ()
|
|
lookupAct env input action = maybe (outputStrLn $ "'" ++ input ++ "' unbound") action $ M.lookup (pack input) env
|
|
|
|
repl :: IO Env
|
|
repl = do
|
|
home <- getHomeDirectory
|
|
let basepath = home </> ".cache" </> "perga"
|
|
let filepath = basepath </> "history"
|
|
createDirectoryIfMissing True basepath
|
|
runInputT (defaultSettings{historyFile = Just filepath}) (loop M.empty)
|
|
where
|
|
loop :: Env -> InputT IO Env
|
|
loop env = do
|
|
minput <- getInputLine "> "
|
|
case parseCommand minput of
|
|
Nothing -> pure env
|
|
Just Quit -> pure env
|
|
Just DumpEnv -> lift (dumpEnv env) >> loop env
|
|
Just (TypeQuery input) -> parseActPrint env input (findType []) >> loop env
|
|
Just (ValueQuery input) -> lookupAct env input (putTextLn . pretty . _val) >> loop env
|
|
Just (Normalize input) -> parseActPrint env input normalize >> loop env
|
|
Just (WeakNormalize input) -> parseActPrint env input whnf >> loop env
|
|
Just (LoadFile filename) -> lift (runExceptT $ handleFile env filename) >>= either ((>> loop env) . outputStrLn) loop
|
|
Just (Input input) -> handleInput env input >>= loop
|