extensible-effects-concurrent 0.25.0 → 0.25.1

raw patch · 23 files changed

+445/−213 lines, 23 filesdep +taggedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: tagged

API changes (from Hackage documentation)

Files

• ChangeLog.md +28/−18
• README.md +23/−26
• default.nix +1/−2
• examples/example-1/Main.hs +7/−6
• examples/example-2/Main.hs +13/−11
• examples/example-4/Main.hs +13/−20
• extensible-effects-concurrent.cabal +2/−1
• extensible-effects-concurrent.nix +3/−1
• shell.nix +22/−2
• src/Control/Eff/Concurrent.hs +10/−1
• src/Control/Eff/Concurrent/Process/Interactive.hs +2/−2
• src/Control/Eff/Concurrent/Protocol.hs +140/−29
• src/Control/Eff/Concurrent/Protocol/Client.hs +52/−3
• src/Control/Eff/Concurrent/Protocol/EffectfulServer.hs +1/−0
• src/Control/Eff/Concurrent/Protocol/Observer.hs +39/−29
• src/Control/Eff/Concurrent/Protocol/Observer/Queue.hs +4/−4
• src/Control/Eff/Concurrent/Protocol/Request.hs +27/−7
• src/Control/Eff/Concurrent/Protocol/StatefulServer.hs +11/−10
• src/Control/Eff/Concurrent/Protocol/Supervisor.hs +20/−18
• test/GenServerTests.hs +15/−13
• test/ProcessBehaviourTestCases.hs +4/−3
• test/SupervisorTests.hs +7/−6
• with-hoogle.nix +1/−1

@@ -1,17 +1,27 @@ # Changelog for extensible-effects-concurrent -## 0.25.0 +## 0.25.1+- Add `castSingleton` and `callSingleton`, which use the `EndpointReader` and `EmbedProtocol` type class.+- Change `toObserver` to accept an Endpoint of a protocol that embeds `Observer x`+- Add `sendEmbeddedReply`+- Add `toEmbeddedEndpoint` and `fromEmbeddedEndpoint`+- Change `StatefulServer` class definition to not add `Processes` to the effects by default+- Add forgotten re-exports to `Concurrent`+- Fix the `NFData` instance for `Pdu (Observer o)`+- Put the `Pdu` data family inside of a new type class `IsPdu`++## 0.25.0 - Improve effect type aliases and module structure, [read the details here](./ChangeLog-Details-0.25.0.md).-        + ## 0.24.3 - Add `EmbedProtocol` related function `toEmbeddedOrigin`-    + ## 0.24.2 - Add more `EmbedProtocol` related functions:     - `embedReplySerializer`     - `embedRequestOrigin`-- Improve documentation for `EffectfulServer`     -- Improve documentation for `StatefulServer`     +- Improve documentation for `EffectfulServer`+- Improve documentation for `StatefulServer`  ## 0.24.1 @@ -26,38 +36,38 @@ ## 0.24.0  - Get rid of the `PrettyTypeShow` constraint in `Tangible`-- Get rid of `LogWriterEffects` and the necessity for some `UndecidableInstances` that came with it  +- Get rid of `LogWriterEffects` and the necessity for some `UndecidableInstances` that came with it - Add `Server` module for `Api` handling via type classes-    - Add `Stateless` +    - Add `Stateless`     - Add `GenServer`-- Reimplement `Supervisor`    -       +- Reimplement `Supervisor`+ ## 0.23.0  - Include the process id in the console and trace log renderer - Add a **process supervisor** similar to Erlang/OTPs simple_one_for_one supervisor. - Fix `SingleThreadedScheduler` process linking bug: A process shall not be interrupted-  when a linked process exits normally. -- Rename **ExitReason** to **Interrupt** and make the interrupt and exit handling -  API more robust. +  when a linked process exits normally.+- Rename **ExitReason** to **Interrupt** and make the interrupt and exit handling+  API more robust.  ## 0.22.1  - Fix duplicated content in RFC-5424 log message renderer -## 0.22.0    +## 0.22.0 -- Remove `SchedulerProxy` ruins +- Remove `SchedulerProxy` ruins  - Make message sending strict:    Ensure that every message sent from one process to another-  is reduced to normal form by the sender. +  is reduced to normal form by the sender.      - Remove *all* lazy message selectors     - Introduce a newtype wrapper `StrictDynamic` around `Dynamic`       and export only a constructor that deeply evaluates the-      value to *rnf* before converting it to a `Dynamic` +      value to *rnf* before converting it to a `Dynamic`  - Change the `Server` API for better system *vitality*: @@ -65,8 +75,8 @@  - Add more efficient log renderer:     - `renderLogMessageBodyNoLocation`-    - `renderRFC5424NoLocation`     -          +    - `renderRFC5424NoLocation`+ ## 0.21.2  - Fix copy-paste error: Remove the `LogsTo` constraint from `withAsyncLogWriter`

@@ -7,7 +7,7 @@ ## From Erlang to Haskell  This project is an attempt to implement core ideas learned from the **Erlang/OTP**  -framework in Haskell using **`extensible-effects`**.+framework in Haskell using **[extensible-effects](http://hackage.haskell.org/package/extensible-effects)**.  This library sketches my personal history of working on a large, real world Erlang application, trying to bring some of the ideas over to Haskell.@@ -23,7 +23,7 @@ The mental model of the programming framework regards objects as **processes** with an isolated internal state.  -**`Processes`** are at the center of that contraption. All *actions*+**[Processes](http://hackage.haskell.org/package/extensible-effects-concurrent-0.25.0/docs/Control-Eff-Concurrent-Process.html)** are at the center of that contraption. All *actions* happen in processes, and all *interactions* happen via messages sent between processes.  @@ -37,11 +37,13 @@ - A *multi-threaded* scheduler, based on the `async` - A *pure* single-threaded scheduler, based on coroutines +### Using the library+ For convenience, it is enough to import one of three modules: -- `Control.Eff.Concurrent` for a multi threaded scheduler and `LoggingAndIo`-- `Control.Eff.Concurrent.Pure`, for a single threaded scheduler and pure log capturing and otherwise no IO-- `Control.Eff.Concurrent.SingleThreaded`, for a single threaded scheduler and totally impure logging via IO+- [Control.Eff.Concurrent](http://hackage.haskell.org/package/extensible-effects-concurrent/docs/Control-Eff-Concurrent.html) for a multi threaded scheduler and `LoggingAndIo`+- [Control.Eff.Concurrent.Pure](http://hackage.haskell.org/package/extensible-effects-concurrent/docs/Control-Eff-Concurrent-Pure.html), for a single threaded scheduler and pure log capturing and otherwise no IO+- [Control.Eff.Concurrent.SingleThreaded](http://hackage.haskell.org/package/extensible-effects-concurrent/docs/Control-Eff-Concurrent-SingleThreaded.html), for a single threaded scheduler and totally impure logging via IO  ### Process Life-Cycles and Interprocess Links @@ -88,33 +90,28 @@  import           Control.Eff import           Control.Eff.Concurrent-import           Data.Dynamic-import           Control.DeepSeq-import           GHC.Stack (HasCallStack)  main :: IO ()-main = defaultMain firstExample--newtype WhoAreYou = WhoAreYou ProcessId -  deriving (Typeable, NFData, Show)+main = defaultMain example -firstExample -  :: (HasCallStack, Member Logs q) -  => Eff (InterruptableProcess q) ()-firstExample = do-  person <- spawn-    (do-      logInfo "I am waiting for someone to ask me..."-      WhoAreYou replyPid <- receiveMessage-      sendMessage replyPid "Alice"-      logInfo (show replyPid ++ " just needed to know it.")-    )-  me <- self-  sendMessage person (WhoAreYou me)+example :: Eff Effects ()+example = do+  person <- spawn "alice" alice+  replyToMe <- self+  sendMessage person replyToMe   personName <- receiveMessage-  logInfo ("I just met " ++ personName)+  logInfo' ("I just met " ++ personName) +alice :: Eff Effects ()+alice = do+  logInfo "I am waiting for someone to ask me..."+  sender <- receiveMessage+  sendMessage sender ("Alice" :: String)+  logInfo' (show sender ++ " message received.")+ ```+This is taken from [example-4](./examples/example-4/Main.hs).+  **Running** this example causes this output: 

@@ -1,2 +1,1 @@-{ pkgs ? (import <nixpkgs> {}) }:-pkgs.callPackage ./extensible-effects-concurrent.nix {}+import ./extensible-effects-concurrent.nix 

@@ -17,12 +17,13 @@  type instance ToPretty TestProtocol = PutStr "test" -data instance Pdu TestProtocol x where-  SayHello :: String -> Pdu TestProtocol ('Synchronous Bool)-  Shout :: String -> Pdu TestProtocol 'Asynchronous-  Terminate :: Pdu TestProtocol ('Synchronous ())-  TerminateError :: String -> Pdu TestProtocol ('Synchronous ())-  deriving (Typeable)+instance Typeable x => IsPdu TestProtocol x where+  data instance Pdu TestProtocol x where+    SayHello :: String -> Pdu TestProtocol ('Synchronous Bool)+    Shout :: String -> Pdu TestProtocol 'Asynchronous+    Terminate :: Pdu TestProtocol ('Synchronous ())+    TerminateError :: String -> Pdu TestProtocol ('Synchronous ())+    deriving (Typeable)  instance NFData (Pdu TestProtocol x) where   rnf (SayHello s) = rnf s

@@ -23,10 +23,11 @@  type instance ToPretty Counter = PutStr "counter" -data instance Pdu Counter x where-  Inc :: Pdu Counter 'Asynchronous-  Cnt :: Pdu Counter ('Synchronous Integer)-  deriving Typeable+instance Typeable x => IsPdu Counter x where+  data instance Pdu Counter x where+    Inc :: Pdu Counter 'Asynchronous+    Cnt :: Pdu Counter ('Synchronous Integer)+    deriving Typeable  instance NFData (Pdu Counter x) where   rnf Inc = ()@@ -66,9 +67,10 @@  type instance ToPretty SupiDupi = PutStr "supi dupi" -data instance Pdu SupiDupi r where-  Whoopediedoo :: Bool -> Pdu SupiDupi ('Synchronous (Maybe ()))-  deriving Typeable+instance Typeable r => IsPdu SupiDupi r where+  data instance Pdu SupiDupi r where+    Whoopediedoo :: Bool -> Pdu SupiDupi ('Synchronous (Maybe ()))+    deriving Typeable  instance Show (Pdu SupiDupi r) where   show (Whoopediedoo True) = "woopediedooo"@@ -86,7 +88,7 @@  type instance ToPretty (Counter, ObserverRegistry CounterChanged, SupiDupi) = PutStr "supi-counter" -instance (LogIo q) => Server SupiCounter q where+instance (LogIo q) => Server SupiCounter (Processes q) where    type instance Model SupiCounter =     ( Integer@@ -96,7 +98,7 @@             )     ) -  data instance StartArgument SupiCounter q = MkEmptySupiCounter+  data instance StartArgument SupiCounter (Processes q) = MkEmptySupiCounter    setup _ = return ((0, emptyObservers, Nothing), ()) @@ -136,8 +138,8 @@   svr <- start OCCStart   pure (toObserver svr) -instance Member Logs q => Server (Observer CounterChanged) q where-  data StartArgument (Observer CounterChanged) q = OCCStart+instance Member Logs q => Server (Observer CounterChanged) (Processes q) where+  data StartArgument (Observer CounterChanged) (Processes q) = OCCStart   type Model (Observer CounterChanged) = Observers CounterChanged   type Settings (Observer CounterChanged) = ()   type Protocol (Observer CounterChanged) = Observer CounterChanged

@@ -2,28 +2,21 @@  import           Control.Eff import           Control.Eff.Concurrent-import           Data.Dynamic-import           Control.DeepSeq-import           GHC.Stack (HasCallStack)  main :: IO ()-main =-    defaultMainWithLogWriter-      (defaultIoLogWriter "example-4" local0 consoleLogWriter)-      firstExample--newtype WhoAreYou = WhoAreYou ProcessId deriving (Typeable, NFData, Show)+main = defaultMain example -firstExample :: (HasCallStack, Member Logs q) => Eff (Processes q) ()-firstExample = do-  person <- spawn "first-example"-    (do-      logInfo "I am waiting for someone to ask me..."-      WhoAreYou replyPid <- receiveMessage-      sendMessage replyPid ("Alice" :: String)-      logInfo' (show replyPid ++ " just needed to know it.")-    )-  me <- self-  sendMessage person (WhoAreYou me)+example :: Eff Effects ()+example = do+  person <- spawn "alice" alice+  replyToMe <- self+  sendMessage person replyToMe   personName <- receiveMessage   logInfo' ("I just met " ++ personName)++alice :: Eff Effects ()+alice = do+  logInfo "I am waiting for someone to ask me..."+  sender <- receiveMessage+  sendMessage sender ("Alice" :: String)+  logInfo' (show sender ++ " message received.")

@@ -1,6 +1,6 @@ cabal-version:  2.0 name:           extensible-effects-concurrent-version:        0.25.0+version:        0.25.1 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@@ -58,6 +58,7 @@       monad-control >= 1.0 && < 1.1,       extensible-effects >= 5 && < 6,       stm >= 2.4.5 && <2.6,+      tagged >= 0.8 && < 0.9,       transformers-base >= 0.4 && < 0.5,       text >= 1.2 && < 1.3,       network >= 2 && < 4,

@@ -1,5 +1,7 @@-{ lib, haskellPackages }: let+  pkgs = import ./pkgs.nix;+  lib = pkgs.lib;+  haskellPackages = pkgs.haskellPackages;   cleanSrc = lib.cleanSourceWith {     filter = (path: type:       let base = baseNameOf (toString path);

@@ -1,2 +1,22 @@-{ pkgs ? (import <nixpkgs> {}) }:-pkgs.callPackage ./extensible-effects-concurrent.nix {}+let extensible-effects-concurrent = import ./extensible-effects-concurrent.nix;+    pkgs         = import <nixpkgs> {};+in+pkgs.haskellPackages.shellFor {+      packages = p: [extensible-effects-concurrent];+      withHoogle = true;+      buildInputs = with pkgs.haskellPackages;+                    [ pkgs.cabal-install+                      pkgs.cabal2nix+                      pkgs.erlang+                      ghcid+                      hoogle+                      pointfree+                      graphmod+                      cabal-plan+                      # brittany+                      weeder+                      pkgs.stack+                      pkgs.nix+                      pkgs.graphviz-nox+                    ];+      }

@@ -72,6 +72,10 @@ where  import           Control.Eff.Concurrent.Process ( Process(..)+                                                , ProcessTitle(..)+                                                , fromProcessTitle+                                                , ProcessDetails(..)+                                                , fromProcessDetails                                                 , StrictDynamic()                                                 , toStrictDynamic                                                 , fromStrictDynamic@@ -171,7 +175,8 @@                                                 )  import           Control.Eff.Concurrent.Protocol-                                                ( Pdu(..)+                                                ( IsPdu(..)+                                                , Pdu(..)                                                 , Synchronicity(..)                                                 , ProtocolReply                                                 , Tangible@@ -181,12 +186,16 @@                                                 , proxyAsEndpoint                                                 , asEndpoint                                                 , EmbedProtocol(..)+                                                , toEmbeddedEndpoint+                                                , fromEmbeddedEndpoint                                                 ) import           Control.Eff.Concurrent.Protocol.Client                                                 ( cast                                                 , call                                                 , callWithTimeout+                                                , castSingleton                                                 , castEndpointReader+                                                , callSingleton                                                 , callEndpointReader                                                 , ServesProtocol                                                 , runEndpointReader

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

@@ -15,7 +15,8 @@ -- the "Control.Eff.Concurrent.Pdu.Client" should be used. -- module Control.Eff.Concurrent.Protocol-  ( Pdu(..)+  ( IsPdu(..)+  , Pdu(..)   , Synchronicity(..)   , ProtocolReply   , Tangible@@ -25,6 +26,8 @@   , proxyAsEndpoint   , asEndpoint   , EmbedProtocol(..)+  , toEmbeddedEndpoint+  , fromEmbeddedEndpoint   , prettyTypeableShows   , prettyTypeableShowsPrec   )@@ -33,11 +36,15 @@ import           Control.DeepSeq import           Control.Eff.Concurrent.Process import           Control.Lens+import           Data.Coerce+import           Data.Dynamic import           Data.Kind-import           Type.Reflection+import           Data.Typeable () import           Data.Type.Pretty+import           Type.Reflection --- | This data family defines the **protocol data units**(PDU) of a /protocol/.++-- | This data family defines the __protocol data units__ (PDU) of a /protocol/. -- -- A Protocol in the sense of a communication interface description -- between processes.@@ -54,16 +61,35 @@ -- > -- > data BookShop deriving Typeable -- >--- > data instance Pdu BookShop r where--- >   RentBook  :: BookId   -> Pdu BookShop ('Synchronous (Either RentalError RentalId))--- >   BringBack :: RentalId -> Pdu BookShop 'Asynchronous+-- > instance IsPdu BookShop r where+-- >   data instance Pdu BookShop r where+-- >     RentBook  :: BookId   -> Pdu BookShop ('Synchronous (Either RentalError RentalId))+-- >     BringBack :: RentalId -> Pdu BookShop 'Asynchronous+-- >     deriving Typeable -- > -- > type BookId = Int -- > type RentalId = Int -- > type RentalError = String -- >-data family Pdu (protocol :: Type) (reply :: Synchronicity)+--+-- @since 0.25.1+class (NFData (Pdu protocol reply), Show (Pdu protocol reply), Typeable protocol, Typeable reply) => IsPdu (protocol :: Type) (reply :: Synchronicity) where+  -- | 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) +  default deserializePdu :: (Typeable (Pdu protocol reply)) => Dynamic -> Maybe (Pdu protocol reply)+  deserializePdu = fromDynamic++  -- | The __protocol data unit__ type for the given protocol.+  data family Pdu protocol reply++  --  type family PrettyPdu protocol reply :: PrettyType+  --  type instance PrettyPdu protocol reply =+  --      PrettySurrounded (PutStr "<") (PutStr ">") ("protocol" <:> ToPretty protocol <+> ToPretty reply)++ type instance ToPretty (Pdu x y) =   PrettySurrounded (PutStr "<") (PutStr ">") ("protocol" <:> ToPretty x <+> ToPretty y) @@ -176,16 +202,44 @@   fromPdu :: Pdu protocol r -> Maybe (Pdu embeddedProtocol r)   fromPdu = preview embeddedPdu ++-- | Convert an 'Endpoint' to an endpoint for an embedded protocol.+--+-- See 'EmbedProtocol', 'fromEmbeddedEndpoint'.+--+-- @since 0.25.1+toEmbeddedEndpoint :: forall inner outer . EmbedProtocol outer inner => Endpoint outer -> Endpoint inner+toEmbeddedEndpoint = coerce++-- | Convert an 'Endpoint' to an endpoint for a server, that embeds the protocol.+--+-- See 'EmbedProtocol', 'toEmbeddedEndpoint'.+--+-- @since 0.25.1+fromEmbeddedEndpoint ::  forall outer inner. EmbedProtocol outer inner => Endpoint inner -> Endpoint outer+fromEmbeddedEndpoint = coerce+ instance EmbedProtocol a a where   embeddedPdu = prism' id Just   embedPdu = id   fromPdu = Just -data instance Pdu (a1, a2) x where-        ToPduLeft :: Pdu a1 r -> Pdu (a1, a2) r-        ToPduRight :: Pdu a2 r -> Pdu (a1, a2) r-  deriving Typeable+instance (IsPdu a1 r, IsPdu a2 r) => IsPdu (a1, a2) r where+  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 (NFData (Pdu a1 r), NFData (Pdu a2 r)) => NFData (Pdu (a1, a2) r) where   rnf (ToPduLeft x) = rnf x   rnf (ToPduRight y) = rnf y@@ -205,12 +259,27 @@       ToPduRight r -> Just r       ToPduLeft _ -> Nothing -data instance Pdu (a1, a2, a3) x 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-  deriving Typeable+instance (IsPdu a1 r, IsPdu a2 r, IsPdu a3 r) => IsPdu (a1, a2, a3) r where+  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 (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@@ -236,13 +305,32 @@   fromPdu (ToPdu3 l) = Just l   fromPdu _ = Nothing -data instance Pdu (a1, a2, a3, a4) x 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-  deriving Typeable+instance (IsPdu a1 r, IsPdu a2 r, IsPdu a3 r, IsPdu a4 r) => IsPdu (a1, a2, a3, a4) r where+  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 (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@@ -275,13 +363,36 @@   fromPdu (ToPdu4Of4 l) = Just l   fromPdu _ = Nothing -data instance Pdu (a1, a2, a3, a4, a5) x where-  ToPdu1Of5 :: Pdu a1 r -> Pdu (a1, a2, a3, a4, a5) r-  ToPdu2Of5 :: Pdu a2 r -> Pdu (a1, a2, a3, a4, a5) r-  ToPdu3Of5 :: Pdu a3 r -> Pdu (a1, a2, a3, a4, a5) r-  ToPdu4Of5 :: Pdu a4 r -> Pdu (a1, a2, a3, a4, a5) r-  ToPdu5Of5 :: Pdu a5 r -> Pdu (a1, a2, a3, a4, a5) r-  deriving Typeable+instance (IsPdu a1 r, IsPdu a2 r, IsPdu a3 r, IsPdu a4 r, IsPdu a5 r) => IsPdu (a1, a2, a3, a4, a5) r where+  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+    ToPdu3Of5 :: Pdu a3 r -> Pdu (a1, a2, a3, a4, a5) r+    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  instance (NFData (Pdu a1 r), NFData (Pdu a2 r), NFData (Pdu a3 r), NFData (Pdu a4 r), NFData (Pdu a5 r)) => NFData (Pdu (a1, a2, a3, a4, a5) r) where   rnf (ToPdu1Of5 x) = rnf x

@@ -7,7 +7,9 @@   , call   , callWithTimeout   -- * Server Process Registration+  , castSingleton   , castEndpointReader+  , callSingleton   , callEndpointReader   , ServesProtocol   , EndpointReader@@ -38,8 +40,8 @@    . ( HasCallStack      , SetMember Process (Process q) r      , Member Interrupts r-     , TangiblePdu o' 'Asynchronous-     , TangiblePdu o 'Asynchronous+     , IsPdu o' 'Asynchronous+     , IsPdu o 'Asynchronous      , EmbedProtocol o' o      )   => Endpoint o'@@ -165,6 +167,8 @@  -- | Like 'call' but take the 'Endpoint' from the reader provided by -- 'runEndpointReader'.+--+-- When working with an embedded 'Pdu' use 'callSingleton'. callEndpointReader   :: forall reply o r q .      ( ServesProtocol o r q@@ -181,15 +185,60 @@  -- | Like 'cast' but take the 'Endpoint' from the reader provided by -- 'runEndpointReader'.+--+-- When working with an embedded 'Pdu' use 'castSingleton'. castEndpointReader   :: forall o r q .      ( ServesProtocol o r q      , HasCallStack      , Member Interrupts r-     , TangiblePdu o 'Asynchronous+     , IsPdu o 'Asynchronous      )   => Pdu o 'Asynchronous   -> Eff r () castEndpointReader method = do   serverPid <- askEndpoint @o   cast @o @o serverPid method++-- | Like 'callEndpointReader', uses 'embedPdu' to embed the value.+--+-- This function makes use of AmbigousTypes and TypeApplications.+--+-- When not working with an embedded 'Pdu' use 'callEndpointReader'.+--+-- @since 0.25.1+callSingleton+  :: forall outer inner reply q e+  . ( HasCallStack+    , EmbedProtocol outer inner+    , Member (EndpointReader outer) e+    , SetMember Process (Process q) e+    , Member Interrupts e+    , TangiblePdu outer ('Synchronous reply)+    , TangiblePdu inner ('Synchronous reply)+    , Tangible reply+    )+  => Pdu inner ('Synchronous reply)+  -> Eff e reply+callSingleton = withFrozenCallStack $ \p -> callEndpointReader (embedPdu @outer @inner p)++-- | Like 'castEndpointReader', but uses 'embedPdu' to embed the value.+--+-- This function makes use of AmbigousTypes and TypeApplications.+--+-- When not working with an embedded 'Pdu' use 'castEndpointReader'.+--+-- @since 0.25.1+castSingleton+  :: forall outer inner q e+  . ( HasCallStack+    , EmbedProtocol outer inner+    , Member (EndpointReader outer) e+    , SetMember Process (Process q) e+    , Member Interrupts e+    , IsPdu outer 'Asynchronous+    , IsPdu inner 'Asynchronous+    )+  => Pdu inner 'Asynchronous+  -> Eff e ()+castSingleton = withFrozenCallStack $ \p -> castEndpointReader (embedPdu @outer @inner p)

@@ -16,6 +16,7 @@   , RequestOrigin(..)   , Reply(..)   , sendReply+  , sendEmbeddedReply   , toEmbeddedOrigin   , embedReplySerializer   )

@@ -34,6 +34,7 @@ import           Data.Data                     (typeOf) import           Data.Dynamic import           Data.Foldable+import           Data.Kind import           Data.Proxy import           Data.Set                       ( Set ) import qualified Data.Set                      as Set@@ -53,7 +54,7 @@ data Observer o where   Observer     :: ( Tangible o-       , TangiblePdu p 'Asynchronous+       , IsPdu p 'Asynchronous        , Tangible (Endpoint p)        , Typeable p        )@@ -64,7 +65,7 @@ -- -- @since 0.24.0 type TangibleObserver o =-  ( Tangible o, TangiblePdu (Observer o) 'Asynchronous)+  ( Tangible o, IsPdu (Observer o) 'Asynchronous)  type instance ToPretty (Observer o) =   PrettyParens ("observing" <:> ToPretty o)@@ -97,7 +98,7 @@      , Member Interrupts r      , TangibleObserver o      , EmbedProtocol x (ObserverRegistry o)-     , TangiblePdu x 'Asynchronous+     , IsPdu x 'Asynchronous      )   => Observer o   -> Endpoint x@@ -115,7 +116,7 @@      , Typeable o      , NFData o      , EmbedProtocol x (ObserverRegistry o)-     , TangiblePdu x 'Asynchronous+     , IsPdu x 'Asynchronous      )   => Observer o   -> Endpoint x@@ -130,14 +131,15 @@ -- any other 'Asynchronous' 'Pdu' message type for receiving observations. -- -- @since 0.16.0-data instance Pdu (Observer o) r where-  -- | This message denotes that the given value was 'observed'.-  ---  -- @since 0.16.1-  Observed :: o -> Pdu (Observer o) 'Asynchronous-  deriving Typeable+instance (NFData o, Show o, Typeable o, Typeable r) => IsPdu (Observer o) r where+  data instance Pdu (Observer o) r where+    -- | This message denotes that the given value was 'observed'.+    --+    -- @since 0.16.1+    Observed :: o -> Pdu (Observer o) 'Asynchronous+    deriving Typeable -instance NFData o => NFData (Pdu (Observer o) 'Asynchronous) where+instance NFData o => NFData (Pdu (Observer o) r) where   rnf (Observed o) = rnf o  instance Show o => Show (Pdu (Observer o) r) where@@ -157,8 +159,15 @@ -- | Use a 'Endpoint' as an 'Observer' for 'handleObservations'. -- -- @since 0.16.0-toObserver :: TangibleObserver o => Endpoint (Observer o) -> Observer o-toObserver = toObserverFor Observed+toObserver+  :: forall o p+  . ( IsPdu p 'Asynchronous+    , EmbedProtocol p (Observer o)+    , TangibleObserver o+    )+  => Endpoint p+  -> Observer o+toObserver = toObserverFor (embedPdu @p . Observed)  -- | Create an 'Observer' that conditionally accepts all observations of the -- given type and applies the given function to them; the function takes an observation and returns an 'Pdu'@@ -166,7 +175,7 @@ -- -- @since 0.16.0 toObserverFor-  :: (TangibleObserver o, Typeable a, TangiblePdu a 'Asynchronous)+  :: (TangibleObserver o, Typeable a, IsPdu a 'Asynchronous)   => (o -> Pdu a 'Asynchronous)   -> Endpoint a   -> Observer o@@ -178,27 +187,28 @@ -- 'Observer's. -- -- @since 0.16.0-data ObserverRegistry o+data ObserverRegistry (o :: Type)   deriving Typeable  type instance ToPretty (ObserverRegistry o) =   PrettyParens ("observer registry" <:> ToPretty o) --- | Protocol for managing observers. This can be added to any server for any number of different observation types.--- The functions 'manageObservers' and 'handleObserverRegistration' are used to include observer handling;------ @since 0.16.0-data instance Pdu (ObserverRegistry o) r where-  -- | This message denotes that the given 'Observer' should receive observations until 'ForgetObserver' is-  --   received.-  ---  -- @since 0.16.1-  RegisterObserver :: NFData o => Observer o -> Pdu (ObserverRegistry o) 'Asynchronous-  -- | This message denotes that the given 'Observer' should not receive observations anymore.+instance (Typeable o, Typeable r) => IsPdu (ObserverRegistry o) r where+  -- | Protocol for managing observers. This can be added to any server for any number of different observation types.+  -- The functions 'manageObservers' and 'handleObserverRegistration' are used to include observer handling;   ---  -- @since 0.16.1-  ForgetObserver :: NFData o => Observer o -> Pdu (ObserverRegistry o) 'Asynchronous-  deriving Typeable+  -- @since 0.16.0+  data instance Pdu (ObserverRegistry o) r where+    -- | This message denotes that the given 'Observer' should receive observations until 'ForgetObserver' is+    --   received.+    --+    -- @since 0.16.1+    RegisterObserver :: NFData o => Observer o -> Pdu (ObserverRegistry o) 'Asynchronous+    -- | This message denotes that the given 'Observer' should not receive observations anymore.+    --+    -- @since 0.16.1+    ForgetObserver :: NFData o => Observer o -> Pdu (ObserverRegistry o) 'Asynchronous+    deriving Typeable  instance NFData (Pdu (ObserverRegistry o) r) where   rnf (RegisterObserver o) = rnf o

@@ -93,7 +93,7 @@ -- -- @ -- withObservationQueue 100 $ do---   q  <- ask \@(ObservationQueueReader TestEvent)+--   q  <- ask \@(ObservationQueue TestEvent) --   wq <- spawnLinkObservationQueueWriter q --   registerObserver wq testServer --   ...@@ -137,7 +137,7 @@ spawnLinkObservationQueueWriter   :: forall o q h    . ( TangibleObserver o-     , TangiblePdu (Observer o) 'Asynchronous+     , IsPdu (Observer o) 'Asynchronous      , Member Logs q      , Lifted IO q      , LogsTo h (Processes q)@@ -148,10 +148,10 @@   cbo <- startLink (MkObservationQueue q)   pure (toObserver cbo) -instance (TangibleObserver o, TangiblePdu (Observer o) 'Asynchronous, Lifted IO q, Member Logs q) => Server (ObservationQueue o) q where+instance (TangibleObserver o, IsPdu (Observer o) 'Asynchronous, Lifted IO q, Member Logs q) => Server (ObservationQueue o) (Processes q) where   type Protocol (ObservationQueue o) = Observer o -  data instance StartArgument (ObservationQueue o) q =+  data instance StartArgument (ObservationQueue o) (Processes q) =      MkObservationQueue (ObservationQueue o)    update (MkObservationQueue (ObservationQueue q)) =

@@ -4,6 +4,7 @@ module Control.Eff.Concurrent.Protocol.Request   ( Request(..)   , sendReply+  , sendEmbeddedReply   , RequestOrigin(..)   , embedRequestOrigin   , toEmbeddedOrigin@@ -17,9 +18,10 @@ import Control.Eff import Control.Eff.Concurrent.Process import Control.Eff.Concurrent.Protocol+import Data.Functor.Contravariant import Data.Kind (Type) import Data.Typeable (Typeable)-import Data.Functor.Contravariant+import Data.Tagged import GHC.Generics  -- | A wrapper sum type for calls and casts for the 'Pdu's of a protocol@@ -97,15 +99,33 @@ -- -- The reply will be deeply evaluated to 'rnf'. ----- To send replies for 'EmbedProtocol' instances use 'embedReplySerializer'--- and 'toEmbeddedOrigin'.+-- To send replies for 'EmbedProtocol' instances use 'sendEmbeddedReply',+-- or 'embedReplySerializer' and 'toEmbeddedOrigin'. -- -- @since 0.15.0 sendReply ::+  forall protocol reply q eff .      (SetMember Process (Process q) eff, Member Interrupts eff, Tangible reply, Typeable protocol)   => Serializer (Reply protocol reply) -> RequestOrigin protocol reply -> reply -> Eff eff () sendReply ser o r = sendAnyMessage (_requestOriginPid o) $! runSerializer ser $! Reply o r +-- | Send a 'Reply' to a 'Call' for an embedded 'Pdu'.+--+-- The reply will be deeply evaluated to 'rnf'.+--+-- @since 0.25.1+sendEmbeddedReply ::+  forall outer inner reply q eff .+     ( SetMember Process (Process q) eff+     , Member Interrupts eff+     , TangiblePdu outer ('Synchronous reply)+     , TangiblePdu inner ('Synchronous reply)+     , Tangible reply+     , EmbedProtocol outer inner+     )+  => Serializer (Reply outer reply) -> RequestOrigin outer reply -> Tagged inner reply -> Eff eff ()+sendEmbeddedReply ser o = sendReply @outer @reply (embedReplySerializer ser) (toEmbeddedOrigin o) . unTagged+ -- | Turn an 'RequestOrigin' to an origin for an embedded request (See 'EmbedProtocol'). -- -- This is useful of a server delegates the @calls@ and @casts@ for an embedded protocol@@ -116,7 +136,7 @@ -- -- @since 0.24.3 toEmbeddedOrigin-  :: EmbedProtocol outer inner+  :: forall outer inner reply . EmbedProtocol outer inner   => RequestOrigin outer reply   -> RequestOrigin inner reply toEmbeddedOrigin (RequestOrigin !pid !ref) = RequestOrigin pid ref@@ -128,7 +148,7 @@ -- This function is strict in all parameters. -- -- @since 0.24.2-embedRequestOrigin :: EmbedProtocol outer inner => RequestOrigin inner reply -> RequestOrigin outer reply+embedRequestOrigin :: forall outer inner reply . EmbedProtocol 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@@ -141,7 +161,7 @@ -- See also 'toEmbeddedOrigin'. -- -- @since 0.24.2-embedReplySerializer :: EmbedProtocol outer inner => Serializer (Reply outer reply) -> Serializer (Reply inner reply)+embedReplySerializer :: forall outer inner reply . EmbedProtocol outer inner => Serializer (Reply outer reply) -> Serializer (Reply inner reply) embedReplySerializer = contramap embedReply  -- | Turn an /embedded/ 'Reply' to a 'Reply' for the /bigger/ request.@@ -149,5 +169,5 @@ -- This function is strict in all parameters. -- -- @since 0.24.2-embedReply :: EmbedProtocol outer inner => Reply inner reply -> Reply outer reply+embedReply :: forall outer inner reply . EmbedProtocol outer inner => Reply inner reply -> Reply outer reply embedReply (Reply (RequestOrigin !pid !ref) !v) = Reply (RequestOrigin pid ref) v

@@ -22,6 +22,7 @@   , RequestOrigin(..)   , Reply(..)   , sendReply+  , sendEmbeddedReply   , toEmbeddedOrigin   , embedReplySerializer   )@@ -81,19 +82,19 @@   -- | Return an initial 'Model' and 'Settings'   setup ::        StartArgument a q-    -> Eff (Processes q) (Model a, Settings a)+    -> Eff q (Model a, Settings a)    default setup ::        (Default (Model a), Default (Settings a))     => StartArgument a q-    -> Eff (Processes q) (Model a, Settings a)+    -> Eff q (Model a, Settings a)   setup _ = pure (def, def)    -- | Update the 'Model' based on the 'Event'.   update ::        StartArgument a q     -> Effectful.Event (Protocol a)-    -> Eff (ModelState a ': SettingsReader a ': Processes q) ()+    -> Eff (ModelState a ': SettingsReader a ': q) ()  -- | This type is used to build stateful 'EffectfulServer' instances. --@@ -102,10 +103,10 @@ -- @since 0.24.0 data Stateful a deriving Typeable -instance Server a q => Effectful.Server (Stateful a) (Processes q) where-  data Init (Stateful a) (Processes q) = Init (StartArgument a q)+instance Server a q => Effectful.Server (Stateful a) q where+  data Init (Stateful a) q = Init (StartArgument a q)   type ServerPdu (Stateful a) = Protocol a-  type ServerEffects (Stateful a) (Processes q) = ModelState a ': SettingsReader a ': Processes q+  type ServerEffects (Stateful a) q = ModelState a ': SettingsReader a ': q    runEffects (Init sa) m = do     (st, env) <- setup sa@@ -123,9 +124,9 @@     , Typeable a     , LogsTo h (Processes q)     , Effectful.Server (Stateful a) (Processes q)-    , Server a q+    , Server a (Processes q)     )-  => StartArgument a q -> Eff (Processes q) (Endpoint (Protocol a))+  => StartArgument a (Processes q) -> Eff (Processes q) (Endpoint (Protocol a)) start = Effectful.start . Init  -- | Execute the server loop.@@ -137,9 +138,9 @@     , Typeable a     , LogsTo h (Processes q)     , Effectful.Server (Stateful a) (Processes q)-    , Server a q+    , Server a (Processes q)     )-  => StartArgument a q -> Eff (Processes q) (Endpoint (Protocol a))+  => StartArgument a (Processes q) -> Eff (Processes q) (Endpoint (Protocol a)) startLink = Effectful.startLink . Init  

@@ -79,6 +79,7 @@ import Data.Default import Data.Dynamic import Data.Foldable+import Data.Kind import qualified Data.Map as Map import Data.Text (Text, pack) import Data.Type.Pretty@@ -97,18 +98,19 @@ -- The supervisor maps an identifier value of type @'ChildId' p@ to an @'Endpoint' p@. -- -- @since 0.24.0-data Sup p deriving Typeable+data Sup (p :: Type) deriving Typeable --- | The 'Pdu' instance contains methods to start, stop and lookup a child--- process, as well as a diagnostic callback.------ @since 0.23.0-data instance  Pdu (Sup p) r where-        StartC :: ChildId p -> Pdu (Sup p) ('Synchronous (Either (SpawnErr p) (Endpoint (Protocol p))))-        StopC :: ChildId p -> Timeout -> Pdu (Sup p) ('Synchronous Bool)-        LookupC :: ChildId p -> Pdu (Sup p) ('Synchronous (Maybe (Endpoint (Protocol p))))-        GetDiagnosticInfo :: Pdu (Sup p) ('Synchronous Text)-    deriving Typeable+instance (NFData (Pdu (Sup p) r), Show (Pdu (Sup p) r), Typeable p, Typeable r) => IsPdu (Sup p) r where+  -- | The 'Pdu' instance contains methods to start, stop and lookup a child+  -- process, as well as a diagnostic callback.+  --+  -- @since 0.23.0+  data instance  Pdu (Sup p) r where+          StartC :: ChildId p -> Pdu (Sup p) ('Synchronous (Either (SpawnErr p) (Endpoint (Protocol p))))+          StopC :: ChildId p -> Timeout -> Pdu (Sup p) ('Synchronous Bool)+          LookupC :: ChildId p -> Pdu (Sup p) ('Synchronous (Maybe (Endpoint (Protocol p))))+          GetDiagnosticInfo :: Pdu (Sup p) ('Synchronous Text)+      deriving Typeable  instance (Show (ChildId p)) => Show (Pdu (Sup p) ('Synchronous r)) where   showsPrec d (StartC c) = showParen (d >= 10) (showString "StartC " . showsPrec 10 c)@@ -142,11 +144,11 @@   instance-  ( Lifted IO q, LogsTo IO q+  ( LogIo q   , TangibleSup p   , Tangible (ChildId p)-  , Server p q-  ) => Server (Sup p) q where+  , Server p (Processes q)+  ) => Server (Sup p) (Processes q) where    -- | Options that control the 'Sup p' process.   --@@ -156,12 +158,12 @@   -- * the 'Timeout' after requesting a normal child exit before brutally killing the child.   --   -- @since 0.24.0-  data StartArgument (Sup p) q = MkSupConfig+  data StartArgument (Sup p) (Processes q) = MkSupConfig     {       -- , supConfigChildRestartPolicy :: ChildRestartPolicy       -- , supConfigResilience :: Resilience       supConfigChildStopTimeout :: Timeout-    , supConfigStartFun :: ChildId p -> Server.StartArgument p q+    , supConfigStartFun :: ChildId p -> Server.StartArgument p (Processes q)     }    type Model (Sup p) = Children (ChildId p) p@@ -255,9 +257,9 @@     , LogsTo IO (Processes e)     , Lifted IO e     , TangibleSup p-    , Server (Sup p) e+    , Server (Sup p) (Processes e)     )-  => StartArgument (Sup p) e+  => StartArgument (Sup p) (Processes e)   -> Eff (Processes e) (Endpoint (Sup p)) startSupervisor = Server.start 

@@ -26,10 +26,11 @@  type instance ToPretty Small = PutStr "small" -data instance  Pdu Small r where-        SmallCall :: Bool -> Pdu Small ('Synchronous Bool)-        SmallCast :: String -> Pdu Small 'Asynchronous-    deriving Typeable+instance Typeable r => IsPdu Small r where+  data instance  Pdu Small r where+          SmallCall :: Bool -> Pdu Small ('Synchronous Bool)+          SmallCast :: String -> Pdu Small 'Asynchronous+      deriving Typeable  instance NFData (Pdu Small r) where   rnf (SmallCall x) = rnf x@@ -42,8 +43,8 @@  -- ---------------------------------------------------------------------------- -instance LogIo e => S.Server Small e where-  data StartArgument Small e = MkSmall+instance LogIo e => S.Server Small (Processes e) where+  data StartArgument Small (Processes e) = MkSmall   type Model Small = String   update MkSmall x =     case x of@@ -60,11 +61,12 @@  type instance ToPretty Big = PutStr "big" -data instance  Pdu Big r where-        BigCall :: Bool -> Pdu Big ('Synchronous Bool)-        BigCast :: String -> Pdu Big 'Asynchronous-        BigSmall :: Pdu Small r -> Pdu Big r-    deriving Typeable+instance Typeable r => IsPdu Big r where+  data instance  Pdu Big r where+          BigCall :: Bool -> Pdu Big ('Synchronous Bool)+          BigCast :: String -> Pdu Big 'Asynchronous+          BigSmall :: Pdu Small r -> Pdu Big r+      deriving Typeable  instance NFData (Pdu Big r) where   rnf (BigCall x) = rnf x@@ -86,8 +88,8 @@  -- ---------------------------------------------------------------------------- -instance LogIo e => S.Server Big e where-  data instance StartArgument Big e = MkBig+instance LogIo e => S.Server Big (Processes e) where+  data instance StartArgument Big (Processes e) = MkBig   type Model Big = String   update MkBig = \case     E.OnCall ser orig req ->

@@ -90,9 +90,10 @@  type instance ToPretty ReturnToSender = PutStr "ReturnToSender" -data instance Pdu ReturnToSender r where-  ReturnToSender :: ProcessId -> String -> Pdu ReturnToSender ('Synchronous Bool)-  StopReturnToSender :: Pdu ReturnToSender ('Synchronous ())+instance Typeable r => IsPdu ReturnToSender r where+ data instance Pdu ReturnToSender r where+   ReturnToSender :: ProcessId -> String -> Pdu ReturnToSender ('Synchronous Bool)+   StopReturnToSender :: Pdu ReturnToSender ('Synchronous ())  instance NFData (Pdu ReturnToSender r) where   rnf (ReturnToSender p s) = rnf p `seq` rnf s

@@ -246,10 +246,11 @@  type instance ToPretty TestProtocol = PutStr "test" -data instance  Pdu TestProtocol x where-        TestGetStringLength :: String -> Pdu TestProtocol ('Synchronous Int)-        TestInterruptWith :: Interrupt 'Recoverable -> Pdu TestProtocol 'Asynchronous-    deriving Typeable+instance Typeable x => IsPdu TestProtocol x where+  data instance Pdu TestProtocol x where+    TestGetStringLength :: String -> Pdu TestProtocol ('Synchronous Int)+    TestInterruptWith :: Interrupt 'Recoverable -> Pdu TestProtocol 'Asynchronous+      deriving Typeable  instance NFData (Pdu TestProtocol x) where   rnf (TestGetStringLength x) = rnf x@@ -264,7 +265,7 @@   | ExitWhenRequested   deriving Eq -instance Server TestProtocol BaseEffects where+instance Server TestProtocol Effects where   update (TestServerArgs testMode tId) evt =     case evt of       OnCast (TestInterruptWith i) -> do@@ -283,6 +284,6 @@             exitBecause (interruptToExit x)       _ ->         logDebug (pack (show tId) <> ": got some info: " <> pack (show evt))-  data instance StartArgument TestProtocol BaseEffects = TestServerArgs TestProtocolServerMode Int+  data instance StartArgument TestProtocol Effects = TestServerArgs TestProtocolServerMode Int  type instance ChildId TestProtocol = Int

@@ -2,7 +2,7 @@ {  # Library of functions to use, for composeExtensions.-lib ? (import <nixpkgs> {}).pkgs.lib+lib ? (import <nixpkgs> {}).pkgs.lib,  # Input set of all haskell packages. A valid input would be: # (import <nixpkgs> {}).pkgs.haskellPackages