diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2022-06-04 19:38:24 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2022-06-05 17:57:19 +0200 |
commit | 384d1bddebc3909ebd5dc16ca9a9cd0b64c8786c (patch) | |
tree | 220fb940b9cd05a27251d4ee1df862175efbb510 /src/Test.hs | |
parent | a01feb5be27323ebb4a61bf02f1f67ed6e3799c2 (diff) |
Variable expansion in strings and regexes
Diffstat (limited to 'src/Test.hs')
-rw-r--r-- | src/Test.hs | 42 |
1 files changed, 40 insertions, 2 deletions
diff --git a/src/Test.hs b/src/Test.hs index 465b424..d652f9b 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -4,12 +4,21 @@ module Test ( ProcName(..), textProcName, unpackProcName, NodeName(..), textNodeName, unpackNodeName, + + MonadEval(..), + VarName(..), unpackVarName, + StringExpr(..), evalStringExpr, + RegexExpr(..), evalRegexExpr, ) where +import Control.Monad + +import Data.List import Data.Text (Text) import qualified Data.Text as T import Text.Regex.TDFA +import Text.Regex.TDFA.String import Process @@ -19,8 +28,8 @@ data Test = Test } data TestStep = Spawn ProcName NodeName - | Send ProcName Text - | Expect ProcName Regex Text + | Send ProcName StringExpr + | Expect ProcName RegexExpr | Wait newtype NodeName = NodeName Text @@ -31,3 +40,32 @@ textNodeName (NodeName name) = name unpackNodeName :: NodeName -> String unpackNodeName (NodeName tname) = T.unpack tname + + +class Monad m => MonadEval m where + lookupStringVar :: VarName -> m Text + + +data VarName = VarName [Text] + deriving (Eq, Ord) + +unpackVarName :: VarName -> String +unpackVarName (VarName name) = concat $ intersperse "." $ map T.unpack name + +data StringExpr = StringExpr [Either Text VarName] + +evalStringExpr :: MonadEval m => StringExpr -> m Text +evalStringExpr (StringExpr xs) = fmap T.concat $ forM xs $ \case + Left text -> return text + Right var -> lookupStringVar var + +data RegexExpr = RegexExpr [Either String VarName] + +evalRegexExpr :: (MonadFail m, MonadEval m) => RegexExpr -> m Regex +evalRegexExpr (RegexExpr xs) = do + parts <- forM xs $ \case + Left str -> return str + Right var -> concatMap (\c -> ['\\',c]) . T.unpack <$> lookupStringVar var + case compile defaultCompOpt defaultExecOpt $ concat $ concat [["^"], parts, ["$"]] of + Left err -> fail err + Right re -> return re |