70 lines
2.5 KiB
Haskell
70 lines
2.5 KiB
Haskell
module Repl (repl, showEnvEntry) where
|
|
|
|
import Control.Monad.Reader
|
|
import Data.Functor (void)
|
|
import Data.List (isPrefixOf, stripPrefix)
|
|
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 | Normalize 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 = TypeQuery <$> stripPrefix ":t " input
|
|
| ":n " `isPrefixOf` input = Normalize <$> stripPrefix ":n " input
|
|
| otherwise = Just $ Input input
|
|
|
|
showEnvEntry :: T.Text -> EnvLine -> String
|
|
showEnvEntry k EL{_ty = t} = T.unpack k ++ " : " ++ prettyS t
|
|
|
|
dumpEnv :: Env -> InputT IO ()
|
|
dumpEnv = void . M.traverseWithKey ((outputStrLn .) . showEnvEntry)
|
|
|
|
handleInput :: Env -> String -> InputT IO Env
|
|
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 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 -> dumpEnv env >> loop env
|
|
Just (TypeQuery input) ->
|
|
( case M.lookup (T.pack input) env of
|
|
Nothing -> outputStrLn (input ++ " unbound")
|
|
Just (EL{_ty = t}) -> outputStrLn $ prettyS t
|
|
)
|
|
>> loop env
|
|
Just (Normalize input) ->
|
|
( case parseExpr env (T.pack input) of
|
|
Left err -> outputStrLn err
|
|
Right expr -> case runReaderT (normalize expr) env of
|
|
Left err -> outputStrLn $ show err
|
|
Right result -> outputStrLn $ prettyS result
|
|
)
|
|
>> loop env
|
|
Just (Input input) -> do
|
|
env' <- handleInput env input
|
|
loop env'
|