From 6447095bcffd101507afb65854da22bd4ee6fcaa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sat, 9 Nov 2024 19:29:06 +0100 Subject: Move withVar into MonadEval type class --- src/Run.hs | 3 --- src/Run/Monad.hs | 2 ++ src/Test.hs | 5 +++-- 3 files changed, 5 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/Run.hs b/src/Run.hs index 1cb04bb..2fa1989 100644 --- a/src/Run.hs +++ b/src/Run.hs @@ -186,9 +186,6 @@ evalSteps = mapM_ $ \case void $ outPromptGetLine "Waiting..." -withVar :: ExprType e => VarName -> e -> TestRun a -> TestRun a -withVar name value = local (fmap $ \s -> s { tsVars = ( name, SomeVarValue mempty $ const $ const value ) : tsVars s }) - withInternet :: (Network -> TestRun a) -> TestRun a withInternet inner = do testDir <- asks $ optTestDir . teOptions . fst diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs index 9ec9065..1890572 100644 --- a/src/Run/Monad.hs +++ b/src/Run/Monad.hs @@ -96,6 +96,8 @@ instance MonadEval TestRun where lookupVar name = maybe (fail $ "variable not in scope: '" ++ unpackVarName name ++ "'") return =<< asks (lookup name . tsVars . snd) rootNetwork = asks $ tsNetwork . snd + withVar name value = local (fmap $ \s -> s { tsVars = ( name, SomeVarValue mempty $ const $ const value ) : tsVars s }) + instance MonadOutput TestRun where getOutput = asks $ teOutput . fst diff --git a/src/Test.hs b/src/Test.hs index 24a4c72..58c8667 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -76,8 +76,9 @@ newtype SourceLine = SourceLine Text class MonadFail m => MonadEval m where - lookupVar :: VarName -> m SomeVarValue - rootNetwork :: m Network + lookupVar :: VarName -> m SomeVarValue + rootNetwork :: m Network + withVar :: ExprType e => VarName -> e -> m a -> m a newtype VarName = VarName Text -- cgit v1.2.3