Lean into static pointers

packages/distributed-process-async/CHANGELOG.md

@@ -1,3 +1,7 @@
+Unreleased
+
+* Breaking: `remoteTask` takes a `Closure (SerializableDict a)` instead of a `Static (SerializableDict a)`.
+
 2025-02-04 Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.2.11
 
 * Ported test suite to use `tasty` rather than `test-framework`.

packages/distributed-process-async/distributed-process-async.cabal

@@ -1,6 +1,6 @@
 cabal-version:  3.0
 name:           distributed-process-async
-version:        0.2.11
+version:        0.3.0
 build-type:     Simple
 license:        BSD-3-Clause
 license-file:   LICENCE
@@ -38,7 +38,7 @@ library
   import:          warnings
   build-depends:
                    base >= 4.14 && < 5,
-                   distributed-process >= 0.6.1 && < 0.8,
+                   distributed-process >= 0.8 && < 0.9,
                    exceptions >= 0.10 && < 1.0,
                    binary >= 0.8 && < 0.9,
                    stm >= 2.4 && < 2.6,

packages/distributed-process-async/src/Control/Distributed/Process/Async.hs

@@ -80,7 +80,7 @@ task :: Process a -> AsyncTask a
 task = AsyncTask
 
 -- | Wraps the components required and builds a remote 'AsyncTask'.
-remoteTask :: Static (SerializableDict a)
+remoteTask :: Closure (SerializableDict a)
               -> NodeId
               -> Closure (Process a)
               -> AsyncTask a

packages/distributed-process-async/src/Control/Distributed/Process/Async/Internal/Types.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveDataTypeable        #-}
-{-# LANGUAGE TemplateHaskell           #-}
 {-# LANGUAGE StandaloneDeriving        #-}
 {-# LANGUAGE RankNTypes                #-}
 {-# LANGUAGE ExistentialQuantification #-}
@@ -55,7 +54,7 @@ data AsyncTask a =
         asyncTask :: Process a -- ^ the task to be performed
       }
   | AsyncRemoteTask {
-        asyncTaskDict :: Static (SerializableDict a)
+        asyncTaskDict :: Closure (SerializableDict a)
           -- ^ the serializable dict required to spawn a remote process
       , asyncTaskNode :: NodeId
           -- ^ the node on which to spawn the asynchronous task

packages/distributed-process-async/tests/TestAsync.hs

@@ -1,5 +1,5 @@
+{-# LANGUAGE StaticPointers #-}
 {-# LANGUAGE DeriveDataTypeable        #-}
-{-# LANGUAGE TemplateHaskell           #-}
 {-# LANGUAGE ScopedTypeVariables       #-}
 
 module Main where
@@ -12,7 +12,7 @@ import Control.Distributed.Process.Serializable()
 import Control.Distributed.Process.Async
 import Control.Distributed.Process.SysTest.Utils
 import Control.Monad (replicateM_)
-import Data.Binary()
+import Data.Binary (decode, encode)
 import Data.Typeable()
 import Network.Transport.TCP
 import qualified Network.Transport as NT
@@ -139,18 +139,15 @@ testAsyncWaitCancelTimeout result = do
      p1 <- async $ task expect
      waitCancelTimeout 1000000 p1 >>= stash result
 
-remotableDecl [
-    [d| fib :: (NodeId,Int) -> Process Integer ;
-        fib (_,0) = return 0
-        fib (_,1) = return 1
-        fib (myNode,n) = do
-          let tsk = remoteTask ($(functionTDict 'fib)) myNode ($(mkClosure 'fib) (myNode,n-2))
-          future <- async tsk
-          y <- fib (myNode,n-1)
-          (AsyncDone z) <- wait future
-          return $ y + z
-      |]
-  ]
+fib :: (NodeId,Int) -> Process Integer
+fib (_,0) = return 0
+fib (_,1) = return 1
+fib (myNode,n) = do
+  let tsk = remoteTask (static SerializableDict) myNode (closure (static (fib . decode)) (encode (myNode, n-2)))
+  future <- async tsk
+  y <- fib (myNode,n-1)
+  (AsyncDone z) <- wait future
+  return $ y + z
 
 -- Tests that wait returns when remote actions complete.
 testAsyncRecursive :: TestResult Integer -> Process ()
@@ -212,7 +209,7 @@ tests localNode = testGroup "" [
 
 asyncStmTests :: NT.Transport -> IO TestTree
 asyncStmTests transport = do
-  localNode <- newLocalNode transport $ __remoteTableDecl initRemoteTable
+  localNode <- newLocalNode transport
   let testData = tests localNode
   return testData
 

packages/distributed-process-client-server/distributed-process-client-server.cabal

@@ -1,6 +1,6 @@
 cabal-version:  3.0
 name:           distributed-process-client-server
-version:        0.2.8.0
+version:        0.2.9.0
 build-type:     Simple
 license:        BSD-3-Clause
 license-file:   LICENCE
@@ -39,9 +39,9 @@ library
   import:          warnings
   build-depends:
                    base >= 4.8.2.0 && < 5,
-                   distributed-process >= 0.6.6 && < 0.8,
-                   distributed-process-extras >= 0.3.1 && < 0.4,
-                   distributed-process-async >= 0.2.4 && < 0.3,
+                   distributed-process >= 0.8 && < 0.9,
+                   distributed-process-extras >= 0.4 && < 0.5,
+                   distributed-process-async >= 0.3 && < 0.4,
                    binary >= 0.8 && < 0.9,
                    deepseq >= 1.4 && < 1.7,
                    mtl,

packages/distributed-process-client-server/tests/Counter.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable   #-}
 {-# LANGUAGE DeriveGeneric        #-}
-{-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE BangPatterns         #-}
 

packages/distributed-process-client-server/tests/SafeCounter.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveDataTypeable   #-}
-{-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE BangPatterns         #-}
 {-# LANGUAGE DeriveGeneric        #-}

packages/distributed-process-client-server/tests/TestManagedProcess.hs

@@ -15,7 +15,7 @@ import Control.Exception (SomeException)
 import Control.Distributed.Process hiding (call, catch)
 import Control.Distributed.Process.Async (AsyncResult(AsyncDone))
 import Control.Distributed.Process.Node
-import Control.Distributed.Process.Extras hiding (__remoteTable, monitor, send, nsend)
+import Control.Distributed.Process.Extras hiding (monitor, send, nsend)
 import Control.Distributed.Process.ManagedProcess
 import Control.Distributed.Process.SysTest.Utils
 import Control.Distributed.Process.Extras.Time
@@ -212,7 +212,7 @@ testCounterExceedsLimit result = do
 
 tests :: NT.Transport  -> IO TestTree
 tests transport = do
-  localNode <- newLocalNode transport initRemoteTable
+  localNode <- newLocalNode transport
   scpid <- newEmptyMVar
   _ <- forkProcess localNode $ SafeCounter.startCounter 5 >>= stash scpid
   safeCounter <- takeMVar scpid

packages/distributed-process-client-server/tests/TestPrioritisedProcess.hs

@@ -15,7 +15,7 @@ import Control.Exception (SomeException)
 import Control.DeepSeq (NFData)
 import Control.Distributed.Process hiding (call, send, catch, sendChan, wrapMessage)
 import Control.Distributed.Process.Node
-import Control.Distributed.Process.Extras hiding (__remoteTable, monitor)
+import Control.Distributed.Process.Extras hiding (monitor)
 import Control.Distributed.Process.Async hiding (check)
 import Control.Distributed.Process.ManagedProcess hiding (reject, Message)
 import qualified Control.Distributed.Process.ManagedProcess.Server.Priority as P (Message)
@@ -536,7 +536,7 @@ testCallPrioritisation result = do
 
 tests :: NT.Transport  -> IO TestTree
 tests transport = do
-  localNode <- newLocalNode transport initRemoteTable
+  localNode <- newLocalNode transport
   return $ testGroup "" [
         testGroup "basic server functionality matches un-prioritised processes" [
             testCase "basic call with explicit server reply"

packages/distributed-process-client-server/tests/TestUtils.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveDataTypeable        #-}
-{-# LANGUAGE TemplateHaskell           #-}
 {-# LANGUAGE TupleSections             #-}
 
 module TestUtils
@@ -38,7 +37,7 @@ waitForExit exitReason = do
 mkNode :: String -> IO LocalNode
 mkNode port = do
   Right (transport1, _) <- createTransportExposeInternals (defaultTCPAddr "127.0.0.1" port) defaultTCPParameters
-  newLocalNode transport1 initRemoteTable
+  newLocalNode transport1
 
 -- | Given a @builder@ function, make and run a test suite on a single transport
 testMain :: (NT.Transport -> IO TestTree) -> IO ()

packages/distributed-process-execution/ChangeLog

@@ -1,5 +1,6 @@
 Unreleased
 
+* Breaking: `__remoteTable` is no longer exported, as `RemoteTable` has been removed from `distributed-process`.
 * Added support for `containers-0.8`.
 
 2025-02-04 Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.1.5.0

packages/distributed-process-execution/distributed-process-execution.cabal

@@ -1,6 +1,6 @@
 cabal-version:  3.0
 name:           distributed-process-execution
-version:        0.1.5.0
+version:        0.2.0.0
 build-type:     Simple
 license:        BSD-3-Clause
 license-file:   LICENCE
@@ -40,9 +40,9 @@ library
   build-depends:
                    base >= 4.14 && < 5,
                    data-accessor >= 0.2.2.3,
-                   distributed-process >= 0.6.6 && < 0.8,
-                   distributed-process-extras >= 0.3.1 && < 0.4,
-                   distributed-process-supervisor >= 0.2.0 && < 0.3,
+                   distributed-process >= 0.8 && < 0.9,
+                   distributed-process-extras >= 0.4 && < 0.5,
+                   distributed-process-supervisor >= 0.3 && < 0.4,
                    distributed-process-client-server >= 0.2.0 && < 0.3,
                    binary >= 0.8 && < 0.9,
                    deepseq >= 1.4 && < 1.7,
@@ -85,6 +85,7 @@ test-suite MailboxTests
   import:          warnings
   type:            exitcode-stdio-1.0
   build-depends:   base >= 4.14 && < 5,
+                   binary >= 0.8 && < 0.9,
                    distributed-process,
                    distributed-process-execution,
                    distributed-process-extras,

packages/distributed-process-execution/src/Control/Distributed/Process/Execution/EventManager.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE RankNTypes                #-}
 {-# LANGUAGE RecordWildCards           #-}
 {-# LANGUAGE ScopedTypeVariables       #-}
-{-# LANGUAGE TemplateHaskell           #-}
 {-# LANGUAGE ImpredicativeTypes        #-}
 
 -----------------------------------------------------------------------------

packages/distributed-process-execution/src/Control/Distributed/Process/Execution/Exchange/Broadcast.hs

@@ -6,7 +6,6 @@
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE EmptyDataDecls        #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE ImpredicativeTypes    #-}
 {-# LANGUAGE UndecidableInstances  #-}
 {-# LANGUAGE MultiParamTypeClasses #-}

packages/distributed-process-execution/src/Control/Distributed/Process/Execution/Exchange/Internal.hs

@@ -6,7 +6,6 @@
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE EmptyDataDecls        #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE ImpredicativeTypes    #-}
 {-# LANGUAGE UndecidableInstances  #-}
 {-# LANGUAGE MultiParamTypeClasses #-}

packages/distributed-process-execution/src/Control/Distributed/Process/Execution/Exchange/Router.hs

@@ -6,7 +6,6 @@
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE EmptyDataDecls        #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE ImpredicativeTypes    #-}
 {-# LANGUAGE UndecidableInstances  #-}
 {-# LANGUAGE MultiParamTypeClasses #-}

packages/distributed-process-execution/src/Control/Distributed/Process/Execution/Mailbox.hs

@@ -7,7 +7,7 @@
 {-# LANGUAGE RecordWildCards      #-}
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE EmptyDataDecls       #-}
-{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE StaticPointers       #-}
 {-# LANGUAGE ImpredicativeTypes   #-}
 
 -----------------------------------------------------------------------------
@@ -115,8 +115,6 @@ module Control.Distributed.Process.Execution.Mailbox
   , FilterResult(..)
   , acceptEverything
   , acceptMatching
-    -- * Remote Table
-  , __remoteTable
   ) where
 
 import Control.Concurrent.STM (atomically)
@@ -129,10 +127,6 @@ import Control.Concurrent.STM.TChan
   )
 import Control.Distributed.Process hiding (call, monitor)
 import qualified Control.Distributed.Process as P (monitor)
-import Control.Distributed.Process.Closure
-  ( remotable
-  , mkStaticClosure
-  )
 import Control.Distributed.Process.Serializable hiding (SerializableDict)
 import Control.Distributed.Process.Extras
   ( ExitReason(..)
@@ -547,7 +541,7 @@ matching :: Closure (Message -> Process FilterResult)
          -> Message
          -> Process FilterResult
 matching predicate msg = do
-  pred' <- unClosure predicate :: Process (Message -> Process FilterResult)
+  pred' <- unclosure predicate :: Process (Message -> Process FilterResult)
   res   <- handleMessage msg pred'
   case res of
     Nothing -> return Skip
@@ -632,7 +626,7 @@ type Skipped = Integer
 sendMail :: State -> Process State
 sendMail st = do
     let Active f = st ^. state ^. mode
-    unCl <- catch (unClosure f >>= return . Just)
+    unCl <- catch (unclosure f >>= return . Just)
                   (\(_ :: SomeException) -> return Nothing)
     case unCl of
       Nothing -> return st -- TODO: Logging!?
@@ -721,20 +715,18 @@ stats = accessor getStats (\_ s -> s) -- TODO: use a READ ONLY accessor for this
   where
     getStats (State _ (BufferState _ _ lm sz dr op _)) = MailboxStats sz dr lm op
 
-$(remotable ['everything, 'matching])
-
 -- | A /do-nothing/ filter that accepts all messages (i.e., returns @Keep@
 -- for any input).
 acceptEverything :: Closure (Message -> Process FilterResult)
-acceptEverything = $(mkStaticClosure 'everything)
+acceptEverything = (static everything)
 
 -- | A filter that takes a @Closure (Message -> Process FilterResult)@ holding
 -- the filter function and applies it remotely (i.e., in the mailbox's own
 -- managed process).
 --
 acceptMatching :: Closure (Closure (Message -> Process FilterResult)
                            -> Message -> Process FilterResult)
-acceptMatching = $(mkStaticClosure 'matching)
+acceptMatching = (static matching)
 
 -- | Instructs the mailbox to deliver all pending messages to the owner.
 --

packages/distributed-process-execution/tests/MailboxTestFilters.hs

@@ -1,5 +1,5 @@
+{-# LANGUAGE StaticPointers #-}
 {-# LANGUAGE CPP                 #-}
-{-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module MailboxTestFilters where
@@ -10,7 +10,7 @@ import Control.Monad (forM)
 
 import Prelude hiding (drop)
 import Data.Maybe (catMaybes)
-import Control.Distributed.Process.Closure (remotable, mkClosure, mkStaticClosure)
+import Data.Binary (decode, encode)
 
 filterInputs :: (String, Int, Bool) -> Message -> Process FilterResult
 filterInputs (s, i, b) msg = do
@@ -30,11 +30,9 @@ filterEvens m = do
     Just fr -> return fr
     _       -> return Skip
 
-$(remotable ['filterInputs, 'filterEvens])
-
 intFilter :: Closure (Message -> Process FilterResult)
-intFilter = $(mkStaticClosure 'filterEvens)
+intFilter = (static filterEvens)
 
 myFilter :: (String, Int, Bool) -> Closure (Message -> Process FilterResult)
-myFilter = $(mkClosure 'filterInputs)
+myFilter x = closure (static (filterInputs . decode)) (encode x)
 

packages/distributed-process-execution/tests/TestExchange.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE CPP                   #-}
 {-# LANGUAGE BangPatterns          #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
@@ -9,7 +8,6 @@ module Main where
 import Control.Distributed.Process hiding (monitor)
 import Control.Distributed.Process.Node
 import Control.Distributed.Process.Execution.EventManager hiding (start)
-import qualified Control.Distributed.Process.Extras
 import Control.Distributed.Process.Execution.Exchange
 import Control.Distributed.Process.Extras.Internal.Types
 import Control.Distributed.Process.Extras.Internal.Primitives
@@ -153,13 +151,9 @@ myHandler :: SendPort (String, String, String)
           -> Process ()
 myHandler sp s m@(_, _, _) = sendChan sp m >> return s
 
-myRemoteTable :: RemoteTable
-myRemoteTable =
-  Control.Distributed.Process.Extras.__remoteTable initRemoteTable
-
 tests :: NT.Transport  -> IO TestTree
 tests transport = do
-  localNode <- newLocalNode transport myRemoteTable
+  localNode <- newLocalNode transport
   return $ testGroup "" [
         testGroup "Event Manager"
         [