extensible-effects-concurrent 0.28.0 → 0.29.0

raw patch · 20 files changed

+584/−210 lines, 20 filesdep ~basedep ~deepseqdep ~extensible-effectsnew-component:exe:extensible-effects-concurrent-example-embedded-protocolsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, deepseq, extensible-effects, lens, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• examples/example-1/Main.hs +1/−1
• examples/example-2/Main.hs +4/−3
• examples/example-embedded-protocols/Main.hs +274/−0
• extensible-effects-concurrent.cabal +34/−1
• src/Control/Eff/Concurrent.hs +6/−2
• src/Control/Eff/Concurrent/Process.hs +45/−0
• src/Control/Eff/Concurrent/Process/Interactive.hs +4/−2
• src/Control/Eff/Concurrent/Protocol.hs +129/−136
• src/Control/Eff/Concurrent/Protocol/Client.hs +24/−19
• src/Control/Eff/Concurrent/Protocol/EffectfulServer.hs +1/−1
• src/Control/Eff/Concurrent/Protocol/Observer.hs +13/−5
• src/Control/Eff/Concurrent/Protocol/Observer/Queue.hs +3/−1
• src/Control/Eff/Concurrent/Protocol/StatefulServer.hs +1/−1
• src/Control/Eff/Concurrent/Protocol/Supervisor.hs +1/−1
• src/Control/Eff/Concurrent/Protocol/Wrapper.hs +8/−8
• test/GenServerTests.hs +9/−12
• test/ObserverTests.hs +15/−13
• test/ProcessBehaviourTestCases.hs +3/−3
• test/SupervisorTests.hs +1/−1

@@ -1,5 +1,13 @@ # Changelog for extensible-effects-concurrent +## 0.29.0+- Remove the reply type parameter from `HasPdu` +- Make a new constraint `Embeds` that replaces `EmbedProtocol`+- Rename `EmbedProtocol` to `HasPduPrism`+- Add `EmbeddedPduList` to `HasPdu`+- Add embedded protocols example+- Rename and change `ServesProtocol` to `HasEndpointReader`+ ## 0.28.0 - Simplify `Protocol.Observer` registration API - Rewrite `Protocol.Observer.Queue` API

@@ -18,7 +18,7 @@  type instance ToPretty TestProtocol = PutStr "test" -instance Typeable x => HasPdu TestProtocol x where+instance HasPdu TestProtocol where   data instance Pdu TestProtocol x where     SayHello :: String -> Pdu TestProtocol ('Synchronous Bool)     Shout :: String -> Pdu TestProtocol 'Asynchronous

@@ -23,7 +23,7 @@  type instance ToPretty Counter = PutStr "counter" -instance Typeable x => HasPdu Counter x where+instance HasPdu Counter where   data instance Pdu Counter x where     Inc :: Pdu Counter 'Asynchronous     Cnt :: Pdu Counter ('Synchronous Integer)@@ -67,7 +67,7 @@  type instance ToPretty SupiDupi = PutStr "supi dupi" -instance Typeable r => HasPdu SupiDupi r where+instance HasPdu SupiDupi where   data instance Pdu SupiDupi r where     Whoopediedoo :: Bool -> Pdu SupiDupi ('Synchronous (Maybe ()))     deriving Typeable@@ -141,8 +141,9 @@ logCounterObservations = start OCCStart  instance Member Logs q => Server (Observer CounterChanged) (Processes q) where-  data StartArgument (Observer CounterChanged) (Processes q) = OCCStart+  data instance StartArgument (Observer CounterChanged) (Processes q) = OCCStart   update _ _ e =     case e of       OnCast (Observed msg) -> logInfo' ("observerRegistryNotify: " ++ show msg)       _ -> logNotice (T.pack (show e))+

@@ -0,0 +1,274 @@+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE UndecidableInstances #-}+-- | Another  example for the library that uses embedded protocols with multiple server back+-- ends and a polymorphic client.+--+-- @since 0.29.0+module Main where++import           Control.DeepSeq+import           Control.Eff+import           Control.Eff.Concurrent+import           Control.Eff.Concurrent.Protocol.StatefulServer as Server+import           Control.Lens+import           Control.Monad+import           Data.Dynamic+import           Data.Foldable+import           Data.Functor.Contravariant (contramap)+import qualified Data.Text as T++main :: IO ()+main =+  defaultMain (void embeddedExample)++embeddedExample :: Eff Effects ()+embeddedExample = do+  b1 <- Server.start InitBackend1+  b2 <- Server.start InitBackend2+  app <- Server.start InitApp+  cast app DoThis+  cast app DoThis+  cast app DoThis+  call app (SetBackend (Just (SomeBackend b1)))+  cast app DoThis+  cast app DoThis+  cast app DoThis+  cast app DoThis+  call app (SetBackend Nothing)+  cast app DoThis+  cast app DoThis+  cast app DoThis+  call app (SetBackend (Just (SomeBackend b1)))+  cast app DoThis+  cast app DoThis+  cast app DoThis+  call app (SetBackend (Just (SomeBackend b2)))+  cast app DoThis+  cast app DoThis+  cast app DoThis+  call app (SetBackend Nothing)++------------------------------ Server Instances++-- Application layer++instance Server.Server App Effects where+  type instance Model App = Maybe SomeBackend+  data instance StartArgument App Effects = InitApp+  update me _x e =+    case e of+      OnCall rt (SetBackend b) -> do+        logInfo "setting backend"+        oldB <- getAndPutModel @App b+        traverse_ (`backendForgetObserver` me) oldB+        traverse_ (`backendRegisterObserver` me) b+        sendReply rt ()+      OnCast DoThis ->+        do m <- getModel @App+           case m of+            Nothing -> logInfo "doing this without backend"+            Just b -> do+                doSomeBackendWork b+                bi <- getSomeBackendInfo b+                logInfo ("doing this. Backend: " <> T.pack bi)+      _ -> logWarning ("unexpected: "<>T.pack(show e))+++------------------------------ Protocol Data Types++-- Application layer++data App deriving Typeable++instance HasPdu App where+  type EmbeddedPduList App = '[Observer BackendEvent]+  data Pdu App r where+    SetBackend :: Maybe SomeBackend -> Pdu App ('Synchronous ())+    DoThis :: Pdu App 'Asynchronous+    AppBackendEvent :: Pdu (Observer BackendEvent) r -> Pdu App r+    deriving Typeable++instance NFData (Pdu App r) where+  rnf (SetBackend !_x) = ()+  rnf DoThis = ()+  rnf (AppBackendEvent e) = rnf e++instance Show (Pdu App r) where+  show (SetBackend _x) = "setting backend"+  show DoThis = "doing this"+  show (AppBackendEvent e) = "got backend event: " ++ show e++instance HasPduPrism App (Observer BackendEvent) where+  embedPdu = AppBackendEvent+  fromPdu (AppBackendEvent e) = Just e+  fromPdu _ = Nothing++-- Backend+data Backend deriving Typeable++instance HasPdu Backend where+  data Pdu Backend r where+    BackendWork :: Pdu Backend 'Asynchronous+    GetBackendInfo :: Pdu Backend ('Synchronous String)+    deriving Typeable++instance NFData (Pdu Backend r) where+  rnf BackendWork = ()+  rnf GetBackendInfo = ()++instance Show (Pdu Backend r) where+  show BackendWork = "BackendWork"+  show GetBackendInfo = "GetBackendInfo"++newtype BackendEvent where+    BackendEvent :: String -> BackendEvent+    deriving (NFData, Show, Typeable)++type IsBackend b =+  ( HasPdu b+  , Embeds b Backend+  , IsObservable b BackendEvent+  , Tangible (Pdu b ('Synchronous String))+  , Tangible (Pdu b 'Asynchronous)+  )++data SomeBackend =+  forall b . IsBackend b => SomeBackend (Endpoint b)++withSomeBackend ::+   SomeBackend+  -> (forall b . IsBackend b => Endpoint b -> x )+  -> x+withSomeBackend (SomeBackend x) f = f x++backendRegisterObserver+  :: ( HasProcesses e q+     , CanObserve m BackendEvent+     , Embeds m (Observer BackendEvent)+     , Tangible (Pdu m 'Asynchronous))+  => SomeBackend+  -> Endpoint m+  -> Eff e ()+backendRegisterObserver (SomeBackend x) o = registerObserver @BackendEvent x o++backendForgetObserver+  :: ( HasProcesses e q+     , CanObserve m BackendEvent+     , Embeds m (Observer BackendEvent)+     , Tangible (Pdu m 'Asynchronous)+     )+  => SomeBackend+  -> Endpoint m+  -> Eff e ()+backendForgetObserver (SomeBackend x) o = forgetObserver @BackendEvent x o++getSomeBackendInfo :: HasProcesses e q => SomeBackend -> Eff e String+getSomeBackendInfo (SomeBackend x) = call x GetBackendInfo++doSomeBackendWork ::  HasProcesses e q => SomeBackend -> Eff e ()+doSomeBackendWork (SomeBackend x) = cast x BackendWork++-------------------------++-- Backend 1++data Backend1 deriving Typeable++instance Server.Server Backend1 Effects where+  type instance Protocol Backend1 = (Backend, ObserverRegistry BackendEvent)+  type instance Model Backend1 = (Int, ObserverRegistry BackendEvent)+  data instance StartArgument Backend1 Effects = InitBackend1+  setup _ _ = pure ( (0, emptyObserverRegistry), () )+  update me _ e = do+    model <- getModel @Backend1+    case e of+      OnCall rt (ToPduLeft GetBackendInfo) ->+        sendReply+          (toEmbeddedReplyTarget @(Server.Protocol Backend1) @Backend rt)+          ("Backend1 " <> show me <> " " <> show (model ^. _1))+      OnCast (ToPduLeft BackendWork) -> do+        logInfo "working..."+        modifyModel @Backend1 (over _1 (+ 1))+      OnCast (ToPduRight x) -> do+        logInfo "event registration stuff ..."+        zoomModel @Backend1 _2 (observerRegistryHandlePdu x)+      OnDown pd -> do+        logWarning (T.pack (show pd))+        wasObserver <- zoomModel @Backend1 _2 (observerRegistryRemoveProcess @BackendEvent (downProcess pd))+        when wasObserver $+          logNotice "observer removed"+      _ -> logWarning ("unexpected: " <> T.pack (show e))++-- Backend 2++data Backend2 deriving Typeable++instance HasPdu Backend2 where+  type instance EmbeddedPduList Backend2 = '[Backend, ObserverRegistry BackendEvent]+  data instance Pdu Backend2 r where+    B2ObserverRegistry :: Pdu (ObserverRegistry BackendEvent) r -> Pdu Backend2 r+    B2BackendWork :: Pdu Backend r -> Pdu Backend2 r+    deriving Typeable++instance NFData (Pdu Backend2 r) where+  rnf (B2BackendWork w) = rnf w+  rnf (B2ObserverRegistry x) = rnf x++instance Show (Pdu Backend2 r) where+  show (B2BackendWork w) = show w+  show (B2ObserverRegistry x) = show x++instance HasPduPrism Backend2 Backend where+  embedPdu = B2BackendWork+  fromPdu (B2BackendWork x) = Just x+  fromPdu _ = Nothing++instance HasPduPrism Backend2 (ObserverRegistry BackendEvent) where+  embedPdu = B2ObserverRegistry+  fromPdu (B2ObserverRegistry x) = Just x+  fromPdu _ = Nothing++instance Server.Server Backend2 Effects where+  type instance Model Backend2 = (Int, ObserverRegistry BackendEvent)+  data instance StartArgument Backend2 Effects = InitBackend2+  setup _ _ = pure ( (0, emptyObserverRegistry), () )+  update me _ e = do+    model <- getModel @Backend2+    case e of+      OnCall rt (B2BackendWork GetBackendInfo) ->+        sendReply rt ("Backend2 " <> show me <> " " <> show (model ^. _1))+      OnCast (B2BackendWork BackendWork) -> do+        logInfo "working..."+        oldM <- getAndModifyModel @Backend2 (over _1 (+ 1))+        when (fst oldM `mod` 2 == 0)+          (zoomModel @Backend2 _2 (observerRegistryNotify (BackendEvent "even!")))+      OnCast (B2ObserverRegistry x) -> do+        logInfo "event registration stuff ..."+        zoomModel @Backend2 _2 (observerRegistryHandlePdu x)+      OnDown pd -> do+        logWarning (T.pack (show pd))+        wasObserver <- zoomModel @Backend2 _2 (observerRegistryRemoveProcess @BackendEvent (downProcess pd))+        when wasObserver $+          logNotice "observer removed"+      _ -> logWarning ("unexpected: " <> T.pack (show e))++-- EXPERIMENTING+data EP a where+  EP :: forall a (r :: Synchronicity) . (NFData (Pdu a r), Typeable r) => Receiver (Pdu a r) -> EP a++sendEPCast+  :: forall a e q+  . (HasProcesses e q)+  => EP a+  -> (forall x . Pdu a x)+  -> Eff e ()+sendEPCast (EP r) p = sendToReceiver r p++embeddedReceiver+  :: forall  a b+  . (Embeds a b, (forall (r :: Synchronicity) . Typeable r => NFData (Pdu b r) ))+  => EP a+  -> EP b+embeddedReceiver (EP r) = EP (contramap embedPdu r)++

@@ -1,6 +1,6 @@ cabal-version:  2.0 name:           extensible-effects-concurrent-version:        0.28.0+version:        0.29.0 description:    Please see the README on GitHub at <https://github.com/sheyll/extensible-effects-concurrent#readme> synopsis:       Message passing concurrency as extensible-effect homepage:       https://github.com/sheyll/extensible-effects-concurrent#readme@@ -248,6 +248,39 @@   default-language: Haskell2010   default-extensions:   AllowAmbiguousTypes                       , BangPatterns+                      , DataKinds+                      , FlexibleContexts+                      , FlexibleInstances+                      , FunctionalDependencies+                      , GADTs+                      , GeneralizedNewtypeDeriving+                      , LambdaCase+                      , OverloadedStrings+                      , RankNTypes+                      , ScopedTypeVariables+                      , StandaloneDeriving+                      , TemplateHaskell+                      , TypeApplications+                      , TypeFamilies+                      , TypeOperators+++executable extensible-effects-concurrent-example-embedded-protocols+  main-is: Main.hs+  hs-source-dirs: examples/example-embedded-protocols+  build-depends:+                base+              , deepseq+              , extensible-effects-concurrent+              , extensible-effects+              , lens+              , pretty-types >= 0.2.3.1 && < 0.4+              , text+  ghc-options: -Wall -threaded -fno-full-laziness+  default-language: Haskell2010+  default-extensions:   AllowAmbiguousTypes+                      , BangPatterns+                      , ConstraintKinds                       , DataKinds                       , FlexibleContexts                       , FlexibleInstances

@@ -157,6 +157,9 @@                                                 , logInterrupts                                                 , provideInterrupts                                                 , mergeEitherInterruptAndExitReason+                                                , sendToReceiver+                                                , Receiver(..)+                                                , receiverPid                                                 ) import           Control.Eff.Concurrent.Process.Timer                                                 ( Timeout(fromTimeoutMicros)@@ -173,6 +176,7 @@  import           Control.Eff.Concurrent.Protocol                                                 ( HasPdu(..)+                                                , Embeds                                                 , Pdu(..)                                                 , Synchronicity(..)                                                 , ProtocolReply@@ -182,7 +186,7 @@                                                 , fromEndpoint                                                 , proxyAsEndpoint                                                 , asEndpoint-                                                , EmbedProtocol(..)+                                                , HasPduPrism(..)                                                 , toEmbeddedEndpoint                                                 , fromEmbeddedEndpoint                                                 )@@ -194,7 +198,7 @@                                                 , castEndpointReader                                                 , callSingleton                                                 , callEndpointReader-                                                , ServesProtocol+                                                , HasEndpointReader                                                 , runEndpointReader                                                 , askEndpoint                                                 , EndpointReader

@@ -122,6 +122,10 @@   , logInterrupts   , provideInterrupts   , mergeEitherInterruptAndExitReason+  -- ** Typed ProcessIds: Receiver+  , sendToReceiver+  , Receiver(..)+  , receiverPid   ) where @@ -146,6 +150,7 @@ import           Data.String                    ( IsString, fromString ) import           Data.Text                      ( Text, pack, unpack) import qualified Data.Text                     as T+import           Type.Reflection                ( SomeTypeRep(..), typeRep ) import           GHC.Stack import           GHC.Generics                    ( Generic                                                  , Generic1@@ -1301,3 +1306,43 @@   showsPrec _ (ProcessId !c) = showChar '!' . shows c  makeLenses ''ProcessId++-- | Serialize and send a message to the process in a 'Receiver'.+--+-- EXPERIMENTAL+--+-- @since 0.29.0+sendToReceiver :: (NFData o, HasProcesses r q) => Receiver o -> o -> Eff r ()+sendToReceiver (Receiver pid serializer) message =+  rnf message `seq` sendMessage pid (toStrictDynamic (serializer message))++-- | A 'ProcessId' and a 'Serializer'. EXPERIMENTAL+--+-- See 'sendToReceiver'.+--+-- @since 0.29.0+data Receiver a =+  forall out . (NFData out, Typeable out, Show out) =>+    Receiver { _receiverPid :: ProcessId+             , _receiverSerializer :: a -> out+             }+  deriving (Typeable)++instance NFData (Receiver o) where+  rnf (Receiver e f) = f `seq` rnf e++instance Eq (Receiver o) where+  (==) = (==) `on` _receiverPid++instance Ord (Receiver o) where+  compare = compare `on` _receiverPid++instance Contravariant Receiver where+  contramap f (Receiver p s) = Receiver p (s . f)++instance Typeable protocol => Show (Receiver protocol) where+  showsPrec d (Receiver c _) =+    showParen (d>=10)+    (showSTypeRep (SomeTypeRep (Type.Reflection.typeRep @protocol)) . showsPrec 10 c)++makeLenses ''Receiver

@@ -131,7 +131,8 @@ submitCast   :: forall o r    . ( SetMember Lift (Lift IO) r-     , HasPdu o 'Asynchronous+     , HasPdu o+     , Tangible (Pdu o 'Asynchronous)      , Member Interrupts r)   => SchedulerSession r   -> Endpoint o@@ -144,7 +145,8 @@   :: forall o q r    . ( SetMember Lift (Lift IO) r      , Member Interrupts r-     , HasPdu o ('Synchronous q)+     , Tangible (Pdu o ('Synchronous q))+     , HasPdu o      , Tangible q      )   => SchedulerSession r

@@ -1,3 +1,4 @@+{-# LANGUAGE UndecidableInstances, QuantifiedConstraints #-} -- | Types and functions for type-safe(er) interaction between processes. -- -- All messages sent between processes are eventually converted to 'Dynamic' values@@ -6,7 +7,7 @@ -- A step towards a more controlled and type safe process interaction model is -- done with the facilities defined in this module. ----- The metaphor for communication is a /stateles protocol/ that describes the+-- The metaphor for communication is a /stateless protocol/ that describes the -- messages handled by a process. -- -- A /protocol/ is represented by a custom data type, often a /phantom/ type,@@ -35,6 +36,8 @@ -- module Control.Eff.Concurrent.Protocol   ( HasPdu(..)+  , deserializePdu+  , Embeds   , Pdu(..)   , Synchronicity(..)   , ProtocolReply@@ -44,7 +47,7 @@   , fromEndpoint   , proxyAsEndpoint   , asEndpoint-  , EmbedProtocol(..)+  , HasPduPrism(..)   , toEmbeddedEndpoint   , fromEmbeddedEndpoint   )@@ -54,7 +57,6 @@ import           Control.DeepSeq import           Control.Eff.Concurrent.Process import           Control.Lens-import           Data.Coerce import           Data.Dynamic import           Data.Kind import           Data.Typeable ()@@ -111,23 +113,64 @@ -- > -- -- @since 0.25.1-class (Tangible (Pdu protocol reply), Typeable protocol, Typeable reply) => HasPdu (protocol :: Type) (reply :: Synchronicity) where+class (Typeable protocol) =>+   HasPdu (protocol :: Type) where+  -- | A type level list Protocol phantom types included in the associated 'Pdu' instance.+  --+  -- This is just a helper for better compiler error messages.+  -- It relies on 'Embeds' to add the constraint 'HasPduPrism'.+  --+  -- @since 0.29.0+  type family EmbeddedPduList protocol :: [Type]+  type instance EmbeddedPduList protocol = '[]    -- | The __protocol data unit__ type for the given protocol.-  data family Pdu protocol reply+  data family Pdu protocol (reply :: Synchronicity) -  -- | Deserialize a 'Pdu' from a 'Dynamic' i.e. from a message received by a process.-  ---  -- @since 0.25.1-  deserializePdu :: Dynamic -> Maybe (Pdu protocol reply)+-- | Deserialize a 'Pdu' from a 'Dynamic' i.e. from a message received by a process.+--+-- @since 0.25.1+deserializePdu :: (Typeable (Pdu protocol reply)) => Dynamic -> Maybe (Pdu protocol reply)+deserializePdu = fromDynamic -  default deserializePdu :: (Typeable (Pdu protocol reply)) => Dynamic -> Maybe (Pdu protocol reply)-  deserializePdu = fromDynamic+-- | A constraint that requires that the @outer@ 'Pdu' has a clause to+-- embed values from the @inner@ 'Pdu'.+--+-- Also, this constraint requires a 'HasPduPrism' instance, as a proof for+-- a possible conversion+-- of an embedded 'Pdu' value into to the enclosing 'Pdu'.+--+-- This generates better compiler error messages, when an embedding of a 'Pdu'+-- into another.+--+-- This is provided by 'HasPdu' instances. The instances are required to+-- provide a list of embedded 'Pdu' values in 'EmbeddedPduList'.+--+-- Note that every type embeds itself, so @Embeds x x@ always holds.+--+-- @since 0.29.0+type Embeds outer inner = (HasPduPrism outer inner, CheckEmbeds outer inner) -  --  type family PrettyPdu protocol reply :: PrettyType-  --  type instance PrettyPdu protocol reply =-  --      PrettySurrounded (PutStr "<") (PutStr ">") ("protocol" <:> ToPretty protocol <+> ToPretty reply)+-- ---------- Type Machinery:+type family CheckEmbeds outer inner :: Constraint where+  CheckEmbeds outer outer = ()+  CheckEmbeds outer inner =+    IsProtocolOneOf+      inner+      (EmbeddedPduList outer)+      (EmbeddedPduList outer)+    ~ 'IsEmbeddedProtocol +data IsEmbeddedProtocol k  = IsEmbeddedProtocol | IsNotAnEmbeddedProtocol k [k]++type family IsProtocolOneOf (x :: k) (xs :: [k]) (orig :: [k]) :: IsEmbeddedProtocol k where+  IsProtocolOneOf x '[] orig = 'IsNotAnEmbeddedProtocol x orig+  IsProtocolOneOf x (x ': xs) orig = 'IsEmbeddedProtocol+  IsProtocolOneOf x (y ': xs) orig = IsProtocolOneOf x xs orig++-- --------------------------++ type instance ToPretty (Pdu x y) =   PrettySurrounded (PutStr "<") (PutStr ">") ("protocol" <:> ToPretty x <+> ToPretty y) @@ -153,7 +196,7 @@   ( Typeable p   , Typeable r   , Tangible (Pdu p r)-  , HasPdu p r+  , HasPdu p   )  -- | The (promoted) constructors of this type specify (at the type level) the@@ -176,72 +219,30 @@  type instance ToPretty (Endpoint a) = ToPretty a <+> PutStr "endpoint" -makeLenses ''Endpoint -instance (Typeable r, HasPdu a1 r, HasPdu a2 r) => HasPdu (a1, a2) r where+instance (HasPdu a1, HasPdu a2) => HasPdu (a1, a2) where+  type instance EmbeddedPduList (a1, a2) = '[a1, a2]   data instance Pdu (a1, a2) r where           ToPduLeft :: Pdu a1 r -> Pdu (a1, a2) r           ToPduRight :: Pdu a2 r -> Pdu (a1, a2) r -  deserializePdu d =-    case deserializePdu d of-      Just (x :: Pdu a1 r) ->-        Just (embedPdu x)-      Nothing ->-        case deserializePdu d of-          Just (x :: Pdu a2 r) ->-            Just (embedPdu x)-          Nothing ->-            Nothing--instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r) => HasPdu (a1, a2, a3) r where+instance (HasPdu a1, HasPdu a2, HasPdu a3) => HasPdu (a1, a2, a3) where+  type instance EmbeddedPduList (a1, a2, a3) = '[a1, a2, a3]   data instance Pdu (a1, a2, a3) r where     ToPdu1 :: Pdu a1 r -> Pdu (a1, a2, a3) r     ToPdu2 :: Pdu a2 r -> Pdu (a1, a2, a3) r     ToPdu3 :: Pdu a3 r -> Pdu (a1, a2, a3) r -  deserializePdu d =-    case deserializePdu d of-      Just (x :: Pdu a1 r) ->-        Just (embedPdu x)-      Nothing ->-        case deserializePdu d of-          Just (x :: Pdu a2 r) ->-            Just (embedPdu x)-          Nothing ->-            case deserializePdu d of-              Just (x :: Pdu a3 r) ->-                Just (embedPdu x)-              Nothing ->-                Nothing--instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r) => HasPdu (a1, a2, a3, a4) r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4) => HasPdu (a1, a2, a3, a4) where+  type instance EmbeddedPduList (a1, a2, a3, a4) = '[a1, a2, a3, a4]   data instance Pdu (a1, a2, a3, a4) r where     ToPdu1Of4 :: Pdu a1 r -> Pdu (a1, a2, a3, a4) r     ToPdu2Of4 :: Pdu a2 r -> Pdu (a1, a2, a3, a4) r     ToPdu3Of4 :: Pdu a3 r -> Pdu (a1, a2, a3, a4) r     ToPdu4Of4 :: Pdu a4 r -> Pdu (a1, a2, a3, a4) r -  deserializePdu d =-    case deserializePdu d of-      Just (x :: Pdu a1 r) ->-        Just (embedPdu x)-      Nothing ->-        case deserializePdu d of-          Just (x :: Pdu a2 r) ->-            Just (embedPdu x)-          Nothing ->-            case deserializePdu d of-              Just (x :: Pdu a3 r) ->-                Just (embedPdu x)-              Nothing ->-                case deserializePdu d of-                  Just (x :: Pdu a4 r) ->-                    Just (embedPdu x)-                  Nothing ->-                    Nothing--instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r, HasPdu a5 r) => HasPdu (a1, a2, a3, a4, a5) r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4, HasPdu a5) => HasPdu (a1, a2, a3, a4, a5) where+  type instance EmbeddedPduList (a1, a2, a3, a4, a5) = '[a1, a2, a3, a4, a5]   data instance Pdu (a1, a2, a3, a4, a5) r where     ToPdu1Of5 :: Pdu a1 r -> Pdu (a1, a2, a3, a4, a5) r     ToPdu2Of5 :: Pdu a2 r -> Pdu (a1, a2, a3, a4, a5) r@@ -249,29 +250,6 @@     ToPdu4Of5 :: Pdu a4 r -> Pdu (a1, a2, a3, a4, a5) r     ToPdu5Of5 :: Pdu a5 r -> Pdu (a1, a2, a3, a4, a5) r -  deserializePdu d =-    case deserializePdu d of-      Just (x :: Pdu a1 r) ->-        Just (embedPdu x)-      Nothing ->-        case deserializePdu d of-          Just (x :: Pdu a2 r) ->-            Just (embedPdu x)-          Nothing ->-            case deserializePdu d of-              Just (x :: Pdu a3 r) ->-                Just (embedPdu x)-              Nothing ->-                case deserializePdu d of-                  Just (x :: Pdu a4 r) ->-                    Just (embedPdu x)-                  Nothing ->-                    case deserializePdu d of-                      Just (x :: Pdu a5 r) ->-                        Just (embedPdu x)-                      Nothing ->-                        Nothing- -- | Tag a 'ProcessId' with an 'Pdu' type index to mark it a 'Endpoint' process -- handling that API proxyAsEndpoint :: proxy protocol -> ProcessId -> Endpoint protocol@@ -282,97 +260,110 @@ asEndpoint :: forall protocol . ProcessId -> Endpoint protocol asEndpoint = Endpoint ++ -- | A class for 'Pdu' instances that embed other 'Pdu'.+--+-- This is a part of 'Embeds' provide instances for your+-- 'Pdu's but in client code use the 'Embeds' constraint.+--+-- Instances of this class serve as proof to 'Embeds' that+-- a conversion into another 'Pdu' actually exists.+-- -- A 'Prism' for the embedded 'Pdu' is the center of this class -- -- Laws: @embeddedPdu = prism' embedPdu fromPdu@ ----- @since 0.24.0+-- @since 0.29.0 class-  ( HasPdu protocol         result-  , HasPdu embeddedProtocol result-  )-  => EmbedProtocol protocol embeddedProtocol (result :: Synchronicity) where+ (Typeable protocol, Typeable embeddedProtocol)+  => HasPduPrism protocol embeddedProtocol where    -- | A 'Prism' for the embedded 'Pdu's.-  embeddedPdu :: Prism' (Pdu protocol result) (Pdu embeddedProtocol result)+  embeddedPdu+    :: forall (result :: Synchronicity)+    . Prism' (Pdu protocol result) (Pdu embeddedProtocol result)   embeddedPdu = prism' embedPdu fromPdu    -- | Embed the 'Pdu' value of an embedded protocol into the corresponding   --  'Pdu' value.-  embedPdu :: Pdu embeddedProtocol result -> Pdu protocol result+  embedPdu+    :: forall (result :: Synchronicity)+    . Pdu embeddedProtocol result -> Pdu protocol result   embedPdu = review embeddedPdu   -- | Examine a 'Pdu' value from the outer protocol, and return it, if it embeds a 'Pdu' of   -- embedded protocol, otherwise return 'Nothing'/-  fromPdu :: Pdu protocol result -> Maybe (Pdu embeddedProtocol result)+  fromPdu+    :: forall (result :: Synchronicity)+    . Pdu protocol result -> Maybe (Pdu embeddedProtocol result)   fromPdu = preview embeddedPdu - -- | Convert an 'Endpoint' to an endpoint for an embedded protocol. ----- See 'EmbedProtocol', 'fromEmbeddedEndpoint'.+-- See 'Embeds', 'fromEmbeddedEndpoint'. -- -- @since 0.25.1-toEmbeddedEndpoint :: forall inner outer r . EmbedProtocol outer inner r => Endpoint outer -> Endpoint inner-toEmbeddedEndpoint = coerce+toEmbeddedEndpoint :: forall inner outer . Embeds outer inner => Endpoint outer -> Endpoint inner+toEmbeddedEndpoint (Endpoint e) = Endpoint e  -- | Convert an 'Endpoint' to an endpoint for a server, that embeds the protocol. ----- See 'EmbedProtocol', 'toEmbeddedEndpoint'.+-- See 'Embeds', 'toEmbeddedEndpoint'. -- -- @since 0.25.1-fromEmbeddedEndpoint ::  forall outer inner r . EmbedProtocol outer inner r => Endpoint inner -> Endpoint outer-fromEmbeddedEndpoint = coerce+fromEmbeddedEndpoint ::  forall outer inner . HasPduPrism outer inner => Endpoint inner -> Endpoint outer+fromEmbeddedEndpoint (Endpoint e) = Endpoint e -instance HasPdu a r => EmbedProtocol a a r where+instance (Typeable a) => HasPduPrism a a where   embeddedPdu = prism' id Just   embedPdu = id   fromPdu = Just -instance (NFData (Pdu a1 r), NFData (Pdu a2 r)) => NFData (Pdu (a1, a2) r) where-  rnf (ToPduLeft x) = rnf x-  rnf (ToPduRight y) = rnf y--instance (Show (Pdu a1 r), Show (Pdu a2 r)) => Show (Pdu (a1, a2) r) where-  showsPrec d (ToPduLeft x) = showsPrec d x-  showsPrec d (ToPduRight y) = showsPrec d y--instance (Typeable r, HasPdu a1 r, HasPdu a2 r) => EmbedProtocol (a1, a2) a1 r where+instance (Typeable a1, Typeable a2) => HasPduPrism (a1, a2) a1 where   embedPdu = ToPduLeft   fromPdu (ToPduLeft l) = Just l   fromPdu _ = Nothing -instance (Typeable r, HasPdu a1 r, HasPdu a2 r) => EmbedProtocol (a1, a2) a2 r where+instance (Typeable a1, Typeable a2) => HasPduPrism (a1, a2) a2 where   embeddedPdu =     prism' ToPduRight $ \case       ToPduRight r -> Just r       ToPduLeft _ -> Nothing -instance (NFData (Pdu a1 r), NFData (Pdu a2 r), NFData (Pdu a3 r)) => NFData (Pdu (a1, a2, a3) r) where-  rnf (ToPdu1 x) = rnf x-  rnf (ToPdu2 y) = rnf y-  rnf (ToPdu3 z) = rnf z--instance (Show (Pdu a1 r), Show (Pdu a2 r), Show (Pdu a3 r)) => Show (Pdu (a1, a2, a3) r) where-  showsPrec d (ToPdu1 x) = showsPrec d x-  showsPrec d (ToPdu2 y) = showsPrec d y-  showsPrec d (ToPdu3 z) = showsPrec d z--instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r) => EmbedProtocol (a1, a2, a3) a1 r where+instance (Typeable a1, Typeable a2, Typeable a3) => HasPduPrism (a1, a2, a3) a1 where   embedPdu = ToPdu1   fromPdu (ToPdu1 l) = Just l   fromPdu _ = Nothing -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r) => EmbedProtocol (a1, a2, a3) a2 r where+instance (Typeable a1, Typeable a2, Typeable a3) => HasPduPrism (a1, a2, a3) a2 where   embedPdu = ToPdu2   fromPdu (ToPdu2 l) = Just l   fromPdu _ = Nothing -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r) => EmbedProtocol (a1, a2, a3) a3 r where+instance (Typeable a1, Typeable a2, Typeable a3) => HasPduPrism (a1, a2, a3) a3 where   embedPdu = ToPdu3   fromPdu (ToPdu3 l) = Just l   fromPdu _ = Nothing +instance (NFData (Pdu a1 r), NFData (Pdu a2 r)) => NFData (Pdu (a1, a2) r) where+  rnf (ToPduLeft x) = rnf x+  rnf (ToPduRight y) = rnf y++instance (Show (Pdu a1 r), Show (Pdu a2 r)) => Show (Pdu (a1, a2) r) where+  showsPrec d (ToPduLeft x) = showsPrec d x+  showsPrec d (ToPduRight y) = showsPrec d y+++instance (NFData (Pdu a1 r), NFData (Pdu a2 r), NFData (Pdu a3 r)) => NFData (Pdu (a1, a2, a3) r) where+  rnf (ToPdu1 x) = rnf x+  rnf (ToPdu2 y) = rnf y+  rnf (ToPdu3 z) = rnf z++instance (Show (Pdu a1 r), Show (Pdu a2 r), Show (Pdu a3 r)) => Show (Pdu (a1, a2, a3) r) where+  showsPrec d (ToPdu1 x) = showsPrec d x+  showsPrec d (ToPdu2 y) = showsPrec d y+  showsPrec d (ToPdu3 z) = showsPrec d z+ instance (NFData (Pdu a1 r), NFData (Pdu a2 r), NFData (Pdu a3 r), NFData (Pdu a4 r)) => NFData (Pdu (a1, a2, a3, a4) r) where   rnf (ToPdu1Of4 x) = rnf x   rnf (ToPdu2Of4 y) = rnf y@@ -385,22 +376,22 @@   showsPrec d (ToPdu3Of4 z) = showsPrec d z   showsPrec d (ToPdu4Of4 w) = showsPrec d w -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r) => EmbedProtocol (a1, a2, a3, a4) a1 r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4) => HasPduPrism (a1, a2, a3, a4) a1 where   embedPdu = ToPdu1Of4   fromPdu (ToPdu1Of4 l) = Just l   fromPdu _ = Nothing -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r) => EmbedProtocol (a1, a2, a3, a4) a2 r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4) => HasPduPrism (a1, a2, a3, a4) a2 where   embedPdu = ToPdu2Of4   fromPdu (ToPdu2Of4 l) = Just l   fromPdu _ = Nothing -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r) => EmbedProtocol (a1, a2, a3, a4) a3 r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4) => HasPduPrism (a1, a2, a3, a4) a3 where   embedPdu = ToPdu3Of4   fromPdu (ToPdu3Of4 l) = Just l   fromPdu _ = Nothing -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r) => EmbedProtocol (a1, a2, a3, a4) a4 r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4) => HasPduPrism (a1, a2, a3, a4) a4 where   embedPdu = ToPdu4Of4   fromPdu (ToPdu4Of4 l) = Just l   fromPdu _ = Nothing@@ -419,27 +410,29 @@   showsPrec d (ToPdu4Of5 w) = showsPrec d w   showsPrec d (ToPdu5Of5 v) = showsPrec d v -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r, HasPdu a5 r) => EmbedProtocol (a1, a2, a3, a4, a5) a1 r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4, HasPdu a5) => HasPduPrism (a1, a2, a3, a4, a5) a1 where   embedPdu = ToPdu1Of5   fromPdu (ToPdu1Of5 l) = Just l   fromPdu _ = Nothing -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r, HasPdu a5 r) => EmbedProtocol (a1, a2, a3, a4, a5) a2 r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4, HasPdu a5) => HasPduPrism (a1, a2, a3, a4, a5) a2 where   embedPdu = ToPdu2Of5   fromPdu (ToPdu2Of5 l) = Just l   fromPdu _ = Nothing -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r, HasPdu a5 r) => EmbedProtocol (a1, a2, a3, a4, a5) a3 r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4, HasPdu a5) => HasPduPrism (a1, a2, a3, a4, a5) a3 where   embedPdu = ToPdu3Of5   fromPdu (ToPdu3Of5 l) = Just l   fromPdu _ = Nothing -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r, HasPdu a5 r) => EmbedProtocol (a1, a2, a3, a4, a5) a4 r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4, HasPdu a5) => HasPduPrism (a1, a2, a3, a4, a5) a4 where   embedPdu = ToPdu4Of5   fromPdu (ToPdu4Of5 l) = Just l   fromPdu _ = Nothing -instance (Typeable r, HasPdu a1 r, HasPdu a2 r, HasPdu a3 r, HasPdu a4 r, HasPdu a5 r) => EmbedProtocol (a1, a2, a3, a4, a5) a5 r where+instance (HasPdu a1, HasPdu a2, HasPdu a3, HasPdu a4, HasPdu a5) => HasPduPrism (a1, a2, a3, a4, a5) a5 where   embedPdu = ToPdu5Of5   fromPdu (ToPdu5Of5 l) = Just l   fromPdu _ = Nothing++makeLenses ''Endpoint

@@ -11,7 +11,7 @@   , castEndpointReader   , callSingleton   , callEndpointReader-  , ServesProtocol+  , HasEndpointReader   , EndpointReader   , askEndpoint   , runEndpointReader@@ -28,6 +28,7 @@ import           Data.Typeable                  ( Typeable ) import           GHC.Stack + -- | Send a request 'Pdu' that has no reply and return immediately. -- -- The type signature enforces that the corresponding 'Pdu' clause is@@ -39,9 +40,10 @@   :: forall destination protocol r q    . ( HasCallStack      , HasProcesses r q-     , HasPdu destination 'Asynchronous-     , HasPdu protocol 'Asynchronous-     , EmbedProtocol destination protocol 'Asynchronous+     , HasPdu destination+     , HasPdu protocol+     , Tangible (Pdu destination 'Asynchronous)+     , Embeds destination protocol      )   => Endpoint destination   -> Pdu protocol 'Asynchronous@@ -59,8 +61,8 @@    . ( HasProcesses r q      , TangiblePdu destination ( 'Synchronous result)      , TangiblePdu protocol ( 'Synchronous result)-     , EmbedProtocol destination protocol ( 'Synchronous result)      , Tangible result+     , Embeds destination protocol      , HasCallStack      )   => Endpoint destination@@ -82,7 +84,6 @@   resultOrError <- receiveWithMonitor pidInternal selectResult   either (interrupt . becauseProcessIsDown) return resultOrError - -- | Send an request 'Pdu' and wait for the server to return a result value. -- -- The type signature enforces that the corresponding 'Pdu' clause is@@ -101,12 +102,12 @@    . ( HasProcesses r q      , TangiblePdu destination ( 'Synchronous result)      , TangiblePdu protocol ( 'Synchronous result)-     , EmbedProtocol destination protocol ( 'Synchronous result)      , Tangible result      , Member Logs r      , Lifted IO q      , Lifted IO r      , HasCallStack+     , Embeds destination protocol      )   => Endpoint destination   -> Pdu protocol ( 'Synchronous result)@@ -143,9 +144,8 @@ -- only a __single server__ for a given 'Pdu' instance. This type alias is -- convenience to express that an effect has 'Process' and a reader for a -- 'Endpoint'.-type ServesProtocol o r q =          -- TODO remove!+type HasEndpointReader o r =   ( Typeable o-  , HasSafeProcesses r q   , Member (EndpointReader o) r   ) @@ -168,12 +168,12 @@ -- When working with an embedded 'Pdu' use 'callSingleton'. callEndpointReader   :: forall reply o r q .-     ( ServesProtocol o r q+     ( HasEndpointReader o r      , HasCallStack      , Tangible reply      , TangiblePdu o ( 'Synchronous reply)-     , Member Interrupts r-     +     , HasProcesses r q+     , Embeds o o      )   => Pdu o ( 'Synchronous reply)   -> Eff r reply@@ -187,10 +187,12 @@ -- When working with an embedded 'Pdu' use 'castSingleton'. castEndpointReader   :: forall o r q .-     ( ServesProtocol o r q+     ( HasEndpointReader o r+     , HasProcesses r q+     , Tangible (Pdu o 'Asynchronous)      , HasCallStack-     , Member Interrupts r-     , HasPdu o 'Asynchronous+     , HasPdu o+     , Embeds o o      )   => Pdu o 'Asynchronous   -> Eff r ()@@ -208,8 +210,9 @@ callSingleton   :: forall outer inner reply q e   . ( HasCallStack-    , EmbedProtocol outer inner  ( 'Synchronous reply)     , Member (EndpointReader outer) e+    , Embeds outer inner+    , Embeds outer outer     , HasProcesses e q     , TangiblePdu outer ('Synchronous reply)     , TangiblePdu inner ('Synchronous reply)@@ -229,11 +232,13 @@ castSingleton   :: forall outer inner q e   . ( HasCallStack-    , EmbedProtocol outer inner 'Asynchronous     , Member (EndpointReader outer) e+    , Tangible (Pdu outer 'Asynchronous)     , HasProcesses e q-    , HasPdu outer 'Asynchronous-    , HasPdu inner 'Asynchronous+    , HasPdu outer+    , HasPdu inner+    , Embeds outer inner+    , Embeds outer outer     )   => Pdu inner 'Asynchronous   -> Eff e ()

@@ -36,7 +36,7 @@ -- -- Instances can by /index types/ for 'Pdu' family directly, or indirectly via the 'ServerPdu' type family. ----- To builder servers serving multiple protocols, use the generic 'Pdu' instances, for which 'EmbedProtocol'+-- To builder servers serving multiple protocols, use the generic 'Pdu' instances, for which 'Embeds' -- instances exist, like 2-,3-,4-, or 5-tuple. -- -- @since 0.24.1

@@ -56,7 +56,7 @@ -- | A /protocol/ to communicate 'Observed' events from a sources to many sinks. -- -- A sink is any process that serves a protocol with a 'Pdu' instance that embeds--- the 'Observer' Pdu via an 'EmbedProtocol' instance.+-- the 'Observer' Pdu via an 'HasPduPrism' instance. -- -- This type has /dual use/, for one it serves as type-index for 'Pdu', i.e. -- 'HasPdu' respectively, and secondly it contains an 'ObservationSink' and@@ -80,7 +80,7 @@ type instance ToPretty (Observer event) =   PrettyParens ("observing" <:> ToPretty event) -instance (Typeable r, Tangible event) => HasPdu (Observer event) (r :: Synchronicity) where+instance (Tangible event) => HasPdu (Observer event) where   data Pdu (Observer event) r where     Observed :: event -> Pdu (Observer event) 'Asynchronous     deriving Typeable@@ -112,7 +112,8 @@ -- @since 0.28.0 type IsObservable eventSource event =   ( Tangible event-  , EmbedProtocol eventSource (ObserverRegistry event) 'Asynchronous+  , Embeds eventSource (ObserverRegistry event)+  , HasPdu eventSource   )  -- | Convenience type alias.@@ -120,7 +121,8 @@ -- @since 0.28.0 type CanObserve eventSink event =   ( Tangible event-  , EmbedProtocol eventSink (Observer event) 'Asynchronous+  , Embeds eventSink (Observer event)+  , HasPdu eventSink   )  -- | And an 'Observer' to the set of recipients for all observations reported by 'observerRegistryNotify'.@@ -134,6 +136,8 @@      ( HasCallStack      , HasProcesses r q      , IsObservable eventSource event+     , Tangible (Pdu eventSource 'Asynchronous)+     , Tangible (Pdu eventSink 'Asynchronous)      , CanObserve eventSink event      )   => Endpoint eventSource@@ -157,6 +161,8 @@   :: forall event eventSink eventSource r q .      ( HasProcesses r q      , HasCallStack+     , Tangible (Pdu eventSource 'Asynchronous)+     , Tangible (Pdu eventSink 'Asynchronous)      , IsObservable eventSource event      , CanObserve eventSink event      )@@ -173,6 +179,7 @@   :: forall event eventSource r q .      ( HasProcesses r q      , HasCallStack+     , Tangible (Pdu eventSource 'Asynchronous)      , IsObservable eventSource event      )   => Endpoint eventSource@@ -196,7 +203,8 @@ type instance ToPretty (ObserverRegistry event) =   PrettyParens ("observer registry" <:> ToPretty event) -instance (Tangible event, Typeable r) => HasPdu (ObserverRegistry event) r where+instance (Tangible event) => HasPdu (ObserverRegistry event) where+   -- | Protocol for managing observers. This can be added to any server for any number of different observation types.   -- The functions 'evalObserverRegistryState' and 'observerRegistryHandlePdu' are used to include observer handling;   --

@@ -131,6 +131,7 @@     , IsObservable eventSource event     , Integral len     , Server (ObservationQueue event) (Processes q)+    , Tangible (Pdu eventSource 'Asynchronous)     )   => len   -> Endpoint eventSource@@ -201,6 +202,7 @@     , LogIo q     , IsObservable eventSource event     , Member (ObservationQueueReader event) e+    , Tangible (Pdu eventSource 'Asynchronous)     )   => Endpoint eventSource   -> Eff e b@@ -216,7 +218,7 @@   instance (Typeable event, Lifted IO q, Member Logs q) => Server (ObservationQueue event) (Processes q) where-  type Protocol (ObservationQueue event) = Observer event+  type instance Protocol (ObservationQueue event) = Observer event    data instance StartArgument (ObservationQueue event) (Processes q) =      MkObservationQueue (ObservationQueue event)

@@ -44,7 +44,7 @@ -- -- Instances can by /index types/ for 'Pdu' family directly, or indirectly via the 'ServerPdu' type family. ----- To builder servers serving multiple protocols, use the generic 'Pdu' instances, for which 'EmbedProtocol'+-- To builder servers serving multiple protocols, use the generic 'Pdu' instances, for which 'Embeds' -- instances exist, like 2-,3-,4-, or 5-tuple. -- -- The naming is inspired by The Elm Architecture, without the @view@ callback.

@@ -100,7 +100,7 @@ -- @since 0.24.0 data Sup (p :: Type) deriving Typeable -instance (NFData (Pdu (Sup p) r), Show (Pdu (Sup p) r), Typeable p, Typeable r) => HasPdu (Sup p) r where+instance Typeable p => HasPdu (Sup p) where   -- | The 'Pdu' instance contains methods to start, stop and lookup a child   -- process, as well as a diagnostic callback.   --

@@ -95,7 +95,7 @@  instance NFData (RequestOrigin p r) --- | Turn an 'RequestOrigin' to an origin for an embedded request (See 'EmbedProtocol').+-- | Turn an 'RequestOrigin' to an origin for an embedded request (See 'Embeds'). -- -- This is useful of a server delegates the @calls@ and @casts@ for an embedded protocol -- to functions, that require the 'Serializer' and 'RequestOrigin' in order to call@@ -105,7 +105,7 @@ -- -- @since 0.24.3 toEmbeddedOrigin-  :: forall outer inner reply . EmbedProtocol outer inner ('Synchronous reply)+  :: forall outer inner reply . Embeds outer inner   => RequestOrigin outer reply   -> RequestOrigin inner reply toEmbeddedOrigin (RequestOrigin !pid !ref) = RequestOrigin pid ref@@ -117,7 +117,7 @@ -- This function is strict in all parameters. -- -- @since 0.24.2-embedRequestOrigin :: forall outer inner reply . EmbedProtocol outer inner ('Synchronous reply) => RequestOrigin inner reply -> RequestOrigin outer reply+embedRequestOrigin :: forall outer inner reply . Embeds outer inner => RequestOrigin inner reply -> RequestOrigin outer reply embedRequestOrigin (RequestOrigin !pid !ref) = RequestOrigin pid ref  -- | Turn a 'Serializer' for a 'Pdu' instance that contains embedded 'Pdu' values@@ -130,7 +130,7 @@ -- See also 'toEmbeddedOrigin'. -- -- @since 0.24.2-embedReplySerializer :: forall outer inner reply . EmbedProtocol outer inner ('Synchronous reply) => Serializer (Reply outer reply) -> Serializer (Reply inner reply)+embedReplySerializer :: forall outer inner reply . Embeds outer inner => Serializer (Reply outer reply) -> Serializer (Reply inner reply) embedReplySerializer = contramap embedReply  -- | Turn an /embedded/ 'Reply' to a 'Reply' for the /bigger/ request.@@ -138,7 +138,7 @@ -- This function is strict in all parameters. -- -- @since 0.24.2-embedReply :: forall outer inner reply . EmbedProtocol outer inner ('Synchronous reply) => Reply inner reply -> Reply outer reply+embedReply :: forall outer inner reply . Embeds outer inner => Reply inner reply -> Reply outer reply embedReply (Reply (RequestOrigin !pid !ref) !v) = Reply (RequestOrigin pid ref) v  @@ -180,7 +180,7 @@  -- | Smart constructor for a 'ReplyTarget'. ----- To build a @ReplyTarget@ for an 'EmbedProtocol' instance use 'embeddedReplyTarget'.+-- To build a @ReplyTarget@ for an 'Embeds' instance use 'embeddedReplyTarget'. -- -- @since 0.26.0 replyTarget :: Serializer (Reply p reply) -> RequestOrigin p reply -> ReplyTarget p reply@@ -205,7 +205,7 @@ -- This combines 'replyTarget' and 'toEmbeddedReplyTarget'. -- -- @since 0.26.0-embeddedReplyTarget :: EmbedProtocol outer inner ('Synchronous reply) => Serializer (Reply outer reply) -> RequestOrigin outer reply -> ReplyTarget inner reply+embeddedReplyTarget :: Embeds outer inner => Serializer (Reply outer reply) -> RequestOrigin outer reply -> ReplyTarget inner reply embeddedReplyTarget ser orig = toEmbeddedReplyTarget $ replyTarget ser orig  -- | Convert a 'ReplyTarget' to be usable for /embedded/ replies.@@ -214,6 +214,6 @@ -- 'ReplyTarget' that can be passed to functions defined soley on an embedded protocol. -- -- @since 0.26.0-toEmbeddedReplyTarget :: EmbedProtocol outer inner ('Synchronous reply) => ReplyTarget outer reply -> ReplyTarget inner reply+toEmbeddedReplyTarget :: Embeds outer inner => ReplyTarget outer reply -> ReplyTarget inner reply toEmbeddedReplyTarget (MkReplyTarget (Arg orig ser)) =   MkReplyTarget (Arg (toEmbeddedOrigin orig) (embedReplySerializer ser))

@@ -10,7 +10,6 @@ import Control.Eff.Concurrent.Protocol.Supervisor as Sup import qualified Control.Eff.Concurrent.Protocol.EffectfulServer as E import qualified Control.Eff.Concurrent.Protocol.StatefulServer as S-import Control.Lens import Data.Text as T import Data.Type.Pretty import Data.Typeable (Typeable)@@ -23,7 +22,7 @@  type instance ToPretty Small = PutStr "small" -instance Typeable r => HasPdu Small r where+instance HasPdu Small where   data instance  Pdu Small r where           SmallCall :: Bool -> Pdu Small ('Synchronous Bool)           SmallCast :: String -> Pdu Small 'Asynchronous@@ -58,7 +57,8 @@  type instance ToPretty Big = PutStr "big" -instance Typeable r => HasPdu Big r where+instance HasPdu Big where+  type instance EmbeddedPduList Big = '[Small]   data instance  Pdu Big r where     BigCall :: Bool -> Pdu Big ('Synchronous Bool)     BigCast :: String -> Pdu Big 'Asynchronous@@ -75,13 +75,10 @@   showsPrec d (BigCast x) = showParen (d > 10) (showString "SmallCast " . showString x)   showsPrec d (BigSmall x) = showParen (d > 10) (showString "BigSmall " . showsPrec 11 x) -instance  Typeable r => EmbedProtocol Big Small r where-  embeddedPdu =-    prism'-      BigSmall-      (\case-         (BigSmall x) -> Just x-         _ -> Nothing)+instance HasPduPrism Big Small where+  embedPdu = BigSmall+  fromPdu (BigSmall x) = Just x+  fromPdu _ = Nothing  -- ---------------------------------------------------------------------------- @@ -94,11 +91,11 @@             BigCall o -> do               logNotice ("BigCall " <> pack (show o))               sendReply rt o-            BigSmall x -> S.update (toEmbeddedEndpoint @_ @_ @('Synchronous Bool) me) MkSmall (S.OnCall (toEmbeddedReplyTarget rt) x)+            BigSmall x -> S.update (toEmbeddedEndpoint me) MkSmall (S.OnCall (toEmbeddedReplyTarget rt) x)     E.OnCast req ->         case req of           BigCast o -> S.putModel @Big o-          BigSmall x -> S.update (toEmbeddedEndpoint @_ @_ @('Asynchronous) me) MkSmall (S.OnCast x)+          BigSmall x -> S.update (toEmbeddedEndpoint me) MkSmall (S.OnCast x)     other ->       interrupt (ErrorInterrupt (show other)) -- ----------------------------------------------------------------------------

@@ -264,18 +264,18 @@  data TestObservable deriving Typeable -instance Typeable r => HasPdu TestObservable r  where+instance HasPdu TestObservable where+     type instance EmbeddedPduList TestObservable = '[ObserverRegistry String]      data Pdu TestObservable r where       SendTestEvent :: String -> Pdu TestObservable ('Synchronous ())       StopTestObservable :: Pdu TestObservable 'Asynchronous-      TestObsReg :: Pdu (ObserverRegistry String) 'Asynchronous -> Pdu TestObservable 'Asynchronous+      TestObsReg :: Pdu (ObserverRegistry String) r -> Pdu TestObservable r       deriving (Typeable) -instance EmbedProtocol TestObservable (ObserverRegistry String) 'Asynchronous where-  embeddedPdu = prism' TestObsReg $-    \case-      TestObsReg e -> Just e-      _ -> Nothing+instance HasPduPrism TestObservable (ObserverRegistry String) where+  embedPdu = TestObsReg+  fromPdu (TestObsReg x) = Just x+  fromPdu _ = Nothing  instance Typeable r => NFData (Pdu TestObservable r) where   rnf (SendTestEvent s) = rnf s@@ -296,6 +296,7 @@       S.OnCall rt e ->         case e of           SendTestEvent x -> observerRegistryNotify x >> sendReply rt ()+          TestObsReg x -> logError ("unexpected: " <> pack (show x))       S.OnCast (TestObsReg x) -> observerRegistryHandlePdu x       S.OnCast StopTestObservable -> exitNormally       S.OnDown pd -> do@@ -309,10 +310,11 @@  data TestObserver deriving Typeable -instance Typeable r => HasPdu TestObserver r where+instance HasPdu TestObserver where+  type EmbeddedPduList TestObserver = '[Observer String]   data Pdu TestObserver r where     GetCapturedEvents :: Pdu TestObserver ('Synchronous [String])-    OnTestEvent :: Pdu (Observer String) 'Asynchronous -> Pdu TestObserver 'Asynchronous+    OnTestEvent :: Pdu (Observer String) r -> Pdu TestObserver r     deriving Typeable  instance NFData (Pdu TestObserver r) where@@ -323,10 +325,10 @@   showsPrec _ GetCapturedEvents = showString "GetCapturedEvents"   showsPrec d (OnTestEvent e) = showParen (d>=10) (showString "OnTestEvent " . shows e) -instance EmbedProtocol TestObserver (Observer String) 'Asynchronous where-  embeddedPdu = prism' OnTestEvent $-    \case-      OnTestEvent e -> Just e+instance HasPduPrism TestObserver (Observer String) where+  embedPdu = OnTestEvent+  fromPdu (OnTestEvent e) = Just e+  fromPdu _ = Nothing   instance (LogIo r, HasProcesses r q) => M.Server TestObserver r where

@@ -92,7 +92,7 @@  type instance ToPretty ReturnToSender = PutStr "ReturnToSender" -instance Typeable r => HasPdu ReturnToSender r where+instance HasPdu ReturnToSender where  data instance Pdu ReturnToSender r where    ReturnToSender :: ProcessId -> String -> Pdu ReturnToSender ('Synchronous Bool)    StopReturnToSender :: Pdu ReturnToSender ('Synchronous ())@@ -171,8 +171,8 @@             traverse_ (sendMessage destination) [1 .. nMax]          me          <- self-        receiverPid <- spawn "reciever loop" (receiverLoop me)-        spawn_ "sender loop" (senderLoop receiverPid)+        receiverPid2 <- spawn "reciever loop" (receiverLoop me)+        spawn_ "sender loop" (senderLoop receiverPid2)         ok <- receiveMessage @Bool         lift (ok @? "selective receive failed")     , testCase "receive a message while waiting for a call reply"

@@ -246,7 +246,7 @@  type instance ToPretty TestProtocol = PutStr "test" -instance Typeable x => HasPdu TestProtocol x where+instance HasPdu TestProtocol where   data instance Pdu TestProtocol x where     TestGetStringLength :: String -> Pdu TestProtocol ('Synchronous Int)     TestInterruptWith :: Interrupt 'Recoverable -> Pdu TestProtocol 'Asynchronous