wip

hbs2-core/test/HasProtocol.hs

@@ -8,9 +8,11 @@ import GHC.TypeLits
 class HasProtocol a where
   type family ProtocolId  a = (id :: Nat) | id -> a
   type family Encoded a :: Type
+  type family Peer a :: Type
 
   protoId :: forall . KnownNat (ProtocolId a) => Proxy a -> Integer
   protoId _ = natVal (Proxy @(ProtocolId a))
 
-  decode :: String -> Maybe a
+  decode :: Encoded a -> Maybe a
-  encode :: a -> String
+  encode :: a -> Encoded a
+

hbs2-core/test/TestUniqProtoId.hs

@@ -10,7 +10,6 @@ import Data.Proxy
 import Data.Map qualified as Map
 import Data.Map (Map)
 import Control.Monad.Reader
-import Control.Monad.Identity
 
 
 data AnyProtocol m = forall a . ( HasProtocol a
@@ -19,8 +18,8 @@ data AnyProtocol m = forall a . ( HasProtocol a
                                 ) =>
   AnyProtocol
   { getProtoId  :: Integer
-  , protoDecode :: String -> Maybe a
+  , protoDecode :: Encoded a -> Maybe a
-  , protoEncode :: a -> String
+  , protoEncode :: a -> Encoded a
   , handle      :: a -> m ()
   }
 
@@ -32,19 +31,19 @@ data PingPong = Ping Int
 instance HasProtocol PingPong where
   type instance ProtocolId PingPong = 1
   type instance Encoded PingPong = PingPong
-  decode = undefined
+  type instance Peer PingPong = Int
-  encode = undefined
+  decode = Just
-
+  encode = id
 
 class Response p (m :: Type -> Type) where
-  answer :: p -> m ()
+  response :: p -> m ()
 
-makeProtocol :: forall p  m  . ( MonadIO m
+makeProtocol :: forall p t m . ( MonadIO m
-                               , Response p (EngineM m)
+                               , Response p (t m)
                                , HasProtocol p
                                , KnownNat (ProtocolId p)
                                )
-            => (p -> EngineM m ()) -> AnyProtocol (EngineM m)
+            => (p -> t m ()) -> AnyProtocol (t m)
 
 makeProtocol h = AnyProtocol { getProtoId  = natVal (Proxy @(ProtocolId p))
                              , protoDecode = decode @p
@@ -59,7 +58,7 @@ runEngineM :: EngineM m a -> m a
 runEngineM f = runReaderT (fromEngine f) ()
 
 instance (Monad m, HasProtocol p) => Response p (EngineM m) where
-  answer _ = do
+  response _ = do
     -- TODO: get bus
     -- TODO: encode
     -- TODO: sendTo
@@ -74,17 +73,15 @@ testUniqiProtoId = do
   -- TODO: GET RECIPIENT
   -- TODO: GET PROTO-ID FROM MESSAGE
 
-  let pingpong = makeProtocol @PingPong @IO
+  let pingpong = makeProtocol @PingPong @EngineM
         \case
-          Ping c -> lift (print "effect: PING") >> answer (Pong c)
+          Ping c -> lift (print "effect: PING") >> response (Pong c)
           Pong _ -> lift (print "effect: PONG")
 
   -- FIXME: dispatcher!
   case Map.lookup 3 decoders of
-    Just (AnyProtocol {protoDecode = decoder, handle = h}) -> maybe (pure ()) (runEngineM . h) (decoder "AAA")
+    Just (AnyProtocol {protoDecode = decoder, handle = h}) -> maybe (pure ()) (runEngineM . h) (decoder undefined)
     Nothing -> pure ()
 
   pure ()
 
-
-