summaryrefslogtreecommitdiff
path: root/src/Test.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-11-10 11:25:29 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2024-11-12 22:45:56 +0100
commit20f8105e32b5c8d97b67f32b751f01904252ac1f (patch)
treeaff5500ef7567835715922e3f176abb7b3419eea /src/Test.hs
parent6447095bcffd101507afb65854da22bd4ee6fcaa (diff)
Remove ExprStatement in favor of using Expr TestBlock
Diffstat (limited to 'src/Test.hs')
-rw-r--r--src/Test.hs32
1 files changed, 19 insertions, 13 deletions
diff --git a/src/Test.hs b/src/Test.hs
index 58c8667..42012d3 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -46,30 +46,30 @@ import Util
data Module = Module
{ moduleName :: [ Text ]
, moduleTests :: [ Test ]
- , moduleDefinitions :: [ ( VarName, SomeVarValue ) ]
+ , moduleDefinitions :: [ ( VarName, SomeExpr ) ]
}
data Test = Test
{ testName :: Text
- , testSteps :: [TestStep]
+ , testSteps :: Expr TestBlock
}
newtype TestBlock = TestBlock [ TestStep ]
+ deriving (Semigroup, Monoid)
-data TestStep = forall a. ExprType a => Let SourceLine (TypedVarName a) (Expr a) [TestStep]
- | forall a. ExprType a => For SourceLine (TypedVarName a) (Expr [a]) [TestStep]
- | ExprStatement (Expr TestBlock)
- | Subnet (TypedVarName Network) (Expr Network) [TestStep]
- | DeclNode (TypedVarName Node) (Expr Network) [TestStep]
- | Spawn (TypedVarName Process) (Either (Expr Network) (Expr Node)) [TestStep]
+data TestStep = forall a. ExprType a => Let SourceLine (TypedVarName a) (Expr a) (Expr TestBlock)
+ | forall a. ExprType a => For SourceLine (TypedVarName a) (Expr [ a ]) (Expr TestBlock)
+ | Subnet (TypedVarName Network) (Expr Network) (Expr TestBlock)
+ | DeclNode (TypedVarName Node) (Expr Network) (Expr TestBlock)
+ | Spawn (TypedVarName Process) (Either (Expr Network) (Expr Node)) (Expr TestBlock)
| Send (Expr Process) (Expr Text)
- | Expect SourceLine (Expr Process) (Expr Regex) [TypedVarName Text] [TestStep]
+ | Expect SourceLine (Expr Process) (Expr Regex) [ TypedVarName Text ] (Expr TestBlock)
| Flush (Expr Process) (Maybe (Expr Regex))
| Guard SourceLine (Expr Bool)
- | DisconnectNode (Expr Node) [TestStep]
- | DisconnectNodes (Expr Network) [TestStep]
- | DisconnectUpstream (Expr Network) [TestStep]
- | PacketLoss (Expr Scientific) (Expr Node) [TestStep]
+ | DisconnectNode (Expr Node) (Expr TestBlock)
+ | DisconnectNodes (Expr Network) (Expr TestBlock)
+ | DisconnectUpstream (Expr Network) (Expr TestBlock)
+ | PacketLoss (Expr Scientific) (Expr Node) (Expr TestBlock)
| Wait
newtype SourceLine = SourceLine Text
@@ -229,6 +229,12 @@ instance Applicative Expr where
pure = Pure
(<*>) = App AnnNone
+instance Semigroup a => Semigroup (Expr a) where
+ e <> f = (<>) <$> e <*> f
+
+instance Monoid a => Monoid (Expr a) where
+ mempty = Pure mempty
+
eval :: MonadEval m => Expr a -> m a
eval (Variable sline name) = fromSomeVarValue sline name =<< lookupVar name
eval (DynVariable _ _ _) = fail "ambiguous type"