diff --git a/.gitignore b/.gitignore index 6191459..8595428 100644 --- a/.gitignore +++ b/.gitignore @@ -12,3 +12,4 @@ ctags dist-newstyle result* .ghc.environment.* +.hnixrc diff --git a/README.md b/README.md index b3ca937..4a9b499 100644 --- a/README.md +++ b/README.md @@ -32,6 +32,23 @@ $ env NIXPKGS_TESTS=yes PRETTY_TESTS=1 cabal v2-test $ ./dist/build/hnix/hnix --help ``` +## Using the REPL + +To enter the `hnix` REPL use + +``` +hnix --repl +``` + +To evaluate an expression and make it available in the REPL +as the `input` variable use + +``` +hnix --eval -E '(import {}).pkgs.hello' --repl +``` + +Use the `:help` command for a list of all available REPL commands. + ## Building with full debug info To build `hnix` for debugging, and with full tracing output and stack traces, diff --git a/hnix.cabal b/hnix.cabal index 1a4a35b..03075da 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -958,7 +958,7 @@ executable hnix , pretty-show , prettyprinter , ref-tf - , repline + , repline >= 0.4.0.0 && < 0.5 , serialise , template-haskell , text diff --git a/main/Main.hs b/main/Main.hs index 50e90a7..05701c8 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -102,7 +102,12 @@ main = do @(StdThunk (StandardT (StdIdT IO))) frames - when (repl opts) $ withNixContext Nothing Repl.main + when (repl opts) $ + if evaluate opts + then do + val <- Nix.nixEvalExprLoc mpath expr + withNixContext Nothing (Repl.main' $ Just val) + else withNixContext Nothing Repl.main process opts mpath expr | evaluate opts diff --git a/main/Repl.hs b/main/Repl.hs index ed9b4b2..4834fcf 100644 --- a/main/Repl.hs +++ b/main/Repl.hs @@ -7,42 +7,38 @@ directory for more details. -} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -Wno-unused-matches #-} -{-# OPTIONS_GHC -Wno-unused-imports #-} - -module Repl where +module Repl + ( main + , main' + ) where import Nix hiding ( exec , try ) -import Nix.Cited -import Nix.Convert -import Nix.Eval import Nix.Scope -import qualified Nix.Type.Env as Env -import Nix.Type.Infer import Nix.Utils +import Nix.Value.Monad (demand) -import Control.Comonad -import qualified Data.HashMap.Lazy as M -import Data.List ( isPrefixOf - , foldl' - ) -import qualified Data.Map as Map -import Data.Text ( unpack - , pack - ) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text +import qualified Data.List +import qualified Data.Maybe +import qualified Data.HashMap.Lazy +import Data.Text (Text) +import qualified Data.Text +import qualified Data.Text.IO +import Data.Text.Prettyprint.Doc (Doc, (<+>)) +import qualified Data.Text.Prettyprint.Doc +import qualified Data.Text.Prettyprint.Doc.Render.Text import Data.Version ( showVersion ) import Paths_hnix ( version ) @@ -51,40 +47,131 @@ import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.State.Strict -import System.Console.Repline hiding ( options, prefix ) -import System.Environment -import System.Exit +import System.Console.Haskeline.Completion + ( Completion(isFinished) + , completeWordWithPrev + , simpleCompletion + , listFiles + ) +import System.Console.Repline ( Cmd + , CompletionFunc + , CompleterStyle (Prefix) + , ExitDecision(Exit) + , HaskelineT + ) +import qualified System.Console.Repline +import qualified System.Exit +import qualified System.IO.Error +-- | Repl entry point +main :: (MonadNix e t f m, MonadIO m, MonadMask m) => m () +main = main' Nothing -main :: (MonadNix e t f m, MonadIO m, MonadMask m) => m () -main = flip evalStateT initState - $ evalRepl (return prefix) cmd options (Just ':') completer welcomeText +-- | Principled version allowing to pass initial value for context. +-- +-- Passed value is stored in context with "input" key. +main' :: (MonadNix e t f m, MonadIO m, MonadMask m) => Maybe (NValue t f m) -> m () +main' iniVal = initState iniVal >>= \s -> flip evalStateT s + $ System.Console.Repline.evalRepl + banner + cmd + options + (Just commandPrefix) + (Just "paste") + completion + (rcFile >> greeter) + finalizer where - prefix = "hnix> " - welcomeText = + commandPrefix = ':' + + banner = pure . \case + System.Console.Repline.SingleLine -> "hnix> " + System.Console.Repline.MultiLine -> "| " + + greeter = liftIO $ putStrLn $ "Welcome to hnix " <> showVersion version <> ". For help type :help\n" + finalizer = do + liftIO $ putStrLn "Goodbye." + return Exit + + rcFile = do + f <- liftIO $ Data.Text.IO.readFile ".hnixrc" `catch` handleMissing + forM_ (map (words . Data.Text.unpack) $ Data.Text.lines f) $ \case + ((prefix:command) : xs) | prefix == commandPrefix -> do + let arguments = unwords xs + optMatcher command options arguments + x -> cmd $ unwords x + + handleMissing e + | System.IO.Error.isDoesNotExistError e = return "" + | otherwise = throwIO e + + -- Replicated and slightly adjusted `optMatcher` from `System.Console.Repline` + -- which doesn't export it. + -- * @MonadIO m@ instead of @MonadHaskeline m@ + -- * @putStrLn@ instead of @outputStrLn@ + optMatcher :: MonadIO m + => String + -> System.Console.Repline.Options m + -> String + -> m () + optMatcher s [] _ = liftIO $ putStrLn $ "No such command :" ++ s + optMatcher s ((x, m) : xs) args + | s `Data.List.isPrefixOf` x = m args + | otherwise = optMatcher s xs args ------------------------------------------------------------------------------- -- Types ------------------------------------------------------------------------------- -newtype IState t f m = IState - { tmctx :: AttrSet (NValue t f m) -- Value environment +data IState t f m = IState + { replIt :: Maybe NExprLoc -- ^ Last expression entered + , replCtx :: AttrSet (NValue t f m) -- ^ Value environment + , replCfg :: ReplConfig -- ^ REPL configuration + } deriving (Eq, Show) + +data ReplConfig = ReplConfig + { cfgDebug :: Bool + , cfgStrict :: Bool + , cfgValues :: Bool + } deriving (Eq, Show) + +defReplConfig :: ReplConfig +defReplConfig = ReplConfig + { cfgDebug = False + , cfgStrict = False + , cfgValues = False } -initState :: MonadIO m => IState t f m -initState = IState M.empty +-- | Create initial IState for REPL +initState :: MonadNix e t f m => Maybe (NValue t f m) -> m (IState t f m) +initState mIni = do + + builtins <- evalText "builtins" + + opts :: Nix.Options <- asks (view hasLens) + + pure $ IState + Nothing + (Data.HashMap.Lazy.fromList + $ ("builtins", builtins) : fmap ("input",) (Data.Maybe.maybeToList mIni)) + defReplConfig + { cfgStrict = strict opts + , cfgValues = values opts + } + where + evalText :: (MonadNix e t f m) => Text -> m (NValue t f m) + evalText expr = case parseNixTextLoc expr of + Failure e -> error $ "Impossible happened: Unable to parse expression - '" ++ (Data.Text.unpack expr) ++ "' error was " ++ show e + Success e -> do + value <- evalExprLoc e + pure value type Repl e t f m = HaskelineT (StateT (IState t f m) m) -hoistErr :: (MonadIO m, MonadThrow m) => Result a -> Repl e t f m a -hoistErr (Success val) = return val -hoistErr (Failure err) = do - liftIO $ print err - abort ------------------------------------------------------------------------------- -- Execution @@ -94,83 +181,141 @@ exec :: forall e t f m . (MonadNix e t f m, MonadIO m) => Bool - -> Text.Text - -> Repl e t f m (NValue t f m) + -> Text + -> Repl e t f m (Maybe (NValue t f m)) exec update source = do -- Get the current interpreter state - st <- get + st <- get - -- Parser ( returns AST ) - -- TODO: parse = - expr <- hoistErr $ parseNixTextLoc source + when (cfgDebug $ replCfg st) $ liftIO $ print st - -- Type Inference ( returns Typing Environment ) - -- tyctx' <- hoistErr $ inferTop (tyctx st) expr + -- Parser ( returns AST as `NExprLoc` ) + case parseExprOrBinding source of + (Failure err, _) -> do + liftIO $ print err + return Nothing + (Success expr, isBinding) -> do - -- TODO: track scope with (tmctx st) - mVal <- lift $ lift $ try $ pushScope M.empty (evalExprLoc expr) + -- Type Inference ( returns Typing Environment ) + -- + -- import qualified Nix.Type.Env as Env + -- import Nix.Type.Infer + -- + -- let tyctx' = inferTop Env.empty [("repl", stripAnnotation expr)] + -- liftIO $ print tyctx' - case mVal of - Left (NixException frames) -> do - lift $ lift $ liftIO . print =<< renderFrames @(NValue t f m) @t 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 + mVal <- lift $ lift $ try $ pushScope (replCtx st) (evalExprLoc expr) + case mVal of + Left (NixException frames) -> do + lift $ lift $ liftIO . print =<< renderFrames @(NValue t f m) @t frames + return Nothing + Right val -> do + -- Update the interpreter state + when (update && isBinding) $ do + -- Set `replIt` to last entered expression + put st { replIt = Just expr } + + -- If the result value is a set, update our context with it + case val of + NVSet xs _ -> put st { replCtx = Data.HashMap.Lazy.union xs (replCtx st) } + _ -> return () + + return $ Just val + where + -- If parsing fails, turn the input into singleton attribute set + -- and try again. + -- + -- This allows us to handle assignments like @a = 42@ + -- which get turned into @{ a = 42; }@ + parseExprOrBinding i = + case parseNixTextLoc i of + Success expr -> (Success expr, False) + Failure e -> + case parseNixTextLoc $ toAttrSet i of + Failure _ -> (Failure e, False) -- return the first parsing failure + Success e' -> (Success e', True) + + toAttrSet i = "{" <> i <> (if Data.Text.isSuffixOf ";" i then mempty else ";") <> "}" cmd :: (MonadNix e t f m, MonadIO m) => String -> Repl e t f m () cmd source = do - val <- exec True (Text.pack source) + mVal <- exec True (Data.Text.pack source) + case mVal of + Nothing -> return () + Just val -> printValue val + +printValue :: (MonadNix e t f m, MonadIO m) + => NValue t f m + -> Repl e t f m () +printValue val = do + cfg <- replCfg <$> get lift $ lift $ do - opts :: Nix.Options <- asks (view hasLens) if - | strict opts -> liftIO . print . prettyNValue =<< normalForm val - | values opts -> liftIO . print . prettyNValueProv =<< removeEffects val - | otherwise -> liftIO . print . prettyNValue =<< removeEffects val + | cfgStrict cfg -> liftIO . print . prettyNValue =<< normalForm val + | cfgValues cfg -> liftIO . print . prettyNValueProv =<< removeEffects val + | otherwise -> liftIO . print . prettyNValue =<< removeEffects val + ------------------------------------------------------------------------------- -- Commands ------------------------------------------------------------------------------- -- :browse command -browse :: MonadNix e t f m => [String] -> Repl e t f m () +browse :: (MonadNix e t f m, MonadIO m) + => String + -> Repl e t f m () browse _ = do st <- get - undefined - -- liftIO $ mapM_ putStrLn $ ppenv (tyctx st) + forM_ (Data.HashMap.Lazy.toList $ replCtx st) $ \(k, v) -> do + liftIO $ putStr $ Data.Text.unpack $ k <> " = " + printValue v -- :load command load :: (MonadNix e t f m, MonadIO m) - => [String] + => String -> Repl e t f m () load args = do - contents <- liftIO $ Text.readFile (unwords args) + contents <- liftIO + $ Data.Text.IO.readFile + $ Data.Text.unpack + $ Data.Text.strip + $ Data.Text.pack args void $ exec True contents -- :type command typeof :: (MonadNix e t f m, MonadIO m) - => [String] + => String -> Repl e t f m () typeof args = do - st <- get - val <- case M.lookup line (tmctx st) of - Just val -> return val - Nothing -> exec False line - str <- lift $ lift $ showValueType val - liftIO $ putStrLn str - where line = Text.pack (unwords args) + st <- get + mVal <- case Data.HashMap.Lazy.lookup line (replCtx st) of + Just val -> return $ Just val + Nothing -> do + exec False line + + forM_ mVal $ \val -> do + s <- lift . lift . showValueType $ val + liftIO $ putStrLn s + + where line = Data.Text.pack args -- :quit command quit :: (MonadNix e t f m, MonadIO m) => a -> Repl e t f m () -quit _ = liftIO exitSuccess +quit _ = liftIO System.Exit.exitSuccess + +-- :set command +setConfig :: (MonadNix e t f m, MonadIO m) => String -> Repl e t f m () +setConfig args = case words args of + [] -> liftIO $ putStrLn "No option to set specified" + (x:_xs) -> + case filter ((==x) . helpSetOptionName) helpSetOptions of + [opt] -> modify (\s -> s { replCfg = helpSetOptionFunction opt (replCfg s) }) + _ -> liftIO $ putStrLn "No such option" ------------------------------------------------------------------------------- -- Interactive Shell @@ -179,42 +324,218 @@ quit _ = liftIO exitSuccess -- Prefix tab completer defaultMatcher :: MonadIO m => [(String, CompletionFunc m)] defaultMatcher = - [(":load", fileCompleter) - --, (":type" , values) - ] + [ (":load", System.Console.Repline.fileCompleter) + ] --- Default tab completer -comp :: Monad m => WordCompleter m -comp n = do - let cmds = [":load", ":type", ":browse", ":quit"] - -- Env.TypeEnv ctx <- gets tyctx - -- let defs = map unpack $ Map.keys ctx - return $ filter (isPrefixOf n) (cmds {-++ defs-} - ) +completion + :: (MonadNix e t f m, MonadIO m) + => CompleterStyle (StateT (IState t f m) m) +completion = System.Console.Repline.Prefix + (completeWordWithPrev (Just '\\') separators completeFunc) + defaultMatcher + where + separators :: String + separators = " \t[(,=+*&|}#?>:" + +-- | Main completion function +-- +-- Heavily inspired by Dhall Repl, with `algebraicComplete` +-- adjusted to monadic variant able to `demand` thunks. +completeFunc + :: forall e t f m . (MonadNix e t f m, MonadIO m) + => String + -> String + -> (StateT (IState t f m) m) [Completion] +completeFunc reversedPrev word + -- Commands + | reversedPrev == ":" + = pure . listCompletion + $ map helpOptionName (helpOptions :: HelpOptions e t f m) + + -- Files + | any (`Data.List.isPrefixOf` word) [ "/", "./", "../", "~/" ] + = listFiles word + + -- Attributes of sets in REPL context + | var : subFields <- Data.Text.split (== '.') (Data.Text.pack word) + , not $ null subFields + = do + s <- get + case Data.HashMap.Lazy.lookup var (replCtx s) of + Nothing -> pure [] + Just binding -> do + candidates <- lift $ algebraicComplete subFields binding + pure + $ map notFinished + $ listCompletion (Data.Text.unpack . (var <>) <$> candidates) + + -- Builtins, context variables + | otherwise + = do + s <- get + let contextKeys = Data.HashMap.Lazy.keys (replCtx s) + (Just (NVSet builtins _)) = Data.HashMap.Lazy.lookup "builtins" (replCtx s) + shortBuiltins = Data.HashMap.Lazy.keys builtins + + pure $ listCompletion + $ ["__includes"] + ++ (Data.Text.unpack <$> contextKeys) + ++ (Data.Text.unpack <$> shortBuiltins) + + where + listCompletion = map simpleCompletion . filter (word `Data.List.isPrefixOf`) + + notFinished x = x { isFinished = False } + + algebraicComplete :: (MonadNix e t f m) + => [Text] + -> NValue t f m + -> m [Text] + algebraicComplete subFields val = + let keys = fmap ("." <>) . Data.HashMap.Lazy.keys + withMap m = + case subFields of + [] -> pure $ keys m + -- Stop on last subField (we care about the keys at this level) + [_] -> pure $ keys m + f:fs -> + case Data.HashMap.Lazy.lookup f m of + Nothing -> pure [] + Just e -> + (demand e) + (\e' -> fmap (("." <> f) <>) <$> algebraicComplete fs e') + + in case val of + NVSet xs _ -> withMap xs + _ -> pure [] + +-- HelpOption inspired by Dhall Repl +-- with `Doc` instead of String for syntax and doc +data HelpOption e t f m = HelpOption + { helpOptionName :: String + , helpOptionSyntax :: Doc () + , helpOptionDoc :: Doc () + , helpOptionFunction :: Cmd (Repl e t f m) + } + +type HelpOptions e t f m = [HelpOption e t f m] + +helpOptions :: (MonadNix e t f m, MonadIO m) => HelpOptions e t f m +helpOptions = + [ HelpOption + "help" + "" + "Print help text" + (help helpOptions) + , HelpOption + "paste" + "" + "Enter multi-line mode" + (error "Unreachable") + , HelpOption + "load" + "FILENAME" + "Load .nix file into scope" + load + , HelpOption + "browse" + "" + "Browse bindings in interpreter context" + browse + , HelpOption + "type" + "EXPRESSION" + "Evaluate expression or binding from context and print the type of the result value" + typeof + , HelpOption + "quit" + "" + "Quit interpreter" + quit + , HelpOption + "set" + "" + ( "Set REPL option" + <> Data.Text.Prettyprint.Doc.line + <> "Available options:" + <> Data.Text.Prettyprint.Doc.line + <> (renderSetOptions helpSetOptions) + ) + setConfig + ] + +-- Options for :set +data HelpSetOption = HelpSetOption + { helpSetOptionName :: String + , helpSetOptionSyntax :: Doc () + , helpSetOptionDoc :: Doc () + , helpSetOptionFunction :: ReplConfig -> ReplConfig + } + +helpSetOptions :: [HelpSetOption] +helpSetOptions = + [ HelpSetOption + "strict" + "" + "Enable strict evaluation of REPL expressions" + (\x -> x { cfgStrict = True}) + , HelpSetOption + "lazy" + "" + "Disable strict evaluation of REPL expressions" + (\x -> x { cfgStrict = False}) + , HelpSetOption + "values" + "" + "Enable printing of value provenance information" + (\x -> x { cfgValues = True}) + , HelpSetOption + "novalues" + "" + "Disable printing of value provenance information" + (\x -> x { cfgValues = False}) + , HelpSetOption + "debug" + "" + "Enable printing of REPL debug information" + (\x -> x { cfgDebug = True}) + , HelpSetOption + "nodebug" + "" + "Disable REPL debugging" + (\x -> x { cfgDebug = False}) + ] + +renderSetOptions :: [HelpSetOption] -> Doc () +renderSetOptions so = + Data.Text.Prettyprint.Doc.indent 4 + $ Data.Text.Prettyprint.Doc.vsep + $ flip map so + $ \h -> + Data.Text.Prettyprint.Doc.pretty (helpSetOptionName h) + <+> helpSetOptionSyntax h + <> Data.Text.Prettyprint.Doc.line + <> Data.Text.Prettyprint.Doc.indent 4 (helpSetOptionDoc h) + +help :: (MonadNix e t f m, MonadIO m) + => HelpOptions e t f m + -> String + -> Repl e t f m () +help hs _ = do + liftIO $ putStrLn "Available commands:\n" + forM_ hs $ \h -> + liftIO + . Data.Text.IO.putStrLn + . Data.Text.Prettyprint.Doc.Render.Text.renderStrict + . Data.Text.Prettyprint.Doc.layoutPretty + Data.Text.Prettyprint.Doc.defaultLayoutOptions + $ ":" + <> Data.Text.Prettyprint.Doc.pretty (helpOptionName h) + <+> helpOptionSyntax h + <> Data.Text.Prettyprint.Doc.line + <> Data.Text.Prettyprint.Doc.indent 4 (helpOptionDoc h) options :: (MonadNix e t f m, MonadIO m) - => [(String, [String] -> Repl e t f m ())] -options = - [ ( "load" - , load - ) - --, ("browse" , browse) - , ("quit", quit) - , ("type", typeof) - , ("help", help) - ] - -help - :: forall e t f m - . (MonadNix e t f m, MonadIO m) - => [String] - -> Repl e t f m () -help _ = liftIO $ do - putStrLn "Available commands:\n" - mapM_ putStrLn $ map (\o -> ":" ++ (fst o)) (options @e @t @f @m) - -completer - :: (MonadNix e t f m, MonadIO m) - => CompleterStyle (StateT (IState t f m) m) -completer = Prefix (wordCompleter comp) defaultMatcher + => System.Console.Repline.Options (Repl e t f m) +options = (\h -> (helpOptionName h, helpOptionFunction h)) <$> helpOptions