summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Parser/Expr.hs6
-rw-r--r--src/Run.hs4
-rw-r--r--src/Test.hs32
3 files changed, 29 insertions, 13 deletions
diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs
index eefc5cc..70649b2 100644
--- a/src/Parser/Expr.hs
+++ b/src/Parser/Expr.hs
@@ -289,10 +289,10 @@ someExpr = join inner <?> "expression"
SomeExpr e <- p
let err = parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat
[ T.pack "value of type ", textExprType e, T.pack " does not have member '", m, T.pack "'" ]
- maybe err return $ applyRecordSelector e <$> lookup m recordMembers
+ maybe err return $ applyRecordSelector m e <$> lookup m recordMembers
- applyRecordSelector :: ExprType a => Expr a -> RecordSelector a -> SomeExpr
- applyRecordSelector e (RecordSelector f) = SomeExpr $ f <$> e
+ applyRecordSelector :: ExprType a => Text -> Expr a -> RecordSelector a -> SomeExpr
+ applyRecordSelector m e (RecordSelector f) = SomeExpr $ App (AnnRecord m) (pure f) e
literal = label "literal" $ choice
[ return <$> numberLiteral
diff --git a/src/Run.hs b/src/Run.hs
index 01c4a03..26cc34f 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -266,8 +266,8 @@ exprFailed desc (SourceLine sline) pname expr = do
let prompt = maybe T.empty textProcName pname
exprVars <- gatherVars expr
outLine OutputMatchFail (Just prompt) $ T.concat [desc, T.pack " failed on ", sline]
- forM_ exprVars $ \(name, value) ->
- outLine OutputMatchFail (Just prompt) $ T.concat [T.pack " ", textVarName name, T.pack " = ", textSomeVarValue value]
+ forM_ exprVars $ \((name, sel), value) ->
+ outLine OutputMatchFail (Just prompt) $ T.concat [" ", textVarName name, T.concat (map ("."<>) sel), " = ", textSomeVarValue value]
throwError Failed
expect :: SourceLine -> Process -> Expr Regex -> [TypedVarName Text] -> TestRun () -> TestRun ()
diff --git a/src/Test.hs b/src/Test.hs
index 398fa03..e336858 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -11,6 +11,7 @@ module Test (
ExprListUnpacker(..),
ExprEnumerator(..),
Expr(..), eval, gatherVars,
+ AppAnnotation(..),
Regex(RegexPart, RegexString), regexMatch,
) where
@@ -137,22 +138,25 @@ data ExprEnumerator a = ExprEnumerator (a -> a -> [a]) (a -> a -> a -> [a])
data Expr a where
Variable :: ExprType a => VarName -> Expr a
Pure :: a -> Expr a
- App :: Expr (a -> b) -> Expr a -> Expr b
+ App :: AppAnnotation b -> Expr (a -> b) -> Expr a -> Expr b
Concat :: [Expr Text] -> Expr Text
Regex :: [Expr Regex] -> Expr Regex
RootNetwork :: Expr Network
+data AppAnnotation b = AnnNone
+ | ExprType b => AnnRecord Text
+
instance Functor Expr where
- fmap f x = Pure f `App` x
+ fmap f x = Pure f <*> x
instance Applicative Expr where
pure = Pure
- (<*>) = App
+ (<*>) = App AnnNone
eval :: MonadEval m => Expr a -> m a
eval (Variable name) = fromSomeVarValue name =<< lookupVar name
eval (Pure value) = return value
-eval (App f x) = eval f <*> eval x
+eval (App _ f x) = eval f <*> eval x
eval (Concat xs) = T.concat <$> mapM eval xs
eval (Regex xs) = mapM eval xs >>= \case
[re@RegexCompiled {}] -> return re
@@ -161,17 +165,29 @@ eval (Regex xs) = mapM eval xs >>= \case
Right re -> return re
eval (RootNetwork) = rootNetwork
-gatherVars :: forall a m. MonadEval m => Expr a -> m [(VarName, SomeVarValue)]
+gatherVars :: forall a m. MonadEval m => Expr a -> m [((VarName, [Text]), SomeVarValue)]
gatherVars = fmap (uniqOn fst . sortOn fst) . helper
where
- helper :: forall b. Expr b -> m [(VarName, SomeVarValue)]
- helper (Variable var) = (:[]) . (var,) <$> lookupVar var
+ helper :: forall b. Expr b -> m [((VarName, [Text]), SomeVarValue)]
+ helper (Variable var) = (:[]) . ((var, []),) <$> lookupVar var
helper (Pure _) = return []
- helper (App f x) = (++) <$> helper f <*> helper x
+ helper e@(App (AnnRecord sel) _ x)
+ | Just (var, sels) <- gatherSelectors x
+ = do val <- SomeVarValue <$> eval e
+ return [((var, sels ++ [sel]), val)]
+ | otherwise = helper x
+ helper (App _ f x) = (++) <$> helper f <*> helper x
helper (Concat es) = concat <$> mapM helper es
helper (Regex es) = concat <$> mapM helper es
helper (RootNetwork) = return []
+ gatherSelectors :: forall b. Expr b -> Maybe (VarName, [Text])
+ gatherSelectors = \case
+ Variable var -> Just (var, [])
+ App (AnnRecord sel) _ x -> do
+ (var, sels) <- gatherSelectors x
+ return (var, sels ++ [sel])
+ _ -> Nothing
data Regex = RegexCompiled Text RE.Regex
| RegexPart Text