wip

hbs2-core/test/TestAbstractDispatch.hs

@@ -20,6 +20,7 @@ import Data.Word
 import Data.Dynamic
 import Prettyprinter
 import System.Random qualified as Random
+import GHC.TypeLits
 import Data.Maybe
 
 import FakeMessaging
@@ -36,10 +37,18 @@ class Monad m => CookieGenerator p m where
 class Monad m => HasTimeout msg m where
   timeoutFor :: Proxy msg -> m (Timeout 'Seconds)
 
+class HasCookie p msg | msg -> p where
+  getCookie :: msg -> Maybe (Cookie p)
+
 -- still okay
 
 type family Encoded  p :: Type
 
+type family ProtoId p m :: Nat
+
+class Registered msg where
+  protoId :: Proxy msg -> Nat
+
 class IsEncoded p msg | msg -> p where
   encode :: msg -> Encoded p
   decode :: Encoded p -> Maybe msg
@@ -74,7 +83,7 @@ data Fabrique p = forall bus . Messaging bus p (MessageWithCookie p)
 data Dispatcher p m =
   Dispatcher
   { self     :: Peer p
-  , handlers :: Cache (Cookie p) (Handler p m)
+  , handlers :: Cache (Cookie p) (Handler p m) --- FIXME: class + maybe cookie
   , fabriq   :: Fabrique p
   }
 
@@ -141,6 +150,9 @@ dispatcher d = fix \next -> do
 
   next
 
+class DefaultAnswer msg p | msg -> p where
+  defAnswer :: msg
+
 data PingPong p = Ping
                 | Pong
                 deriving stock (Typeable)