Merge pull request #658 from sorki/fix/repline_0_4

Epic Support repline 0.4

.gitignore

@@ -12,3 +12,4 @@ ctags
 dist-newstyle
 result*
 .ghc.environment.*
+.hnixrc

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 <nixpkgs> {}).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,

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

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

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 #-}
+module Repl
-{-# OPTIONS_GHC -Wno-unused-imports #-}
+  ( main
-
+  , main'
-module Repl where
+  ) 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.List
-import qualified Data.HashMap.Lazy             as M
+import qualified Data.Maybe
-import           Data.List                      ( isPrefixOf
+import qualified Data.HashMap.Lazy
-                                                , foldl'
+import           Data.Text                      (Text)
-                                                )
+import qualified Data.Text
-import qualified Data.Map                      as Map
+import qualified Data.Text.IO
-import           Data.Text                      ( unpack
+import           Data.Text.Prettyprint.Doc      (Doc, (<+>))
-                                                , pack
+import qualified Data.Text.Prettyprint.Doc
-                                                )
+import qualified Data.Text.Prettyprint.Doc.Render.Text
-import qualified Data.Text                     as Text
-import qualified Data.Text.IO                  as 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.Console.Haskeline.Completion
-import           System.Environment
+                                                ( Completion(isFinished)
-import           System.Exit
+                                                , 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 = flip evalStateT initState
+main = main' Nothing
-    $ 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> "
+  commandPrefix = ':'
-  welcomeText =
+
+  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
+data IState t f m = IState
-  { tmctx :: AttrSet (NValue t f m)  -- Value environment
+  { 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
+-- | Create initial IState for REPL
-initState = IState M.empty
+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
+  -> Text
-  -> Repl e t f m (NValue t f m)
+  -> Repl e t f m (Maybe (NValue t f m))
 exec update source = do
   -- Get the current interpreter state
   st <- get
 
-  -- Parser ( returns AST )
+  when (cfgDebug $ replCfg st) $ liftIO $ print st
-  -- TODO: parse <var> = <expr>
+
-  expr <- hoistErr $ parseNixTextLoc source
+  -- Parser ( returns AST as `NExprLoc` )
+  case parseExprOrBinding source of
+    (Failure err, _) -> do
+      liftIO $ print err
+      return Nothing
+    (Success expr, isBinding) -> do
 
       -- Type Inference ( returns Typing Environment )
-  -- tyctx' <- hoistErr $ inferTop (tyctx st) expr
+      --
+      -- import qualified Nix.Type.Env                  as Env
+      -- import           Nix.Type.Infer
+      --
+      -- let tyctx' = inferTop Env.empty [("repl", stripAnnotation expr)]
+      -- liftIO $ print tyctx'
 
-  -- TODO: track scope with (tmctx st)
+      mVal <- lift $ lift $ try $ pushScope (replCtx st) (evalExprLoc expr)
-  mVal <- lift $ lift $ try $ pushScope M.empty (evalExprLoc expr)
 
       case mVal of
         Left (NixException frames) -> do
           lift $ lift $ liftIO . print =<< renderFrames @(NValue t f m) @t frames
-      abort
+          return Nothing
         Right val -> do
           -- Update the interpreter state
-      when update $ do
+          when (update && isBinding) $ do
-        -- Create the new environment
+            -- Set `replIt` to last entered expression
-        put st { tmctx = tmctx st } -- TODO: M.insert key val (tmctx st)
+            put st { replIt = Just expr }
-      return val
 
+            -- 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
+      | cfgStrict cfg -> liftIO . print . prettyNValue =<< normalForm val
-      | values opts -> liftIO . print . prettyNValueProv =<< removeEffects 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
+  forM_ (Data.HashMap.Lazy.toList $ replCtx st) $ \(k, v) -> do
-  -- liftIO $ mapM_ putStrLn $ ppenv (tyctx st)
+    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
+  mVal <- case Data.HashMap.Lazy.lookup line (replCtx st) of
-    Just val -> return val
+    Just val -> return $ Just val
-    Nothing  -> exec False line
+    Nothing  -> do
-  str <- lift $ lift $ showValueType val
+      exec False line
-  liftIO $ putStrLn str
+
-  where line = Text.pack (unwords args)
+  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)
+  [ (":load", System.Console.Repline.fileCompleter)
-  --, (":type"  , values)
   ]
 
--- Default tab completer
+completion
-comp :: Monad m => WordCompleter m
+  :: (MonadNix e t f m, MonadIO m)
-comp n = do
+  => CompleterStyle (StateT (IState t f m) m)
-  let cmds = [":load", ":type", ":browse", ":quit"]
+completion = System.Console.Repline.Prefix
-  -- Env.TypeEnv ctx <- gets tyctx
+  (completeWordWithPrev (Just '\\') separators completeFunc)
-  -- let defs = map unpack $ Map.keys ctx
+  defaultMatcher
-  return $ filter (isPrefixOf n) (cmds {-++ defs-}
+  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 ())]
+  => System.Console.Repline.Options (Repl e t f m)
-options =
+options = (\h -> (helpOptionName h, helpOptionFunction h)) <$> helpOptions
-  [ ( "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