Now down to Main.hs and the tests

hnix.cabal

@@ -574,6 +574,7 @@ executable hnix
       aeson
     , base >=4.9 && <5
     , bytestring
+    , comonad
     , containers
     , data-fix
     , deepseq >=1.4.2 && <1.5

main/Repl.hs

@@ -23,6 +23,8 @@
 module Repl where
 
 import           Nix hiding (exec, try)
+import           Nix.Builtins (MonadBuiltins)
+import           Nix.Cited
 import           Nix.Convert
 import           Nix.Eval
 import           Nix.Scope
@@ -30,6 +32,7 @@ import qualified Nix.Type.Env as Env
 import           Nix.Type.Infer
 import           Nix.Utils
 
+import           Control.Comonad
 import qualified Data.HashMap.Lazy as M
 import           Data.List (isPrefixOf, foldl')
 import qualified Data.Map as Map
@@ -51,7 +54,7 @@ import           System.Environment
 import           System.Exit
 
 
-main :: (MonadNix e m, MonadIO m, MonadException m) => m ()
+main :: (MonadBuiltins e t f m, MonadIO m, MonadException m) => m ()
 main = flip evalStateT initState $
 #if MIN_VERSION_repline(0, 2, 0)
     evalRepl (return prefix) cmd options (Just ':') completer welcomeText
@@ -66,15 +69,15 @@ main = flip evalStateT initState $
 -- Types
 -------------------------------------------------------------------------------
 
-newtype IState m = IState
+newtype IState t f m = IState
-  { tmctx :: AttrSet (NValue m)  -- Value environment
+  { tmctx :: AttrSet (NValue t f m)  -- Value environment
   }
 
-initState :: MonadIO m => IState m
+initState :: MonadIO m => IState t f m
 initState = IState M.empty
 
-type Repl e m = HaskelineT (StateT (IState m) m)
+type Repl e t f m = HaskelineT (StateT (IState t f m) m)
-hoistErr :: MonadIO m => Result a -> Repl e m a
+hoistErr :: MonadIO m => Result a -> Repl e t f m a
 hoistErr (Success val) = return val
 hoistErr (Failure err) = do
   liftIO $ print err
@@ -84,8 +87,8 @@ hoistErr (Failure err) = do
 -- Execution
 -------------------------------------------------------------------------------
 
-exec :: forall e m. (MonadNix e m, MonadIO m, MonadException m)
+exec :: forall e t f m. (MonadBuiltins e t f m, MonadIO m, MonadException m)
-     => Bool -> Text.Text -> Repl e m (NValue m)
+     => Bool -> Text.Text -> Repl e t f m (NValue t f m)
 exec update source = do
   -- Get the current interpreter state
   st <- get
@@ -98,11 +101,12 @@ exec update source = do
   -- tyctx' <- hoistErr $ inferTop (tyctx st) expr
 
   -- TODO: track scope with (tmctx st)
-  mVal <- lift $ lift $ try $ pushScope @(NThunk m) M.empty (evalExprLoc expr)
+  mVal <- lift $ lift $ try $ pushScope @t M.empty (evalExprLoc expr)
 
   case mVal of
     Left (NixException frames) -> do
-      lift $ lift $ liftIO . print =<< renderFrames @(NThunk m) frames
+      lift $ lift $ liftIO . print
+        =<< renderFrames @(NValue t f m) @t frames
       abort
     Right val -> do
       -- Update the interpreter state
@@ -113,7 +117,7 @@ exec update source = do
       return val
 
 
-cmd :: (MonadNix e m, MonadIO m, MonadException m) => String -> Repl e m ()
+cmd :: (MonadBuiltins e t f m, MonadIO m, MonadException m) => String -> Repl e t f m ()
 cmd source = do
   val <- exec True (Text.pack source)
   lift $ lift $ do
@@ -129,31 +133,31 @@ cmd source = do
 -------------------------------------------------------------------------------
 
 -- :browse command
-browse :: MonadNix e m => [String] -> Repl e m ()
+browse :: MonadBuiltins e t f m => [String] -> Repl e t f m ()
 browse _ = do
   st <- get
   undefined
   -- liftIO $ mapM_ putStrLn $ ppenv (tyctx st)
 
 -- :load command
-load :: (MonadNix e m, MonadIO m, MonadException m) => [String] -> Repl e m ()
+load :: (MonadBuiltins e t f m, MonadIO m, MonadException m) => [String] -> Repl e t f m ()
 load args = do
   contents <- liftIO $ Text.readFile (unwords args)
   void $ exec True contents
 
 -- :type command
-typeof :: (MonadNix e m, MonadException m, MonadIO m) => [String] -> Repl e m ()
+typeof :: (MonadBuiltins e t f m, MonadException m, MonadIO m) => [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
-  liftIO $ putStrLn $ describeValue . valueType . _cited . _nValue $ val
+  liftIO $ putStrLn $ describeValue . valueType . extract . _nValue $ val
   where
     line = Text.pack (unwords args)
 
 -- :quit command
-quit :: (MonadNix e m, MonadIO m) => a -> Repl e m ()
+quit :: (MonadBuiltins e t f m, MonadIO m) => a -> Repl e t f m ()
 quit _ = liftIO exitSuccess
 
 -------------------------------------------------------------------------------
@@ -175,8 +179,8 @@ comp n = do
   -- let defs = map unpack $ Map.keys ctx
   return $ filter (isPrefixOf n) (cmds {-++ defs-})
 
-options :: (MonadNix e m, MonadIO m, MonadException m)
+options :: (MonadBuiltins e t f m, MonadIO m, MonadException m)
-        => [(String, [String] -> Repl e m ())]
+        => [(String, [String] -> Repl e t f m ())]
 options = [
     ("load"   , load)
   --, ("browse" , browse)
@@ -185,11 +189,12 @@ options = [
   , ("help"   , help)
   ]
 
-help :: forall e m . (MonadNix e m, MonadIO m, MonadException m)
+help :: forall e t f m . (MonadBuiltins e t f m, MonadIO m, MonadException m)
-     => [String] -> Repl e m ()
+     => [String] -> Repl e t f m ()
 help _ = liftIO $ do
   putStrLn "Available commands:\n"
-  mapM_ putStrLn $ map (\o -> ":" ++ (fst o)) (options @e @m)
+  mapM_ putStrLn $ map (\o -> ":" ++ (fst o)) (options @e @t @f @m)
 
-completer :: (MonadNix e m, MonadIO m) => CompleterStyle (StateT (IState m) m)
+completer :: (MonadBuiltins e t f m, MonadIO m)
+          => CompleterStyle (StateT (IState t f m) m)
 completer = Prefix (wordCompleter comp) defaultMatcher

src/Nix.hs

@@ -24,7 +24,6 @@ module Nix (module Nix.Cache,
 
 import           Control.Applicative
 import           Control.Arrow (second)
-import           Control.Monad.Free
 import           Control.Monad.Reader
 import           Data.Fix
 import qualified Data.HashMap.Lazy as M
@@ -51,20 +50,20 @@ import           Nix.XML
 -- | This is the entry point for all evaluations, whatever the expression tree
 --   type. It sets up the common Nix environment and applies the
 --   transformations, allowing them to be easily composed.
-nixEval :: (MonadNix e m, Has e Options, Functor f)
+nixEval :: (MonadBuiltins e t f m, Has e Options, Functor g)
-        => Maybe FilePath -> Transform f (m a) -> Alg f (m a) -> Fix f -> m a
+    => Maybe FilePath -> Transform g (m a) -> Alg g (m a) -> Fix g -> m a
 nixEval mpath xform alg = withNixContext mpath . adi alg xform
 
 -- | Evaluate a nix expression in the default context
-nixEvalExpr :: forall e m. (MonadNix e m, Has e Options)
+nixEvalExpr :: (MonadBuiltins e t f m, Has e Options)
-            => Maybe FilePath -> NExpr -> m (NValue m)
+            => Maybe FilePath -> NExpr -> m (NValue t f m)
 nixEvalExpr mpath = nixEval mpath id Eval.eval
 
 -- | Evaluate a nix expression in the default context
-nixEvalExprLoc :: forall e m. (MonadNix e m, Has e Options)
+nixEvalExprLoc :: forall e t f m. (MonadBuiltins e t f m, Has e Options)
-               => Maybe FilePath -> NExprLoc -> m (NValue m)
+               => Maybe FilePath -> NExprLoc -> m (NValue t f m)
 nixEvalExprLoc mpath =
-    nixEval mpath (Eval.addStackFrames @(NThunk m) . Eval.addSourcePositions)
+    nixEval mpath (Eval.addStackFrames @t . Eval.addSourcePositions)
             (Eval.eval . annotated . getCompose)
 
 -- | Evaluate a nix expression with tracing in the default context. Note that
@@ -73,15 +72,15 @@ nixEvalExprLoc mpath =
 --   'MonadNix'). All this function does is provide the right type class
 --   context.
 nixTracingEvalExprLoc
-    :: forall e m. (MonadNix e m, Has e Options, MonadIO m, Alternative m)
+    :: (MonadBuiltins e t f m, Has e Options, MonadIO m, Alternative m)
-    => Maybe FilePath -> NExprLoc -> m (NValue m)
+    => Maybe FilePath -> NExprLoc -> m (NValue t f m)
 nixTracingEvalExprLoc mpath = withNixContext mpath . evalExprLoc
 
 evaluateExpression
-    :: (MonadNix e m, Has e Options)
+    :: (MonadBuiltins e t f m, Has e Options)
     => Maybe FilePath
-    -> (Maybe FilePath -> NExprLoc -> m (NValue m))
+    -> (Maybe FilePath -> NExprLoc -> m (NValue t f m))
-    -> (NValue m -> m a)
+    -> (NValue t f m -> m a)
     -> NExprLoc
     -> m a
 evaluateExpression mpath evaluator handler expr = do
@@ -97,27 +96,29 @@ evaluateExpression mpath evaluator handler expr = do
 
     eval' = (normalForm =<<) . nixEvalExpr mpath
 
-    argmap args = Fix $ NVSetF (M.fromList args) mempty
+    argmap args = pure $ nvSet (M.fromList args') mempty
+      where
+        args' = map (fmap (wrapValue . nValueFromNF)) args
 
     compute ev x args p = do
-         f <- ev mpath x
+         f :: NValue t f m <- ev mpath x
          processResult p =<< case f of
-             NVClosure _ g -> g args
+             NVClosure _ g -> force ?? pure =<< g args
              _ -> pure f
 
-processResult :: forall e m a. (MonadNix e m, Has e Options)
+processResult :: forall e t f m a. (MonadNix e t f m, Has e Options)
-              => (NValue m -> m a) -> NValue m -> m a
+              => (NValue t f m -> m a) -> NValue t f m -> m a
 processResult h val = do
     opts :: Options <- asks (view hasLens)
     case attr opts of
         Nothing -> h val
         Just (Text.splitOn "." -> keys) -> go keys val
   where
-    go :: [Text.Text] -> NValue m -> m a
+    go :: [Text.Text] -> NValue t f m -> m a
     go [] v = h v
     go ((Text.decimal -> Right (n,"")):ks) v = case v of
         NVList xs -> case ks of
-            [] -> force @(NValue m) @(NThunk m) (xs !! n) h
+            [] -> force @t @m @(NValue t f m) (xs !! n) h
             _  -> force (xs !! n) (go ks)
         _ -> errorWithoutStackTrace $
                 "Expected a list for selector '" ++ show n

src/Nix/Builtins.hs

@@ -21,7 +21,7 @@
 {-# OPTIONS_GHC -Wno-missing-signatures #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
-module Nix.Builtins (withNixContext, builtins) where
+module Nix.Builtins (MonadBuiltins, withNixContext, builtins) where
 
 import           Control.Monad
 import           Control.Monad.Catch
@@ -1011,7 +1011,7 @@ data FileType
    | FileTypeUnknown
    deriving (Show, Read, Eq, Ord)
 
-instance Applicative m => ToNix FileType m (NValue t f m) where
+instance Convertible e t f m => ToNix FileType m (NValue t f m) where
     toNix = toNix . principledMakeNixStringWithoutContext . \case
         FileTypeRegular   -> "regular" :: Text
         FileTypeDirectory -> "directory"
@@ -1045,7 +1045,7 @@ fromJSON = fromValue >=> fromStringNoContext >=> \encoded ->
             <$> traverse (thunk . jsonToNValue) m
         A.Array l -> nvList <$>
             traverse (\x -> thunk @t @m @(NValue t f m)
-                         . whileForcingThunk @t @f (CoercionFromJson x)
+                         . whileForcingThunk @t @f (CoercionFromJson @t @f @m x)
                          . jsonToNValue $ x)
                      (V.toList l)
         A.String s -> pure $ nvStr $ hackyMakeNixStringWithoutContext s
@@ -1176,5 +1176,5 @@ instance ( MonadBuiltins e t f m
          , FromNix a m (NValue t f m)
          , ToBuiltin t f m b)
       => ToBuiltin t f m (a -> b) where
-    toBuiltin name f =
+    toBuiltin name f = return $ nvBuiltin name
-        return $ nvBuiltin name (fromNix >=> toBuiltin name . f)
+        (fromNix >=> fmap wrapValue . toBuiltin name . f)

tests/TestCommon.hs

@@ -28,7 +28,7 @@ hnixEvalFile opts file = do
                                       normalForm expr) $ \case
                 NixException frames ->
                     errorWithoutStackTrace . show
-                        =<< renderFrames @(NThunk (Lazy IO)) frames
+                        =<< renderFrames frames
 
 hnixEvalText :: Options -> Text -> IO (NValueNF (Lazy IO))
 hnixEvalText opts src = case parseNixText src of