From a006769124e09302857fb8f5a109d5517cc257d2 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Sun, 17 Mar 2019 21:58:35 -0700 Subject: [PATCH] Factor some common patterns back into Standard --- main/Main.hs | 15 ++++++--------- src/Nix/Thunk/Standard.hs | 16 ++++++++++++++++ tests/EvalTests.hs | 30 ++++++++++++------------------ tests/Main.hs | 8 ++------ tests/TestCommon.hs | 18 +++++------------- 5 files changed, 41 insertions(+), 46 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index e15d858..8a0a578 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -30,8 +30,6 @@ import Data.Text.Prettyprint.Doc.Render.Text import Nix import Nix.Convert import qualified Nix.Eval as Eval -import Nix.Fresh -import Nix.Fresh.Basic import Nix.Json -- import Nix.Lint import Nix.Options.Parser @@ -49,10 +47,9 @@ import qualified Text.Show.Pretty as PS main :: IO () main = do - time <- liftIO getCurrentTime + time <- getCurrentTime opts <- execParser (nixOptionsInfo time) - i <- newVar (1 :: Int) - runStdLazyM opts (runFreshIdT i) $ case readFrom opts of + runStandardIO opts $ case readFrom opts of Just path -> do let file = addExtension (dropExtension path) "nixc" process opts (Just file) =<< liftIO (readCache path) @@ -98,7 +95,7 @@ main = do NixException frames -> errorWithoutStackTrace . show - =<< renderFrames @(StdValue StdIdT IO) @(StdThunk StdIdT IO) frames + =<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames when (repl opts) $ withNixContext Nothing $ Repl.main @@ -135,7 +132,7 @@ main = do where printer | finder opts - = fromValue @(AttrSet (StdThunk StdIdT IO)) >=> findAttrs + = fromValue @(AttrSet (StandardThunk IO)) >=> findAttrs | xml opts = liftIO . putStrLn @@ -165,7 +162,7 @@ main = do Thunk _ _ ref -> do let path = prefix ++ Text.unpack k (_, descend) = filterEntry path k - val <- readVar @(StdLazy StdIdT IO) ref + val <- readVar @(StandardT IO) ref case val of Computed _ -> pure (k, Nothing) _ | descend -> (k, ) <$> forceEntry path nv @@ -207,7 +204,7 @@ main = do . (k ++) . (": " ++) . show - =<< renderFrames @(StdValue StdIdT IO) @(StdThunk StdIdT IO) frames + =<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames return Nothing reduction path mp x = do diff --git a/src/Nix/Thunk/Standard.hs b/src/Nix/Thunk/Standard.hs index 5e8d5bf..2850885 100644 --- a/src/Nix/Thunk/Standard.hs +++ b/src/Nix/Thunk/Standard.hs @@ -30,6 +30,8 @@ import GHC.Generics import Nix.Cited import Nix.Cited.Basic import Nix.Exec +import Nix.Fresh +import Nix.Fresh.Basic import Nix.Options import Nix.Thunk import Nix.Thunk.Basic @@ -95,3 +97,17 @@ runStdLazyM opts run action = do -- i <- newVar (1 :: Int) -- runFreshIdT i $ runLazyM opts action run $ runLazyM opts action + +type StandardThunk m = StdThunk StdIdT m +type StandardValue m = StdValue StdIdT m +type StandardValueNF m = StdValueNF StdIdT m +type StandardT m = StdLazy StdIdT m + +runStandard :: (MonadVar m, MonadIO m) + => Options -> StdLazy StdIdT m a -> m a +runStandard opts action = do + i <- newVar (1 :: Int) + runStdLazyM opts (runFreshIdT i) action + +runStandardIO :: Options -> StdLazy StdIdT IO a -> IO a +runStandardIO = runStandard diff --git a/tests/EvalTests.hs b/tests/EvalTests.hs index 096fc2f..ae7d02e 100644 --- a/tests/EvalTests.hs +++ b/tests/EvalTests.hs @@ -10,7 +10,7 @@ module EvalTests (tests, genEvalCompareTests) where import Control.Applicative ((<|>)) -import Control.Monad (when) +import Control.Monad (when, unless) import Control.Monad.Catch import Control.Monad.IO.Class -- import qualified Data.HashMap.Lazy as M @@ -22,9 +22,7 @@ import Data.Text (Text) import Data.Time import Nix import Nix.TH -import Nix.Fresh import Nix.Thunk.Standard -import Nix.Var import qualified System.Directory as D import System.Environment import System.FilePath @@ -422,11 +420,10 @@ genEvalCompareTests = do constantEqual :: NExprLoc -> NExprLoc -> Assertion constantEqual a b = do - time <- liftIO getCurrentTime + time <- getCurrentTime let opts = defaultOptions time -- putStrLn =<< lint (stripAnnotation a) - j <- newVar (1 :: Int) - res <- runStdLazyM opts (runFreshIdT j) $ do + res <- runStandardIO opts $ do a' <- normalForm =<< nixEvalExprLoc Nothing a b' <- normalForm =<< nixEvalExprLoc Nothing b return $ valueNFEq a' b' @@ -447,18 +444,15 @@ constantEqualText a b = do assertNixEvalThrows :: Text -> Assertion assertNixEvalThrows a = do - let Success a' = parseNixTextLoc a - time <- liftIO getCurrentTime - let opts = defaultOptions time - j <- newVar (1 :: Int) - errored <- catch - (False <$ runStdLazyM opts (runFreshIdT j) - (normalForm =<< nixEvalExprLoc Nothing a')) - (\(_ :: NixException) -> pure True) - if errored then - pure () - else - assertFailure "Did not catch nix exception" + let Success a' = parseNixTextLoc a + time <- getCurrentTime + let opts = defaultOptions time + errored <- catch + (False <$ runStandardIO opts + (normalForm =<< nixEvalExprLoc Nothing a')) + (\(_ :: NixException) -> pure True) + unless errored $ + assertFailure "Did not catch nix exception" freeVarsEqual :: Text -> [VarName] -> Assertion freeVarsEqual a xs = do diff --git a/tests/Main.hs b/tests/Main.hs index 0fd13d6..fc62f84 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -9,7 +9,6 @@ import Control.DeepSeq import qualified Control.Exception as Exc import Control.Applicative ((<|>)) import Control.Monad -import Control.Monad.IO.Class import Data.Fix import Data.List (isSuffixOf) import Data.Maybe @@ -19,13 +18,11 @@ import Data.Time import qualified EvalTests import qualified Nix import Nix.Expr.Types -import Nix.Fresh import Nix.String import Nix.Options import Nix.Parser import Nix.Thunk.Standard import Nix.Value -import Nix.Var import qualified NixLanguageTests import qualified ParserTests import qualified PrettyTests @@ -59,9 +56,8 @@ ensureNixpkgsCanParse = sha256 = "#{sha256}"; }|]) $ \expr -> do NVStr ns <- do - time <- liftIO getCurrentTime - j <- newVar (1 :: Int) - runStdLazyM (defaultOptions time) (runFreshIdT j) $ + time <- getCurrentTime + runStandardIO (defaultOptions time) $ Nix.nixEvalExprLoc Nothing expr let dir = hackyStringIgnoreContext ns exists <- fileExist (unpack dir) diff --git a/tests/TestCommon.hs b/tests/TestCommon.hs index 2d72faa..9748c56 100644 --- a/tests/TestCommon.hs +++ b/tests/TestCommon.hs @@ -12,12 +12,7 @@ import Data.Text ( Text import Data.Time import Nix import Nix.Exec () -import Nix.Cited () -import Nix.Cited.Basic () -import Nix.Fresh -import Nix.Fresh.Basic import Nix.Thunk.Standard -import Nix.Var import System.Environment import System.IO import System.Posix.Files @@ -25,7 +20,7 @@ import System.Posix.Temp import System.Process import Test.Tasty.HUnit -hnixEvalFile :: Options -> FilePath -> IO (StdValueNF StdIdT IO) +hnixEvalFile :: Options -> FilePath -> IO (StandardValueNF IO) hnixEvalFile opts file = do parseResult <- parseNixFileLoc file case parseResult of @@ -33,16 +28,15 @@ hnixEvalFile opts file = do error $ "Parsing failed for file `" ++ file ++ "`.\n" ++ show err Success expr -> do setEnv "TEST_VAR" "foo" - i <- newVar (1 :: Int) - runStdLazyM opts (runFreshIdT i) + runStandardIO opts $ catch (evaluateExpression (Just file) nixEvalExprLoc normalForm expr) $ \case NixException frames -> errorWithoutStackTrace . show - =<< renderFrames @(StdValue StdIdT IO) @(StdThunk StdIdT IO) frames + =<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames -hnixEvalText :: Options -> Text -> IO (StdValueNF StdIdT IO) +hnixEvalText :: Options -> Text -> IO (StandardValueNF IO) hnixEvalText opts src = case parseNixText src of Failure err -> error @@ -50,9 +44,7 @@ hnixEvalText opts src = case parseNixText src of ++ unpack src ++ "`.\n" ++ show err - Success expr -> do - i <- newVar (1 :: Int) - runStdLazyM opts (runFreshIdT i) $ normalForm =<< nixEvalExpr Nothing expr + Success expr -> runStandardIO opts $ normalForm =<< nixEvalExpr Nothing expr nixEvalString :: String -> IO String nixEvalString expr = do