summaryrefslogtreecommitdiff
path: root/src/Test.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Test.hs')
-rw-r--r--src/Test.hs32
1 files changed, 24 insertions, 8 deletions
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