From c558b300a3353edf7c88a2c363cb6bc7b7c1dcb7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 21 Sep 2025 22:49:21 +0200
Subject: Require result of TestBlock to be ExprType instance

---
 src/Process.hs           |  3 +++
 src/Script/Expr/Class.hs |  4 ++++
 src/Script/Object.hs     | 11 +++++++++++
 src/Test.hs              |  7 +++++--
 4 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/src/Process.hs b/src/Process.hs
index 57411d7..1389987 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -199,6 +199,9 @@ data IgnoreProcessOutput = IgnoreProcessOutput Process Int
 instance ObjectType TestRun IgnoreProcessOutput where
     type ConstructorArgs IgnoreProcessOutput = ( Process, Maybe Regex )
 
+    textObjectType _ _ = "IgnoreProcessOutput"
+    textObjectValue _ (IgnoreProcessOutput _ _) = "<IgnoreProcessOutput>"
+
     createObject oid ( process@Process {..}, regex ) = do
         liftIO $ atomically $ do
             flushProcessOutput process regex
diff --git a/src/Script/Expr/Class.hs b/src/Script/Expr/Class.hs
index 20a92b4..005b6a8 100644
--- a/src/Script/Expr/Class.hs
+++ b/src/Script/Expr/Class.hs
@@ -39,6 +39,10 @@ data ExprListUnpacker a = forall e. ExprType e => ExprListUnpacker (a -> [e]) (P
 data ExprEnumerator a = ExprEnumerator (a -> a -> [a]) (a -> a -> a -> [a])
 
 
+instance ExprType () where
+    textExprType _ = "Unit"
+    textExprValue () = "()"
+
 instance ExprType Integer where
     textExprType _ = T.pack "integer"
     textExprValue x = T.pack (show x)
diff --git a/src/Script/Object.hs b/src/Script/Object.hs
index 9232b21..7e60f80 100644
--- a/src/Script/Object.hs
+++ b/src/Script/Object.hs
@@ -7,8 +7,11 @@ module Script.Object (
 ) where
 
 import Data.Kind
+import Data.Text (Text)
 import Data.Typeable
 
+import Script.Expr.Class
+
 
 newtype ObjectId = ObjectId Int
 
@@ -16,9 +19,17 @@ class Typeable a => ObjectType m a where
     type ConstructorArgs a :: Type
     type ConstructorArgs a = ()
 
+    textObjectType :: proxy (m a) -> proxy a -> Text
+    textObjectValue :: proxy (m a) -> a -> Text
+
     createObject :: ObjectId -> ConstructorArgs a -> m (Object m a)
     destroyObject :: Object m a -> m ()
 
+instance (Typeable m, ObjectType m a) => ExprType (Object m a) where
+    textExprType _ = textObjectType (Proxy @(m a)) (Proxy @a)
+    textExprValue = textObjectValue (Proxy @(m a)) . objImpl
+
+
 data Object m a = ObjectType m a => Object
     { objId :: ObjectId
     , objImpl :: a
diff --git a/src/Test.hs b/src/Test.hs
index 1481b2b..9ba185b 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -12,7 +12,7 @@ import Control.Monad.Reader
 
 import Data.Bifunctor
 import Data.Scientific
-import Data.Text (Text)
+import Data.Text (Text, pack)
 import Data.Typeable
 
 import Network
@@ -57,7 +57,7 @@ data TestStep a where
     PacketLoss :: Scientific -> Node -> TestStep a -> TestStep a
     Wait :: TestStep ()
 
-instance Typeable a => ExprType (TestBlock a) where
+instance ExprType a => ExprType (TestBlock a) where
     textExprType _ = "test block"
     textExprValue _ = "<test block>"
 
@@ -67,6 +67,9 @@ data MultiplyTimeout = MultiplyTimeout Scientific
 instance ObjectType TestRun MultiplyTimeout where
     type ConstructorArgs MultiplyTimeout = Scientific
 
+    textObjectType _ _ = "MultiplyTimeout"
+    textObjectValue _ (MultiplyTimeout x) = pack (show x) <> "@MultiplyTimeout"
+
     createObject oid timeout
         | timeout >= 0 = do
             var <- asks (teTimeout . fst)
-- 
cgit v1.2.3