erebos-tester 0.2.3 → 0.2.4

raw patch · 9 files changed

+30/−28 lines, 9 files

Files

• CHANGELOG.md +5/−0
• erebos-tester.cabal +1/−1
• src/Network.hs +0/−2
• src/Parser.hs +1/−0
• src/Parser/Core.hs +2/−7
• src/Parser/Expr.hs +17/−8
• src/Parser/Statement.hs +1/−1
• src/Process.hs +0/−1
• src/Test.hs +3/−8

@@ -1,5 +1,10 @@ # Revision history for erebos-tester +## 0.2.4 -- 2024-08-13++* Fix build with mtl-2.3+* Fix type error reporting for some command parameters+ ## 0.2.3 -- 2024-08-10  * Added `network` member to the `node` object

@@ -1,7 +1,7 @@ cabal-version:       3.0  name:                erebos-tester-version:             0.2.3+version:             0.2.4 synopsis:            Test framework with virtual network using Linux namespaces description:     This framework is intended mainly for networking libraries/applications and

@@ -101,12 +101,10 @@ instance ExprType Network where     textExprType _ = T.pack "network"     textExprValue n = "s:" <> textNetworkName (netPrefix n)-    emptyVarValue = Network (IpPrefix []) undefined undefined undefined undefined undefined undefined  instance ExprType Node where     textExprType _ = T.pack "node"     textExprValue n = T.pack "n:" <> textNodeName (nodeName n)-    emptyVarValue = Node (IpAddress (IpPrefix []) 0) (NodeName T.empty 0) undefined undefined undefined undefined      recordMembers = map (first T.pack)         [ ("ip", RecordSelector $ textIpAddress . nodeIp)

@@ -4,6 +4,7 @@     parseTestFile, ) where +import Control.Monad import Control.Monad.State import Control.Monad.Writer 

@@ -6,7 +6,6 @@  import Data.Text (Text) import qualified Data.Text.Lazy as TL-import Data.Typeable import Data.Void  import Text.Megaparsec hiding (State)@@ -28,15 +27,11 @@     , testContext :: SomeExpr     } -someEmptyVar :: SomeExprType -> SomeVarValue-someEmptyVar (SomeExprType (Proxy :: Proxy a)) = SomeVarValue $ emptyVarValue @a- textSomeExprType :: SomeExprType -> Text 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+lookupVarType :: VarName -> TestParser SomeExprType+lookupVarType name = maybe (fail $ "variable not in scope: '" ++ unpackVarName name ++ "'") return =<< gets (lookup name . testVars)  skipLineComment :: TestParser () skipLineComment = L.skipLineComment $ TL.pack "#"

@@ -26,7 +26,9 @@  import Text.Megaparsec hiding (State) import Text.Megaparsec.Char-import qualified Text.Megaparsec.Char.Lexer as L+import Text.Megaparsec.Char.Lexer qualified as L+import Text.Regex.TDFA qualified as RE+import Text.Regex.TDFA.Text qualified as RE  import Parser.Core import Test@@ -58,7 +60,7 @@     void $ char '$'     choice         [do name <- VarName . TL.toStrict <$> takeWhile1P Nothing (\x -> isAlphaNum x || x == '_')-            SomeVarValue (_ :: a) <- lookupVar name+            SomeExprType (_ :: Proxy a) <- lookupVarType name             return $ SomeExpr $ Variable @a name         , between (char '{') (char '}') someExpr         ]@@ -70,7 +72,7 @@     let err = do             registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat                 [ tname, T.pack " expansion not defined for '", textExprType e, T.pack "'" ]-            return $ Pure emptyVarValue+            return $ Undefined "expansion not defined for type"      maybe err return $ listToMaybe $ catMaybes $ conv e @@ -111,6 +113,7 @@  regex :: TestParser (Expr Regex) regex = label "regular expression" $ lexeme $ do+    off <- stateOffset <$> getParserState     void $ char '/'     let inner = choice             [ char '/' >> return []@@ -129,9 +132,15 @@                     ]                 (e:) <$> inner             ]-    expr <- Regex <$> inner-    _ <- eval expr -- test regex parsing with empty variables-    return expr+    parts <- inner+    let testEval = \case+            Pure (RegexPart p) -> p+            _ -> ""+    case RE.compile RE.defaultCompOpt RE.defaultExecOpt $ T.concat $ map testEval parts of+        Left err -> registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat+            [ "failed to parse regular expression: ", T.pack err ]+        Right _ -> return ()+    return $ Regex parts  list :: TestParser SomeExpr list = label "list" $ do@@ -307,7 +316,7 @@      variable = label "variable" $ do         name <- varName-        SomeVarValue (_ :: a) <- lookupVar name+        SomeExprType (_ :: Proxy a) <- lookupVarType name         return $ return $ SomeExpr $ Variable @a name  typedExpr :: forall a. ExprType a => TestParser (Expr a)@@ -317,5 +326,5 @@     let err = do             registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat                 [ T.pack "expected '", textExprType @a Proxy, T.pack "', expression has type '", textExprType e, T.pack "'" ]-            return $ Pure emptyVarValue+            return $ Undefined "unexpected type"     maybe err return $ cast e

@@ -123,7 +123,7 @@     type ParamRep (Either a b) = Either (ParamRep a) (ParamRep b)     parseParam _ = try' (Left <$> parseParam @a Proxy) <|> (Right <$> parseParam @b Proxy)       where-        try' act = try $ do+        try' act = try $ region id $ do             x <- act             (stateParseErrors <$> getParserState) >>= \case                 [] -> return x

@@ -50,7 +50,6 @@ instance ExprType Process where     textExprType _ = T.pack "proc"     textExprValue n = T.pack "p:" <> textProcName (procName n)-    emptyVarValue = Process (ProcName T.empty) undefined undefined undefined undefined emptyVarValue      recordMembers = map (first T.pack)         [ ("node", RecordSelector $ procNode)

@@ -84,7 +84,6 @@ class Typeable a => ExprType a where     textExprType :: proxy a -> Text     textExprValue :: a -> Text-    emptyVarValue :: a      recordMembers :: [(Text, RecordSelector a)]     recordMembers = []@@ -98,42 +97,35 @@ instance ExprType Integer where     textExprType _ = T.pack "integer"     textExprValue x = T.pack (show x)-    emptyVarValue = 0      exprEnumerator _ = Just $ ExprEnumerator enumFromTo enumFromThenTo  instance ExprType Scientific where     textExprType _ = T.pack "number"     textExprValue x = T.pack (show x)-    emptyVarValue = 0  instance ExprType Bool where     textExprType _ = T.pack "bool"     textExprValue True = T.pack "true"     textExprValue False = T.pack "false"-    emptyVarValue = False  instance ExprType Text where     textExprType _ = T.pack "string"     textExprValue x = T.pack (show x)-    emptyVarValue = T.empty  instance ExprType Regex where     textExprType _ = T.pack "regex"     textExprValue _ = T.pack "<regex>"-    emptyVarValue = either error id $ regexCompile T.empty  instance ExprType a => ExprType [a] where     textExprType _ = "[" <> textExprType @a Proxy <> "]"     textExprValue x = "[" <> T.intercalate ", " (map textExprValue x) <> "]"-    emptyVarValue = []      exprListUnpacker _ = Just $ ExprListUnpacker id (const Proxy)  instance ExprType TestBlock where     textExprType _ = "test block"     textExprValue _ = "<test block>"-    emptyVarValue = TestBlock []   data SomeExpr = forall a. ExprType a => SomeExpr (Expr a)@@ -171,6 +163,7 @@     Concat :: [Expr Text] -> Expr Text     Regex :: [Expr Regex] -> Expr Regex     RootNetwork :: Expr Network+    Undefined :: String -> Expr a  data AppAnnotation b = AnnNone                      | ExprType b => AnnRecord Text@@ -193,6 +186,7 @@         Left err -> fail err         Right re -> return re eval (RootNetwork) = rootNetwork+eval (Undefined err) = fail err  gatherVars :: forall a m. MonadEval m => Expr a -> m [((VarName, [Text]), SomeVarValue)] gatherVars = fmap (uniqOn fst . sortOn fst) . helper@@ -209,6 +203,7 @@     helper (Concat es) = concat <$> mapM helper es     helper (Regex es) = concat <$> mapM helper es     helper (RootNetwork) = return []+    helper (Undefined {}) = return []      gatherSelectors :: forall b. Expr b -> Maybe (VarName, [Text])     gatherSelectors = \case