diff options
Diffstat (limited to 'src/Test.hs')
-rw-r--r-- | src/Test.hs | 32 |
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 |