add typeof to repl
This commit is contained in:
parent
2e4e5e0077
commit
0c9aef937b
77
main/Repl.hs
77
main/Repl.hs
|
@ -22,7 +22,7 @@
|
|||
|
||||
module Repl where
|
||||
|
||||
import Nix hiding (exec)
|
||||
import Nix hiding (exec, try)
|
||||
import Nix.Convert
|
||||
import Nix.Eval
|
||||
import Nix.Scope
|
||||
|
@ -38,6 +38,7 @@ import Data.Text (unpack, pack)
|
|||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.IO as Text
|
||||
|
||||
import Control.Monad.Catch
|
||||
import Control.Monad.Identity
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State.Strict
|
||||
|
@ -51,18 +52,14 @@ import System.Exit
|
|||
-- Types
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
data TermEnv
|
||||
|
||||
data IState = IState
|
||||
{ -- tyctx :: Env.Env -- Type environment
|
||||
-- ,
|
||||
tmctx :: TermEnv -- Value environment
|
||||
newtype IState m = IState
|
||||
{ tmctx :: AttrSet (NValue m) -- Value environment
|
||||
}
|
||||
|
||||
initState :: IState
|
||||
initState = IState {-Env.empty-} undefined
|
||||
initState :: MonadIO m => IState m
|
||||
initState = IState M.empty
|
||||
|
||||
type Repl e m a = HaskelineT (StateT IState m) a
|
||||
type Repl e m = HaskelineT (StateT (IState m) m)
|
||||
hoistErr :: MonadIO m => Result a -> Repl e m a
|
||||
hoistErr (Success val) = return val
|
||||
hoistErr (Failure err) = do
|
||||
|
@ -74,35 +71,38 @@ hoistErr (Failure err) = do
|
|||
-------------------------------------------------------------------------------
|
||||
|
||||
exec :: forall e m. (MonadNix e m, MonadIO m, MonadException m)
|
||||
=> Bool -> Text.Text -> Repl e m ()
|
||||
=> Bool -> Text.Text -> Repl e m (NValue m)
|
||||
exec update source = do
|
||||
-- Get the current interpreter state
|
||||
st <- get
|
||||
|
||||
-- Parser ( returns AST )
|
||||
-- TODO: parse <var> = <expr>
|
||||
expr <- hoistErr $ parseNixTextLoc source
|
||||
|
||||
-- Type Inference ( returns Typing Environment )
|
||||
-- tyctx' <- hoistErr $ inferTop (tyctx st) expr
|
||||
|
||||
-- Create the new environment
|
||||
let st' = st { tmctx = tmctx st -- foldl' evalDef (tmctx st) expr
|
||||
-- , tyctx = tyctx' <> tyctx st
|
||||
-- TODO: track scope with (tmctx st)
|
||||
mVal <- lift $ lift $ try $ pushScope @(NThunk m) M.empty (evalExprLoc expr)
|
||||
|
||||
case mVal of
|
||||
Left (NixException frames) -> do
|
||||
lift $ lift $ liftIO . print =<< renderFrames @(NThunk m) frames
|
||||
abort
|
||||
Right val -> do
|
||||
-- Update the interpreter state
|
||||
when update $ do
|
||||
-- Create the new environment
|
||||
put st { tmctx = tmctx st -- TODO: M.insert key val (tmctx st)
|
||||
}
|
||||
return val
|
||||
|
||||
-- Update the interpreter state
|
||||
when update (put st')
|
||||
|
||||
-- If a value is entered, print it.
|
||||
cmd :: (MonadNix e m, MonadIO m, MonadException m) => String -> Repl e m ()
|
||||
cmd source = do
|
||||
val <- exec True (Text.pack source)
|
||||
lift $ lift $ do
|
||||
-- jww (2018-04-12): Once the user is able to establish definitions in
|
||||
-- the repl, they should be passed here.
|
||||
pushScope @(NThunk m) M.empty $ catch (go expr) $ \case
|
||||
NixException frames -> do
|
||||
liftIO . print =<< renderFrames @(NThunk m) frames
|
||||
where
|
||||
go expr = do
|
||||
val <- evalExprLoc expr
|
||||
opts :: Nix.Options <- asks (view hasLens)
|
||||
if | strict opts ->
|
||||
liftIO . print . prettyNValueNF =<< normalForm val
|
||||
|
@ -110,10 +110,6 @@ exec update source = do
|
|||
liftIO . print =<< prettyNValueProv val
|
||||
| otherwise ->
|
||||
liftIO . print =<< prettyNValue val
|
||||
|
||||
cmd :: (MonadNix e m, MonadIO m, MonadException m) => String -> Repl e m ()
|
||||
cmd source = exec True (Text.pack source)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Commands
|
||||
-------------------------------------------------------------------------------
|
||||
|
@ -129,16 +125,17 @@ browse _ = do
|
|||
load :: (MonadNix e m, MonadIO m, MonadException m) => [String] -> Repl e m ()
|
||||
load args = do
|
||||
contents <- liftIO $ Text.readFile (unwords args)
|
||||
exec True contents
|
||||
void $ exec True contents
|
||||
|
||||
-- :type command
|
||||
-- typeof :: [String] -> Repl e m ()
|
||||
-- typeof args = do
|
||||
-- st <- get
|
||||
-- let arg = unwords args
|
||||
-- case Env.lookup (pack arg) (tyctx st) of
|
||||
-- Just val -> liftIO $ putStrLn $ undefined -- ppsignature (arg, val)
|
||||
-- Nothing -> exec False (Text.pack arg)
|
||||
typeof :: (MonadNix e m, MonadException m, MonadIO m) => [String] -> Repl e m ()
|
||||
typeof args = do
|
||||
st <- get
|
||||
let arg = unwords args
|
||||
val <- case M.lookup (Text.pack arg) (tmctx st) of
|
||||
Just val -> return val
|
||||
Nothing -> exec False (Text.pack arg)
|
||||
liftIO $ putStrLn $ describeValue $ valueType (_baseValue val)
|
||||
|
||||
-- :quit command
|
||||
quit :: (MonadNix e m, MonadIO m) => a -> Repl e m ()
|
||||
|
@ -156,7 +153,7 @@ defaultMatcher = [
|
|||
]
|
||||
|
||||
-- Default tab completer
|
||||
comp :: (Monad m, MonadState IState m) => WordCompleter m
|
||||
comp :: Monad m => WordCompleter m
|
||||
comp n = do
|
||||
let cmds = [":load", ":type", ":browse", ":quit"]
|
||||
-- Env.TypeEnv ctx <- gets tyctx
|
||||
|
@ -169,14 +166,14 @@ options = [
|
|||
("load" , load)
|
||||
, ("browse" , browse)
|
||||
, ("quit" , quit)
|
||||
-- , ("type" , Repl.typeof)
|
||||
, ("type" , typeof)
|
||||
]
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Entry Point
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
completer :: (MonadNix e m, MonadIO m) => CompleterStyle (StateT IState m)
|
||||
completer :: (MonadNix e m, MonadIO m) => CompleterStyle (StateT (IState m) m)
|
||||
completer = Prefix (wordCompleter comp) defaultMatcher
|
||||
|
||||
shell :: (MonadNix e m, MonadIO m, MonadException m) => Repl e m a -> m ()
|
||||
|
|
Loading…
Reference in New Issue