mirror of https://github.com/voidlizard/hbs2
and it works
This commit is contained in:
parent
c97a7c1bb3
commit
65f95fd3fb
|
@ -3,36 +3,43 @@
|
||||||
module TestUniqProtoId where
|
module TestUniqProtoId where
|
||||||
|
|
||||||
import HBS2.Prelude
|
import HBS2.Prelude
|
||||||
|
import HBS2.Prelude.Plated
|
||||||
|
|
||||||
import HasProtocol
|
import HasProtocol
|
||||||
import FakeMessaging
|
import FakeMessaging
|
||||||
|
|
||||||
|
import Data.ByteString.Lazy (ByteString)
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
|
import Codec.Serialise hiding (encode,decode)
|
||||||
|
|
||||||
import Prettyprinter hiding (pipe)
|
import Prettyprinter hiding (pipe)
|
||||||
|
|
||||||
|
|
||||||
data PingPong e = Ping Int
|
data PingPong e = Ping Int
|
||||||
| Pong Int
|
| Pong Int
|
||||||
deriving stock (Show,Read)
|
deriving stock (Generic,Show,Read)
|
||||||
|
|
||||||
data PeekPoke e = Peek Int
|
data PeekPoke e = Peek Int
|
||||||
| Poke Int
|
| Poke Int
|
||||||
| Nop
|
| Nop
|
||||||
deriving stock (Show,Read)
|
deriving stock (Generic,Show,Read)
|
||||||
|
|
||||||
|
|
||||||
|
instance Serialise (PingPong e)
|
||||||
|
|
||||||
|
instance Serialise (PeekPoke e)
|
||||||
|
|
||||||
instance HasProtocol Fake (PingPong Fake) where
|
instance HasProtocol Fake (PingPong Fake) where
|
||||||
type instance ProtocolId (PingPong Fake) = 1
|
type instance ProtocolId (PingPong Fake) = 1
|
||||||
type instance Encoded Fake = String
|
type instance Encoded Fake = ByteString
|
||||||
decode = readMay
|
decode = either (const Nothing) Just . deserialiseOrFail
|
||||||
encode = show
|
encode = serialise
|
||||||
|
|
||||||
instance HasProtocol Fake (PeekPoke Fake) where
|
instance HasProtocol Fake (PeekPoke Fake) where
|
||||||
type instance ProtocolId (PeekPoke Fake) = 2
|
type instance ProtocolId (PeekPoke Fake) = 2
|
||||||
type instance Encoded Fake = String
|
type instance Encoded Fake = ByteString
|
||||||
decode = readMay
|
decode = either (const Nothing) Just . deserialiseOrFail
|
||||||
encode = show
|
encode = serialise
|
||||||
|
|
||||||
pingPongHandler :: forall e m . ( MonadIO m
|
pingPongHandler :: forall e m . ( MonadIO m
|
||||||
, Response e (PingPong e) m
|
, Response e (PingPong e) m
|
||||||
|
|
Loading…
Reference in New Issue