diff options
Diffstat (limited to 'src/Parser.hs')
| -rw-r--r-- | src/Parser.hs | 22 |
1 files changed, 13 insertions, 9 deletions
diff --git a/src/Parser.hs b/src/Parser.hs index 903ad54..f8c5b0e 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -29,7 +29,7 @@ import qualified Text.Megaparsec.Char.Lexer as L import System.Exit -import Network (Node) +import Network (Network, Node) import Process (Process, ProcName(..)) import Test import Util @@ -40,7 +40,7 @@ type TestStream = TL.Text data TestParserState = TestParserState { testVars :: [(VarName, SomeExprType)] - , testContext :: Maybe SomeExpr + , testContext :: SomeExpr } data SomeExprType = forall a. ExprType a => SomeExprType (Proxy a) @@ -53,6 +53,7 @@ textSomeExprType (SomeExprType p) = textExprType p instance MonadEval TestParser where lookupVar name = maybe (fail $ "variable not in scope: '" ++ unpackVarName name ++ "'") (return . someEmptyVar) =<< gets (lookup name . testVars) + rootNetwork = return emptyVarValue skipLineComment :: TestParser () skipLineComment = L.skipLineComment $ TL.pack "#" @@ -386,13 +387,13 @@ instance ParamType a => ParamType [a] where parseParam _ = listOf (parseParam @a Proxy) showParamType _ = showParamType @a Proxy ++ " [, " ++ showParamType @a Proxy ++ " ...]" paramDefault _ = return [] - paramFromSomeExpr _ (SomeExpr e) = cast e <|> ((:[]) <$> cast e) + paramFromSomeExpr _ se@(SomeExpr e) = cast e <|> ((:[]) <$> paramFromSomeExpr @a Proxy se) instance (ParamType a, ParamType b) => ParamType (Either a b) where type ParamRep (Either a b) = Either (ParamRep a) (ParamRep b) parseParam _ = try (Left <$> parseParam @a Proxy) <|> (Right <$> parseParam @b Proxy) showParamType _ = showParamType @a Proxy ++ " or " ++ showParamType @b Proxy - paramFromSomeExpr _ (SomeExpr e) = (Left <$> cast e) <|> (Right <$> cast e) + paramFromSomeExpr _ se = (Left <$> paramFromSomeExpr @a Proxy se) <|> (Right <$> paramFromSomeExpr @b Proxy se) data SomeParam f = forall a. ParamType a => SomeParam (Proxy a) (f (ParamRep a)) @@ -418,8 +419,9 @@ instance ParamType a => ParamType (ParamOrContext a) where parseParam _ = parseParam @a Proxy showParamType _ = showParamType @a Proxy paramDefault _ = gets testContext >>= \case - Just se | Just e <- paramFromSomeExpr @a Proxy se -> return e - _ -> fail $ showParamType @a Proxy <> " not available from context" + se@(SomeExpr ctx) + | Just e <- paramFromSomeExpr @a Proxy se -> return e + | otherwise -> fail $ showParamType @a Proxy <> " not available from context type '" <> T.unpack (textExprType ctx) <> "'" paramOrContext :: forall a. ParamType a => String -> CommandDef a paramOrContext name = CommandDef [(name, SomeParam (Proxy @(ParamOrContext a)) Proxy)] (\[SomeParam Proxy (Identity x)] -> fromJust $ cast x) @@ -515,7 +517,8 @@ testWith = do off <- stateOffset <$> getParserState ctx@(SomeExpr (_ :: Expr ctxe)) <- someExpr let expected = - [ SomeExprType @Node Proxy + [ SomeExprType @Network Proxy + , SomeExprType @Node Proxy , SomeExprType @Process Proxy ] notAllowed <- flip allM expected $ \case @@ -529,12 +532,13 @@ testWith = do indent <- L.indentGuard scn GT ref localState $ do - modify $ \s -> s { testContext = Just ctx } + modify $ \s -> s { testContext = ctx } testBlock indent testNode :: TestParser [TestStep] testNode = command "node" $ DeclNode <$> param "" + <*> paramOrContext "on" <*> innerBlock testSpawn :: TestParser [TestStep] @@ -617,7 +621,7 @@ parseTestFile path = do content <- TL.readFile path let initState = TestParserState { testVars = [] - , testContext = Nothing + , testContext = SomeExpr RootNetwork } case evalState (runParserT parseTestDefinitions path content) initState of Left err -> putStr (errorBundlePretty err) >> exitFailure |