summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-08-11 10:43:36 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2024-08-11 10:55:34 +0200
commita0480b7ac0705a214136a9a5eb50454abfd67985 (patch)
tree6532616bd61bc4771a08a4b6151dad03d9eea529
parente6bab9cb2aabafb27324f7d923739a8f4a96ad97 (diff)
Remove emptyVarValue from ExprType class
-rw-r--r--src/Network.hs2
-rw-r--r--src/Parser/Expr.hs4
-rw-r--r--src/Process.hs1
-rw-r--r--src/Test.hs11
4 files changed, 5 insertions, 13 deletions
diff --git a/src/Network.hs b/src/Network.hs
index 7f0896c..aa06952 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -101,12 +101,10 @@ instance HasNetns Node where getNetns = nodeNetns
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)
diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs
index 9c0a1de..8ea3ace 100644
--- a/src/Parser/Expr.hs
+++ b/src/Parser/Expr.hs
@@ -72,7 +72,7 @@ stringExpansion tname conv = do
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
@@ -326,5 +326,5 @@ typedExpr = do
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
diff --git a/src/Process.hs b/src/Process.hs
index d048792..48ed40f 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -50,7 +50,6 @@ instance Eq Process where
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)
diff --git a/src/Test.hs b/src/Test.hs
index e2f829b..ba27153 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -84,7 +84,6 @@ unpackVarName = T.unpack . textVarName
class Typeable a => ExprType a where
textExprType :: proxy a -> Text
textExprValue :: a -> Text
- emptyVarValue :: a
recordMembers :: [(Text, RecordSelector a)]
recordMembers = []
@@ -98,42 +97,35 @@ class Typeable a => ExprType a where
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 @@ data Expr a where
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 @@ eval (Regex xs) = mapM eval xs >>= \case
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 @@ gatherVars = fmap (uniqOn fst . sortOn fst) . helper
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