Represent root network as an internal variable

5 files changed, 26 insertions, 16 deletions

diff --git a/src/Network.hs b/src/Network.hs
index aa06952..c841acb 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -5,6 +5,7 @@ module Network (
     NodeName(..), textNodeName, unpackNodeName,
     nextNodeName,
 
+    rootNetworkVar,
     newInternet, delInternet,
     newSubnet,
     newNode,
@@ -112,6 +113,9 @@ instance ExprType Node where
         ]
 
 
+rootNetworkVar :: TypedVarName Network
+rootNetworkVar = TypedVarName (VarName "$ROOT_NET")
+
 nextPrefix :: IpPrefix -> [Word8] -> Word8
 nextPrefix _ used = maximum (0 : used) + 1
 
diff --git a/src/Parser.hs b/src/Parser.hs
index 4b1e69a..ab44833 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -22,6 +22,7 @@ import System.Directory
 import System.Exit
 import System.FilePath
 
+import Network
 import Parser.Core
 import Parser.Expr
 import Parser.Statement
@@ -83,7 +84,7 @@ parseTestFile path = do
             { testVars = concat
                 [ map (fmap someVarValueType) builtins
                 ]
-            , testContext = SomeExpr RootNetwork
+            , testContext = SomeExpr $ varExpr SourceLineBuiltin rootNetworkVar
             , testNextTypeVar = 0
             , testTypeUnif = M.empty
             }
diff --git a/src/Run.hs b/src/Run.hs
index fd02af3..54fdba6 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -59,8 +59,7 @@ runTest out opts test variables = do
             , teGDB = fst <$> mgdb
             }
         tstate = TestState
-            { tsNetwork = error "network not initialized"
-            , tsVars = builtins
+            { tsVars = builtins
             , tsNodePacketLoss = M.empty
             , tsDisconnectedUp = S.empty
             , tsDisconnectedBridge = S.empty
@@ -184,7 +183,8 @@ withInternet inner = do
     testDir <- asks $ optTestDir . teOptions . fst
     inet <- newInternet testDir
     res <- withNetwork (inetRoot inet) $ \net -> do
-        local (fmap $ \s -> s { tsNetwork = net }) $ inner net
+        withTypedVar rootNetworkVar net $ do
+            inner net
     delInternet inet
     return res
 
diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index 512dd72..2882197 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -21,7 +21,6 @@ import Data.Scientific
 import qualified Data.Text as T
 
 import {-# SOURCE #-} GDB
-import {-# SOURCE #-} Network
 import Network.Ip
 import Output
 import {-# SOURCE #-} Process
@@ -39,8 +38,7 @@ data TestEnv = TestEnv
     }
 
 data TestState = TestState
-    { tsNetwork :: Network
-    , tsVars :: [(VarName, SomeVarValue)]
+    { tsVars :: [(VarName, SomeVarValue)]
     , tsDisconnectedUp :: Set NetworkNamespace
     , tsDisconnectedBridge :: Set NetworkNamespace
     , tsNodePacketLoss :: Map NetworkNamespace Scientific
@@ -94,8 +92,6 @@ instance MonadError Failed TestRun where
 
 instance MonadEval TestRun where
     lookupVar name = maybe (fail $ "variable not in scope: '" ++ unpackVarName name ++ "'") return =<< asks (lookup name . tsVars . snd)
-    rootNetwork = asks $ tsNetwork . snd
-
     withVar name value = local (fmap $ \s -> s { tsVars = ( name, someConstValue value ) : tsVars s })
 
 instance MonadOutput TestRun where
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])