diff options
Diffstat (limited to 'src/Test/Builtins.hs')
| -rw-r--r-- | src/Test/Builtins.hs | 27 |
1 files changed, 20 insertions, 7 deletions
diff --git a/src/Test/Builtins.hs b/src/Test/Builtins.hs index 69579bc..5f9f890 100644 --- a/src/Test/Builtins.hs +++ b/src/Test/Builtins.hs @@ -4,9 +4,11 @@ module Test.Builtins ( import Data.Map qualified as M import Data.Maybe +import Data.Proxy +import Data.Scientific import Data.Text (Text) -import Process (Process) +import Process import Script.Expr import Test @@ -14,7 +16,9 @@ builtins :: GlobalDefs builtins = M.fromList [ fq "send" builtinSend , fq "flush" builtinFlush + , fq "ignore" builtinIgnore , fq "guard" builtinGuard + , fq "multiply_timeout" builtinMultiplyTimeout , fq "wait" builtinWait ] where @@ -25,11 +29,7 @@ getArg args = fromMaybe (error "parameter mismatch") . getArgMb args getArgMb :: ExprType a => FunctionArguments SomeVarValue -> Maybe ArgumentKeyword -> Maybe a getArgMb (FunctionArguments args) kw = do - fromSomeVarValue SourceLineBuiltin (LocalVarName (VarName "")) =<< M.lookup kw args - -getArgVars :: FunctionArguments SomeVarValue -> Maybe ArgumentKeyword -> [ (( FqVarName, [ Text ] ), SomeVarValue ) ] -getArgVars (FunctionArguments args) kw = do - maybe [] svvVariables $ M.lookup kw args + fromSomeVarValue (CallStack []) (LocalVarName (VarName "")) =<< M.lookup kw args builtinSend :: SomeVarValue builtinSend = SomeVarValue $ VarValue [] (FunctionArguments $ M.fromList atypes) $ @@ -49,9 +49,22 @@ builtinFlush = SomeVarValue $ VarValue [] (FunctionArguments $ M.fromList atypes , ( Just "matching", SomeArgumentType (OptionalArgument @Regex) ) ] +builtinIgnore :: SomeVarValue +builtinIgnore = SomeVarValue $ VarValue [] (FunctionArguments $ M.fromList atypes) $ + \_ args -> TestBlockStep EmptyTestBlock $ CreateObject (Proxy @IgnoreProcessOutput) ( getArg args (Just "from"), getArgMb args (Just "matching") ) + where + atypes = + [ ( Just "from", SomeArgumentType (ContextDefault @Process) ) + , ( Just "matching", SomeArgumentType (OptionalArgument @Regex) ) + ] + builtinGuard :: SomeVarValue builtinGuard = SomeVarValue $ VarValue [] (FunctionArguments $ M.singleton Nothing (SomeArgumentType (RequiredArgument @Bool))) $ - \sline args -> TestBlockStep EmptyTestBlock $ Guard sline (getArgVars args Nothing) (getArg args Nothing) + \stack args -> TestBlockStep EmptyTestBlock $ Guard stack (getArg args Nothing) + +builtinMultiplyTimeout :: SomeVarValue +builtinMultiplyTimeout = SomeVarValue $ VarValue [] (FunctionArguments $ M.singleton (Just "by") (SomeArgumentType (RequiredArgument @Scientific))) $ + \_ args -> TestBlockStep EmptyTestBlock $ CreateObject (Proxy @MultiplyTimeout) (getArg args (Just "by")) builtinWait :: SomeVarValue builtinWait = someConstValue $ TestBlockStep EmptyTestBlock Wait |