Move StdIdT out of the StandardT transformer

main/Main.hs

@@ -31,6 +31,7 @@ import           Data.Text.Prettyprint.Doc.Render.Text
 import           Nix
 import           Nix.Convert
 import qualified Nix.Eval                      as Eval
+import           Nix.Fresh.Basic
 import           Nix.Json
 -- import           Nix.Lint
 import           Nix.Options.Parser
@@ -97,8 +98,8 @@ main = do
         NixException frames ->
           errorWithoutStackTrace
             .   show
-            =<< renderFrames @(StdValue (StandardT IO))
+            =<< renderFrames @(StdValue (StandardT (StdIdT IO)))
-                  @(StdThunk (StandardT IO))
+                  @(StdThunk (StandardT (StdIdT IO)))
                   frames
 
       when (repl opts) $ withNixContext Nothing Repl.main
@@ -136,7 +137,7 @@ main = do
    where
     printer
       | finder opts
-      = fromValue @(AttrSet (StdValue (StandardT IO))) >=> findAttrs
+      = fromValue @(AttrSet (StdValue (StandardT (StdIdT IO)))) >=> findAttrs
       | xml opts
       = liftIO
         .   putStrLn
@@ -156,7 +157,8 @@ main = do
       | otherwise
       = liftIO . print <=< prettyNValue
      where
-      findAttrs :: AttrSet (StdValue (StandardT IO)) -> StandardT IO ()
+      findAttrs :: AttrSet (StdValue (StandardT (StdIdT IO)))
+                -> StandardT (StdIdT IO) ()
       findAttrs = go ""
        where
         go prefix s = do
@@ -165,7 +167,7 @@ main = do
             Pure (StdThunk (extract -> Thunk _ _ ref)) -> do
               let path         = prefix ++ Text.unpack k
                   (_, descend) = filterEntry path k
-              val <- readVar @(StandardT IO) ref
+              val <- readVar @(StandardT (StdIdT IO)) ref
               case val of
                 Computed _ -> pure (k, Nothing)
                 _ | descend   -> (k, ) <$> forceEntry path nv
@@ -207,8 +209,8 @@ main = do
                 .   (k ++)
                 .   (": " ++)
                 .   show
-                =<< renderFrames @(StdValue (StandardT IO))
+                =<< renderFrames @(StdValue (StandardT (StdIdT IO)))
-                      @(StdThunk (StandardT IO))
+                      @(StdThunk (StandardT (StdIdT IO)))
                       frames
               return Nothing
 

src/Nix/Standard.hs

@@ -207,8 +207,7 @@ instance ( MonadAtomicRef m
 
 newtype StandardTF r m a
   = StandardTF (ReaderT (Context r (StdValue r))
-                        (StateT (HashMap FilePath NExprLoc)
+                        (StateT (HashMap FilePath NExprLoc) m) a)
-                                (StdIdT m)) a)
   deriving
     ( Functor
     , Applicative
@@ -223,8 +222,8 @@ newtype StandardTF r m a
     , MonadState (HashMap FilePath NExprLoc)
     )
 
-instance MonadTrans (StandardTF m) where
+instance MonadTrans (StandardTF r) where
-  lift = StandardTF . lift . lift . lift
+  lift = StandardTF . lift . lift
 
 instance (MonadPutStr r, MonadPutStr m) => MonadPutStr (StandardTF r m)
 instance (MonadHttp r, MonadHttp m) => MonadHttp (StandardTF r m)
@@ -241,14 +240,13 @@ instance MonadTrans (Fix1T StandardTF) where
   lift = Fix1T . lift
 
 -- | This instance is based on the 'StdIdT' layer of 'StandardTF m'.
-instance MonadAtomicRef m => MonadThunkId (Fix1T StandardTF m) where
+instance MonadThunkId m => MonadThunkId (Fix1T StandardTF m) where
-  type ThunkId (Fix1T StandardTF m) = Int
+  type ThunkId (Fix1T StandardTF m) = ThunkId m
-  freshId = mkStandardT $ lift $ lift freshId
 
 mkStandardT
   :: ReaderT (Context (StandardT m) (StdValue (StandardT m)))
             (StateT (HashMap FilePath NExprLoc)
-                    (StdIdT m)) a
+                    m) a
   -> StandardT m a
 mkStandardT = Fix1T . StandardTF
 
@@ -256,11 +254,11 @@ runStandardT
   :: StandardT m a
   -> ReaderT (Context (StandardT m) (StdValue (StandardT m)))
             (StateT (HashMap FilePath NExprLoc)
-                    (StdIdT m)) a
+                    m) a
 runStandardT (Fix1T (StandardTF m)) = m
 
 runWithBasicEffects :: (MonadIO m, MonadAtomicRef m)
-                    => Options -> StandardT m a -> m a
+                    => Options -> StandardT (StdIdT m) a -> m a
 runWithBasicEffects opts =
   go . (`evalStateT` mempty)
      . (`runReaderT` newContext opts)
@@ -270,5 +268,5 @@ runWithBasicEffects opts =
     i <- newVar (1 :: Int)
     runFreshIdT i action
 
-runWithBasicEffectsIO :: Options -> StandardT IO a -> IO a
+runWithBasicEffectsIO :: Options -> StandardT (StdIdT IO) a -> IO a
 runWithBasicEffectsIO = runWithBasicEffects

tests/TestCommon.hs

@@ -14,6 +14,7 @@ import           Data.Time
 import           Nix
 import           Nix.Exec                       ( )
 import           Nix.Standard
+import           Nix.Fresh.Basic
 import           System.Environment
 import           System.IO
 import           System.Posix.Files
@@ -21,7 +22,7 @@ import           System.Posix.Temp
 import           System.Process
 import           Test.Tasty.HUnit
 
-hnixEvalFile :: Options -> FilePath -> IO (StdValueNF (StandardT IO))
+hnixEvalFile :: Options -> FilePath -> IO (StdValueNF (StandardT (StdIdT IO)))
 hnixEvalFile opts file = do
   parseResult <- parseNixFileLoc file
   case parseResult of
@@ -35,11 +36,11 @@ hnixEvalFile opts file = do
             NixException frames ->
               errorWithoutStackTrace
                 .   show
-                =<< renderFrames @(StdValue (StandardT IO))
+                =<< renderFrames @(StdValue (StandardT (StdIdT IO)))
-                      @(StdThunk (StandardT IO))
+                      @(StdThunk (StandardT (StdIdT IO)))
                       frames
 
-hnixEvalText :: Options -> Text -> IO (StdValueNF (StandardT IO))
+hnixEvalText :: Options -> Text -> IO (StdValueNF (StandardT (StdIdT IO)))
 hnixEvalText opts src = case parseNixText src of
   Failure err ->
     error