diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2024-11-29 21:40:16 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-11-29 21:40:16 +0100 |
commit | 1670b628cc7accea1c7ecd9359a7dccb6bd50a45 (patch) | |
tree | efad1d67a737fe654acb8ccfeb3b06fcf767de63 /src/Test.hs | |
parent | 56878ad193071539a1fd83298c4509fe21b880fd (diff) |
Represent root network as an internal variable
Diffstat (limited to 'src/Test.hs')
-rw-r--r-- | src/Test.hs | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/src/Test.hs b/src/Test.hs index d0f1e45..effd00a 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -6,7 +6,7 @@ module Test ( SourceLine(..), textSourceLine, MonadEval(..), - VarName(..), TypedVarName(..), textVarName, unpackVarName, + VarName(..), TypedVarName(..), textVarName, unpackVarName, withTypedVar, ExprType(..), SomeExpr(..), TypeVar(..), SomeExprType(..), someExprType, textSomeExprType, FunctionType, DynamicType, @@ -19,7 +19,7 @@ module Test ( RecordSelector(..), ExprListUnpacker(..), ExprEnumerator(..), - Expr(..), eval, evalSome, + Expr(..), varExpr, eval, evalSome, EvalTrace, VarNameSelectors, gatherVars, AppAnnotation(..), @@ -90,7 +90,6 @@ textSourceLine SourceLineBuiltin = "<builtin>" class MonadFail m => MonadEval m where lookupVar :: VarName -> m SomeVarValue - rootNetwork :: m Network withVar :: ExprType e => VarName -> e -> m a -> m a @@ -106,6 +105,14 @@ textVarName (VarName name ) = name unpackVarName :: VarName -> String unpackVarName = T.unpack . textVarName +isInternalVar :: VarName -> Bool +isInternalVar (VarName name) + | Just ( '$', _ ) <- T.uncons name = True + | otherwise = False + +withTypedVar :: (MonadEval m, ExprType e) => TypedVarName e -> e -> m a -> m a +withTypedVar (TypedVarName name) = withVar name + class Typeable a => ExprType a where textExprType :: proxy a -> Text @@ -253,7 +260,6 @@ data Expr a where App :: AppAnnotation b -> Expr (a -> b) -> Expr a -> Expr b Concat :: [Expr Text] -> Expr Text Regex :: [Expr Regex] -> Expr Regex - RootNetwork :: Expr Network Undefined :: String -> Expr a data AppAnnotation b = AnnNone @@ -272,6 +278,9 @@ instance Semigroup a => Semigroup (Expr a) where instance Monoid a => Monoid (Expr a) where mempty = Pure mempty +varExpr :: ExprType a => SourceLine -> TypedVarName a -> Expr a +varExpr sline (TypedVarName name) = Variable sline name + eval :: forall m a. MonadEval m => Expr a -> m a eval = \case Variable sline name -> fromSomeVarValue sline name =<< lookupVar name @@ -292,7 +301,6 @@ eval = \case parts -> case regexCompile $ T.concat $ map regexSource parts of Left err -> fail err Right re -> return re - RootNetwork -> rootNetwork Undefined err -> fail err evalSome :: MonadEval m => SomeExpr -> m SomeVarValue @@ -309,7 +317,9 @@ gatherVars = fmap (uniqOn fst . sortOn fst) . helper where helper :: forall b. Expr b -> m EvalTrace helper = \case - Variable _ var -> (: []) . (( var, [] ), ) <$> lookupVar var + Variable _ var + | isInternalVar var -> return [] + | otherwise -> (: []) . (( var, [] ), ) <$> lookupVar var DynVariable _ _ var -> (: []) . (( var, [] ), ) <$> lookupVar var FunVariable _ _ var -> (: []) . (( var, [] ), ) <$> lookupVar var ArgsApp (FunctionArguments args) fun -> do @@ -328,7 +338,6 @@ gatherVars = fmap (uniqOn fst . sortOn fst) . helper App _ f x -> (++) <$> helper f <*> helper x Concat es -> concat <$> mapM helper es Regex es -> concat <$> mapM helper es - RootNetwork -> return [] Undefined {} -> return [] gatherSelectors :: forall b. Expr b -> Maybe (VarName, [Text]) |