From 04cf8be6501e3eef320970996143cab311103278 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Sat, 23 Mar 2019 00:56:40 -0700 Subject: [PATCH] Move StdIdT out of the StandardT transformer --- main/Main.hs | 16 +++++++++------- src/Nix/Standard.hs | 20 +++++++++----------- tests/TestCommon.hs | 9 +++++---- 3 files changed, 23 insertions(+), 22 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index 9fe4e82..4dc14fb 100644 --- a/main/Main.hs +++ b/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)) - @(StdThunk (StandardT IO)) + =<< renderFrames @(StdValue (StandardT (StdIdT 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)) - @(StdThunk (StandardT IO)) + =<< renderFrames @(StdValue (StandardT (StdIdT IO))) + @(StdThunk (StandardT (StdIdT IO))) frames return Nothing diff --git a/src/Nix/Standard.hs b/src/Nix/Standard.hs index 04c210f..88861d7 100644 --- a/src/Nix/Standard.hs +++ b/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) - (StdIdT m)) a) + (StateT (HashMap FilePath NExprLoc) m) a) deriving ( Functor , Applicative @@ -223,8 +222,8 @@ newtype StandardTF r m a , MonadState (HashMap FilePath NExprLoc) ) -instance MonadTrans (StandardTF m) where - lift = StandardTF . lift . lift . lift +instance MonadTrans (StandardTF r) where + 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 - type ThunkId (Fix1T StandardTF m) = Int - freshId = mkStandardT $ lift $ lift freshId +instance MonadThunkId m => MonadThunkId (Fix1T StandardTF m) where + type ThunkId (Fix1T StandardTF m) = ThunkId m 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 diff --git a/tests/TestCommon.hs b/tests/TestCommon.hs index fbe5bdd..c1b2969 100644 --- a/tests/TestCommon.hs +++ b/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)) - @(StdThunk (StandardT IO)) + =<< renderFrames @(StdValue (StandardT (StdIdT 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