From 6ae5764221693908999cbc05bc9a41fc34c8794f Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Sat, 16 Mar 2019 01:10:47 -0700 Subject: [PATCH] All type checks, but many instance definitions are still missing --- main/Main.hs | 45 ++++++------ src/Nix/Cited.hs | 8 ++- src/Nix/Exec.hs | 30 ++++---- src/Nix/Scope.hs | 2 +- src/Nix/Thunk/Basic.hs | 5 ++ src/Nix/Thunk/Standard.hs | 144 +++++++++++++++++++++++++------------- src/Nix/Value.hs | 11 +-- tests/EvalTests.hs | 46 ++++++------ tests/Main.hs | 4 +- tests/TestCommon.hs | 8 ++- 10 files changed, 182 insertions(+), 121 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index d544a1c..06cb1de 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -13,8 +13,6 @@ import qualified Control.Exception as Exc import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class -import Control.Monad.Ref -import Control.Monad.Trans.Class -- import Control.Monad.ST import qualified Data.Aeson.Text as A import qualified Data.HashMap.Lazy as M @@ -31,7 +29,6 @@ import Nix import Nix.Cited import Nix.Convert import qualified Nix.Eval as Eval -import Nix.Fresh import Nix.Json -- import Nix.Lint import Nix.Options.Parser @@ -59,18 +56,18 @@ main = do Just s -> handleResult opts Nothing (parseNixTextLoc s) Nothing -> case fromFile opts of Just "-" -> - liftIO $ mapM_ (processFile opts) - =<< (lines <$> getContents) + mapM_ (processFile opts) + =<< (lines <$> liftIO getContents) Just path -> - liftIO $ mapM_ (processFile opts) - =<< (lines <$> readFile path) + mapM_ (processFile opts) + =<< (lines <$> liftIO (readFile path)) Nothing -> case filePaths opts of [] -> withNixContext Nothing $ Repl.main ["-"] -> handleResult opts Nothing . parseNixTextLoc =<< liftIO Text.getContents paths -> - liftIO $ mapM_ (processFile opts) paths + mapM_ (processFile opts) paths where processFile opts path = do eres <- parseNixFileLoc path @@ -98,7 +95,7 @@ main = do catch (process opts mpath expr) $ \case NixException frames -> errorWithoutStackTrace . show - =<< renderFrames frames + =<< renderFrames @(StdValue IO) @(StdThunk IO) frames when (repl opts) $ withNixContext Nothing $ Repl.main @@ -140,19 +137,19 @@ main = do . prettyNix . stripAnnotation $ expr where - printer - :: forall e t f m. - ( MonadNix e t f m - , MonadRef m - , MonadFreshId Int m - , MonadVar m - , MonadIO m - , Typeable m - ) - => NValue t f m -> m () + -- printer + -- :: forall e t f m. + -- ( MonadNix e t f m + -- , MonadRef m + -- , MonadFreshId Int m + -- , MonadVar m + -- , MonadIO m + -- , Typeable m + -- ) + -- => NValue t f m -> m () printer | finder opts = - fromValue @(AttrSet (StdThunk m)) >=> findAttrs + fromValue @(AttrSet (StdThunk IO)) >=> findAttrs | xml opts = liftIO . putStrLn . Text.unpack @@ -174,12 +171,12 @@ main = do where go prefix s = do xs <- forM (sortOn fst (M.toList s)) - $ \(k, nv@(StdThunk (NCited _ t))) -> case t of + $ \(k, nv@(StdThunk (StdCited (NCited _ t)))) -> case t of Value v -> pure (k, Just v) Thunk _ _ ref -> do let path = prefix ++ Text.unpack k (_, descend) = filterEntry path k - val <- readVar @m ref + val <- readVar @(StdLazy IO) ref case val of Computed _ -> pure (k, Nothing) _ | descend -> (k,) <$> forceEntry path nv @@ -193,7 +190,7 @@ main = do when descend $ case mv of Nothing -> return () Just v -> case v of - StdValue (NVSet s' _) -> + NVSet s' _ -> go (path ++ ".") s' _ -> return () where @@ -220,7 +217,7 @@ main = do . ("Exception forcing " ++) . (k ++) . (": " ++) . show - =<< renderFrames @(StdThunk m) frames + =<< renderFrames @(StdValue IO) @(StdThunk IO) frames return Nothing reduction path mp x = do diff --git a/src/Nix/Cited.hs b/src/Nix/Cited.hs index 59702f0..d227486 100644 --- a/src/Nix/Cited.hs +++ b/src/Nix/Cited.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} @@ -17,6 +18,7 @@ import Data.Functor.Compose import Data.Typeable (Typeable) import GHC.Generics import Lens.Family2.TH +import Text.Show.Deriving import Nix.Expr.Types.Annotated import Nix.Scope @@ -29,13 +31,15 @@ data Provenance t v m = Provenance -- 'contextExpr' will be @(x: x + 2) 3@, preserving not only the -- result of the call, but what was called and with what arguments. } - deriving (Generic, Typeable) + deriving (Generic, Typeable, Show) data NCited t v m a = NCited { _provenance :: [Provenance t v m] , _cited :: a } - deriving (Generic, Typeable, Functor, Foldable, Traversable) + deriving (Generic, Typeable, Functor, Foldable, Traversable, Show) + +$(deriveShow1 ''NCited) instance Applicative (NCited t v m) where pure = NCited [] diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index e05fedd..a076d26 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -119,22 +119,24 @@ nvBuiltinP :: Cited t f m nvBuiltinP p name f = addProvenance1 p (nvBuiltin name f) type MonadCitedThunks t f m = - (MonadThunk t m (NValue t f m), - MonadDataErrorContext t f m, - HasCitations1 t (NValue t f m) m f) + ( MonadThunk t m (NValue t f m) + , MonadDataErrorContext t f m + , HasCitations1 t (NValue t f m) m f + ) type MonadNix e t f m = - (Has e SrcSpan, - Has e Options, - Scoped t m, - Framed e m, - MonadFix m, - MonadCatch m, - MonadThrow m, - Typeable m, - Alternative m, - MonadEffects t f m, - MonadCitedThunks t f m) + ( Has e SrcSpan + , Has e Options + , Scoped t m + , Framed e m + , MonadFix m + , MonadCatch m + , MonadThrow m + , Typeable m + , Alternative m + , MonadEffects t f m + , MonadCitedThunks t f m + ) data ExecFrame t f m = Assertion SrcSpan (NValue t f m) deriving (Show, Typeable) diff --git a/src/Nix/Scope.hs b/src/Nix/Scope.hs index ff9f392..32b2da0 100644 --- a/src/Nix/Scope.hs +++ b/src/Nix/Scope.hs @@ -21,7 +21,7 @@ import Lens.Family2 import Nix.Utils newtype Scope a = Scope { getScope :: AttrSet a } - deriving (Functor, Foldable, Traversable) + deriving (Functor, Foldable, Traversable, Eq) instance Show (Scope a) where show (Scope m) = show (M.keys m) diff --git a/src/Nix/Thunk/Basic.hs b/src/Nix/Thunk/Basic.hs index eb75c3f..ec5f046 100644 --- a/src/Nix/Thunk/Basic.hs +++ b/src/Nix/Thunk/Basic.hs @@ -30,6 +30,11 @@ data NThunkF m v = Value v | Thunk Int (Var m Bool) (Var m (Deferred m v)) +instance Eq v => Eq (NThunkF m v) where + Value x == Value y = x == y + Thunk x _ _ == Thunk y _ _ = x == y + _ == _ = False -- jww (2019-03-16): not accurate... + instance Show v => Show (NThunkF m v) where show (Value v) = show v show (Thunk _ _ _) = "" diff --git a/src/Nix/Thunk/Standard.hs b/src/Nix/Thunk/Standard.hs index e965823..31b60fe 100644 --- a/src/Nix/Thunk/Standard.hs +++ b/src/Nix/Thunk/Standard.hs @@ -1,12 +1,15 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} @@ -16,20 +19,27 @@ module Nix.Thunk.Standard where +import Control.Comonad (Comonad) +import Control.Comonad.Env (ComonadEnv) import Control.Monad.Catch hiding (catchJust) import Control.Monad.Reader import Control.Monad.Trans.Control import Data.Fix +import Data.Functor.Classes import qualified Data.HashMap.Lazy as M import Data.Text (Text) +import GHC.Generics import Nix.Cited import Nix.Convert +import Nix.Effects import Nix.Eval as Eval import Nix.Exec import Nix.Expr import Nix.Frames import Nix.Fresh import Nix.Options +import Nix.Render +import Nix.Scope import Nix.String import Nix.Thunk import Nix.Thunk.Basic @@ -37,37 +47,42 @@ import Nix.Utils import Nix.Value import Nix.Var (MonadVar) +newtype StdCited m a = StdCited + { _stdCited :: NCited (StdThunk m) (StdValue m) (StdLazy m) a } + deriving + ( Generic + , Typeable + , Functor + , Applicative + , Foldable + , Traversable + , Comonad + , ComonadEnv [Provenance (StdThunk m) (StdValue m) (StdLazy m)] + ) + newtype StdThunk m = StdThunk - { _stdThunk :: - NCited (StdThunk m) (StdValue m) - (FreshIdT Int m) - (NThunkF (FreshIdT Int m) (StdValue m)) } + { _stdThunk :: StdCited m (NThunkF (StdLazy m) (StdValue m)) } -newtype StdValue m = StdValue - { _stdValue :: - NValue (StdThunk m) - (NCited (StdThunk m) (StdValue m) (FreshIdT Int m)) - (FreshIdT Int m) } +type StdValue m = NValue (StdThunk m) (StdCited m) (StdLazy m) +type StdValueNF m = NValueNF (StdThunk m) (StdCited m) (StdLazy m) -newtype StdValueNF m = StdValueNF - { _stdValueNF :: - NValueNF (StdThunk m) - (NCited (StdThunk m) (StdValue m) (FreshIdT Int m)) - (FreshIdT Int m) } +type StdLazy m = Lazy (StdThunk m) (StdCited m) (FreshIdT Int m) -type StdLazy m = - Lazy (StdThunk m) - (NCited (StdThunk m) (StdValue m) (FreshIdT Int m)) - (FreshIdT Int m) +instance Show1 (StdLazy m) => Show1 (StdCited m) where + liftShowsPrec f g n (StdCited c) = liftShowsPrec f g n c -instance (MonadNix e t f m, MonadVar m) - => MonadThunk (StdThunk m) (FreshIdT Int m) (StdValue m) where +instance ( MonadVar m + , MonadCatch m + , MonadThrow m + , Typeable m + ) + => MonadThunk (StdThunk m) (StdLazy m) (StdValue m) where thunk mv = do - opts :: Options <- lift $ asks (view hasLens) + opts :: Options <- asks (view hasLens) if thunks opts then do - frames :: Frames <- lift $ asks (view hasLens) + frames :: Frames <- asks (view hasLens) -- Gather the current evaluation context at the time of thunk -- creation, and record it along with the thunk. @@ -79,9 +94,9 @@ instance (MonadNix e t f m, MonadVar m) go _ = [] ps = concatMap (go . frame) frames - fmap (StdThunk . NCited ps) . thunk $ mv + fmap (StdThunk . StdCited . NCited ps) . thunk $ mv else - fmap (StdThunk . NCited []) . thunk $ mv + fmap (StdThunk . StdCited . NCited []) . thunk $ mv thunkId = error "jww (2019-03-15): NYI" @@ -92,42 +107,71 @@ instance (MonadNix e t f m, MonadVar m) -- which does not capture the current stack frame information to provide -- it in a NixException, so we catch and re-throw it here using -- 'throwError' from Frames.hs. - force (StdThunk (NCited ps t)) f = - catch go (lift . throwError @ThunkLoop) + force (StdThunk (StdCited (NCited ps t))) f = + catch go (throwError @ThunkLoop) where go = case ps of [] -> force t f - Provenance scope e@(Compose (Ann s _)):_ -> do - r <- liftWith $ \run -> do - withFrame Info (ForcingExpr scope (wrapExprLoc s e)) - (run (force t f)) - restoreT $ return r + Provenance scope e@(Compose (Ann s _)):_ -> + -- r <- liftWith $ \run -> do + -- withFrame Info (ForcingExpr scope (wrapExprLoc s e)) + -- (run (force t f)) + -- restoreT $ return r + withFrame Info (ForcingExpr scope (wrapExprLoc s e)) + (force t f) - forceEff (StdThunk (NCited ps t)) f = - catch go (lift . throwError @ThunkLoop) + forceEff (StdThunk (StdCited (NCited ps t))) f = + catch go (throwError @ThunkLoop) where go = case ps of [] -> forceEff t f Provenance scope e@(Compose (Ann s _)):_ -> do - r <- liftWith $ \run -> do - withFrame Info (ForcingExpr scope (wrapExprLoc s e)) - (run (forceEff t f)) - restoreT $ return r + -- r <- liftWith $ \run -> do + -- withFrame Info (ForcingExpr scope (wrapExprLoc s e)) + -- (run (forceEff t f)) + -- restoreT $ return r + withFrame Info (ForcingExpr scope (wrapExprLoc s e)) + (forceEff t f) - wrapValue = StdThunk . NCited [] . wrapValue - getValue (StdThunk (NCited _ v)) = getValue v + wrapValue = StdThunk . StdCited . NCited [] . wrapValue + getValue (StdThunk (StdCited (NCited _ v))) = getValue v -instance FromValue NixString m (StdThunk m) where -instance FromValue Path m (StdThunk m) where -instance FromValue [StdThunk m] m (StdThunk m) where -instance FromValue (M.HashMap Text (StdThunk m)) m (StdThunk m) where -instance ToValue NixString m (StdThunk m) where -instance ToValue Int m (StdThunk m) where -instance ToValue () m (StdThunk m) where -instance FromValue [NixString] m (StdThunk m) where -instance FromNix [NixString] m (StdThunk m) where -instance ToValue (StdThunk m) m (NValue (StdThunk m) f m) where -instance ToNix (StdThunk m) m (NValue (StdThunk m) f m) where +instance FromNix Bool (StdLazy IO) (StdThunk IO) where +instance FromNix [NixString] (StdLazy IO) (StdThunk IO) where +instance FromValue (M.HashMap Text (StdThunk m)) (StdLazy m) (StdThunk m) where +instance FromValue Bool (StdLazy IO) (StdThunk IO) where +instance FromValue NixString (StdLazy m) (StdThunk m) where +instance FromValue Path (StdLazy m) (StdThunk m) where +instance FromValue [NixString] (StdLazy IO) (StdThunk IO) where +instance FromValue [StdThunk m] (StdLazy m) (StdThunk m) where +instance ToNix (StdThunk m) (StdLazy m) (StdValue m) where +instance ToNix NixString (StdLazy m) (StdThunk m) where +instance ToNix [StdThunk m] (StdLazy m) (StdThunk m) where +instance ToValue () (StdLazy m) (StdThunk m) where +instance ToValue (StdThunk m) (StdLazy m) (StdValue m) where +instance ToValue Int (StdLazy m) (StdThunk m) where +instance ToValue NixString (StdLazy m) (StdThunk m) where +instance ToValue [StdThunk m] (StdLazy m) (StdThunk m) where + +-- instance FromValue a (StdLazy m) (StdValue m) => FromValue a (StdLazy m) (StdThunk m) where +-- instance FromNix a (StdLazy m) (StdValue m) => FromNix a (StdLazy m) (StdThunk m) where + +instance Show (StdThunk m) where + show _ = "" -- jww (2019-03-15): NYI + +deriving instance MonadReader e m => MonadReader e (FreshIdT Int m) +instance MonadFile m => MonadFile (FreshIdT Int m) +instance MonadIntrospect m => MonadIntrospect (FreshIdT Int m) +instance MonadStore m => MonadStore (FreshIdT Int m) +instance MonadPutStr m => MonadPutStr (FreshIdT Int m) +instance MonadHttp m => MonadHttp (FreshIdT Int m) +instance MonadEnv m => MonadEnv (FreshIdT Int m) +instance MonadInstantiate m => MonadInstantiate (FreshIdT Int m) +instance MonadExec m => MonadExec (FreshIdT Int m) + +instance MonadEffects t f m => MonadEffects t f (FreshIdT Int m) + +instance HasCitations1 (StdThunk m) (StdValue m) (StdLazy m) (StdCited m) runStdLazyM :: MonadIO m => Options -> StdLazy m a -> m a runStdLazyM opts = runFreshIdT (1 :: Int) . runLazyM opts diff --git a/src/Nix/Value.hs b/src/Nix/Value.hs index b2ad3a5..3ad61ec 100644 --- a/src/Nix/Value.hs +++ b/src/Nix/Value.hs @@ -38,6 +38,7 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Except import qualified Data.Aeson as A import Data.Align +import Data.Eq.Deriving import Data.Functor.Classes import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as M @@ -121,7 +122,7 @@ lmapNValueF f = \case NVBuiltinF s g -> NVBuiltinF s (g . fmap f) type MonadDataContext f (m :: * -> *) = - (Show1 f, Comonad f, Applicative f, Traversable f, Monad m) + (Comonad f, Applicative f, Traversable f, Monad m) -- | At the time of constructor, the expected arguments to closures are values -- that may contain thunks. The type of such thunks are fixed at that time. @@ -275,7 +276,7 @@ nvBuiltinNF :: Applicative f => String -> (m (NValue t f m) -> m (NValueNF t f m)) -> NValueNF t f m nvBuiltinNF name f = Free (NValue (pure (NVBuiltinF name f))) -instance Comonad f => Eq (NValue t f m) where +instance Comonad f => Eq (NValue' t f m a) where NVConstant (NFloat x) == NVConstant (NInt y) = x == fromInteger y NVConstant (NInt x) == NVConstant (NFloat y) = fromInteger x == y NVConstant (NInt x) == NVConstant (NInt y) = x == y @@ -284,7 +285,7 @@ instance Comonad f => Eq (NValue t f m) where NVPath x == NVPath y = x == y _ == _ = False -instance Comonad f => Ord (NValue t f m) where +instance Comonad f => Ord (NValue' t f m a) where NVConstant (NFloat x) <= NVConstant (NInt y) = x <= fromInteger y NVConstant (NInt x) <= NVConstant (NFloat y) = fromInteger x <= y NVConstant (NInt x) <= NVConstant (NInt y) = x <= y @@ -426,7 +427,7 @@ describeValue = \case TPath -> "a path" TBuiltin -> "a builtin function" -instance Eq1 (NValueF (NValue' t f m a) m) where +instance Eq1 (NValueF p m) where liftEq _ (NVConstantF x) (NVConstantF y) = x == y liftEq _ (NVStrF x) (NVStrF y) = x == y liftEq eq (NVListF x) (NVListF y) = liftEq eq x y @@ -471,3 +472,5 @@ $(makeLenses ''NValue') key :: (Traversable f, Applicative g) => VarName -> LensLike' g (NValue' t f m a) (Maybe a) key k = nValue.traverse._NVSetF._1.hashAt k + +$(deriveEq1 ''NValue') diff --git a/tests/EvalTests.hs b/tests/EvalTests.hs index 288bb7f..bd9aef1 100644 --- a/tests/EvalTests.hs +++ b/tests/EvalTests.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} @@ -9,18 +10,19 @@ module EvalTests (tests, genEvalCompareTests) where import Control.Applicative ((<|>)) -import Control.Monad.Catch import Control.Monad (when) +import Control.Monad.Catch import Control.Monad.IO.Class -import qualified Data.HashMap.Lazy as M +-- import qualified Data.HashMap.Lazy as M import Data.List ((\\)) import Data.Maybe (isJust) -import Data.String.Interpolate.IsString import qualified Data.Set as S +import Data.String.Interpolate.IsString import Data.Text (Text) import Data.Time import Nix import Nix.TH +import Nix.Thunk.Standard import qualified System.Directory as D import System.Environment import System.FilePath @@ -417,26 +419,29 @@ genEvalCompareTests = do mkTestCase td f = testCase f $ assertEvalFileMatchesNix (td f) -instance (Show r, Show (NValueF m r), Eq r) => Eq (NValueF m r) where - NVConstantF x == NVConstantF y = x == y - NVStrF ls == NVStrF rs = hackyStringIgnoreContext ls == hackyStringIgnoreContext rs - NVListF x == NVListF y = and (zipWith (==) x y) - NVSetF x _ == NVSetF y _ = - M.keys x == M.keys y && - and (zipWith (==) (M.elems x) (M.elems y)) - NVPathF x == NVPathF y = x == y - x == y = error $ "Need to add comparison for values: " - ++ show x ++ " == " ++ show y +-- instance (Show r, Show (NValueF p m r), Eq r) => Eq (NValueF p m r) where +-- NVConstantF x == NVConstantF y = x == y +-- NVStrF ls == NVStrF rs = hackyStringIgnoreContext ls == hackyStringIgnoreContext rs +-- NVListF x == NVListF y = and (zipWith (==) x y) +-- NVSetF x _ == NVSetF y _ = +-- M.keys x == M.keys y && +-- and (zipWith (==) (M.elems x) (M.elems y)) +-- NVPathF x == NVPathF y = x == y +-- x == y = error $ "Need to add comparison for values: " +-- ++ show x ++ " == " ++ show y constantEqual :: NExprLoc -> NExprLoc -> Assertion constantEqual a b = do time <- liftIO getCurrentTime let opts = defaultOptions time -- putStrLn =<< lint (stripAnnotation a) - a' <- runLazyM opts $ normalForm =<< nixEvalExprLoc Nothing a - -- putStrLn =<< lint (stripAnnotation b) - b' <- runLazyM opts $ normalForm =<< nixEvalExprLoc Nothing b - assertEqual "" a' b' + res <- runStdLazyM opts $ do + a' <- nixEvalExprLoc Nothing a + b' <- nixEvalExprLoc Nothing b + iterNValue forceEff (const (return ())) a' + iterNValue forceEff (const (return ())) b' + valueEq a' b' + assertBool "" res constantEqualText' :: Text -> Text -> Assertion constantEqualText' a b = do @@ -456,14 +461,13 @@ assertNixEvalThrows a = do let Success a' = parseNixTextLoc a time <- liftIO getCurrentTime let opts = defaultOptions time - errored <- catch ((runLazyM opts $ normalForm =<< nixEvalExprLoc Nothing a') >> pure False) handler + errored <- catch + (False <$ runStdLazyM opts (normalForm =<< nixEvalExprLoc Nothing a')) + (\(_ :: NixException) -> pure True) if errored then pure () else assertFailure "Did not catch nix exception" - where - handler :: NixException -> IO Bool - handler _ = pure True freeVarsEqual :: Text -> [VarName] -> Assertion freeVarsEqual a xs = do diff --git a/tests/Main.hs b/tests/Main.hs index d49739a..fe0e4e1 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -18,12 +18,12 @@ import Data.Text (unpack) import Data.Time import qualified EvalTests import qualified Nix -import Nix.Exec import Nix.Expr.Types import Nix.String import Nix.Options import Nix.Parser import Nix.Value +import Nix.Thunk.Standard import qualified NixLanguageTests import qualified ParserTests import qualified PrettyTests @@ -58,7 +58,7 @@ ensureNixpkgsCanParse = }|]) $ \expr -> do NVStr ns <- do time <- liftIO getCurrentTime - runLazyM (defaultOptions time) $ Nix.nixEvalExprLoc Nothing expr + runStdLazyM (defaultOptions time) $ Nix.nixEvalExprLoc Nothing expr let dir = hackyStringIgnoreContext ns exists <- fileExist (unpack dir) unless exists $ diff --git a/tests/TestCommon.hs b/tests/TestCommon.hs index 66f0849..6909a86 100644 --- a/tests/TestCommon.hs +++ b/tests/TestCommon.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module TestCommon where @@ -16,7 +17,7 @@ import System.Posix.Temp import System.Process import Test.Tasty.HUnit -hnixEvalFile :: Options -> FilePath -> IO (StdValueNF (StdLazy IO)) +hnixEvalFile :: Options -> FilePath -> IO (StdValueNF IO) hnixEvalFile opts file = do parseResult <- parseNixFileLoc file case parseResult of @@ -29,14 +30,15 @@ hnixEvalFile opts file = do normalForm expr) $ \case NixException frames -> errorWithoutStackTrace . show - =<< renderFrames frames + =<< renderFrames @(StdValue IO) @(StdThunk IO) frames -hnixEvalText :: Options -> Text -> IO (StdValueNF (StdLazy IO)) +hnixEvalText :: Options -> Text -> IO (StdValueNF IO) hnixEvalText opts src = case parseNixText src of Failure err -> error $ "Parsing failed for expressien `" ++ unpack src ++ "`.\n" ++ show err Success expr -> + -- runStdLazyM opts $ normalForm =<< nixEvalExpr Nothing expr runStdLazyM opts $ normalForm =<< nixEvalExpr Nothing expr nixEvalString :: String -> IO String