@@ -30,7 +30,6 @@ import qualified Data.Map as Map
3030 , elems
3131 , filterWithKey
3232 , foldlWithKey
33− , keys
3433 )
3534import Data.Set (Set)
3635import qualified Data.Set as Set
@@ -38,7 +37,6 @@ import qualified Data.Set as Set
3837 , insert
3938 , delete
4039 , member
41− , foldl'
4240 , toList
4341 )
4442import Data.Foldable (forM_)
@@ -71,9 +69,6 @@ import Control.Distributed.Process.Internal.CQueue
7169 , newCQueue
7270 , mkWeakCQueue
7371 )
74−import qualified Control.Distributed.Process.Internal.CQueue as Mailbox
75− ( length
76− )
7772import qualified Network.Transport as NT
7873 ( Transport
7974 , EndPoint
@@ -759,76 +754,43 @@ ncEffectGetInfo from pid =
759754 let lpid = processLocalId pid
760755 them = (ProcessIdentifier pid)
761756 in do
762− liftIO . putStrLn $ "processing get info"
763757 node <- ask
764− mProc <- liftIO $ withMVar (localState node) $ return . (^. localProcessWithId lpid)
758+ mProc <- liftIO $
759+ withMVar (localState node) $ return . (^. localProcessWithId lpid)
765760 case mProc of
766761 Nothing -> dispatch (isLocal node (ProcessIdentifier from))
767762 from node (ProcessInfoNone DiedUnknownId)
768− Just proc -> do
769− liftIO . putStrLn $ "getting links"
763+ Just _ -> do
770764 itsLinks <- gets (^. linksFor them)
771− liftIO . putStrLn $ "getting monitors"
772765 itsMons <- gets (^. monitorsFor them)
773− liftIO . putStrLn $ "getting registered names"
774766 registered <- gets (^. registeredHere)
775− sendInfo pid
776− (isLocal node (ProcessIdentifier from))
777− proc
778− node
779− (Set.toList itsLinks)
780− (Set.toList itsMons)
781− (registeredNames registered)
782−
783− where sendInfo :: ProcessId
784− -> Bool
785− -> LocalProcess
786− -> LocalNode
787− -> [ProcessId]
788− -> [(ProcessId, MonitorRef)]
789− -> [String]
790− -> NC ()
791− sendInfo d lc lp n l m r =
792− let n' = processNodeId pid
793− in do
794− qLen <- qLength lp
795− dispatch lc d n ProcessInfo {
796− infoNode = n'
797− , infoRegisteredNames = r
798− , infoMessageQueueLength = qLen
799− , infoMonitors = m
800− , infoLinks = l
801− }
802767
803− dispatch :: (Serializable a, Show a)
768+ let reg = registeredNames registered
769+ dispatch (isLocal node (ProcessIdentifier from))
770+ pid
771+ node
772+ ProcessInfo {
773+ infoNode = (processNodeId pid)
774+ , infoRegisteredNames = reg
775+ -- we cannot populate this field
776+ , infoMessageQueueLength = Nothing
777+ , infoMonitors = Set.toList itsMons
778+ , infoLinks = Set.toList itsLinks
779+ }
780+ where dispatch :: (Serializable a, Show a)
804781 => Bool
805782 -> ProcessId
806783 -> LocalNode
807784 -> a
808785 -> NC ()
809− dispatch True dest _ pInfo = do
810− -- liftIO $ putStrLn $ "posting " ++ (show pInfo) ++ " to " ++ (show dest)
811− postAsMessage dest $ pInfo
786+ dispatch True dest _ pInfo = postAsMessage dest $ pInfo
812787 dispatch False dest node pInfo = do
813− -- liftIO $ putStrLn $ "posting pinfo to node of " ++ (show dest)
814788 liftIO $ sendMessage node
815789 (NodeIdentifier (localNodeId node))
816790 (ProcessIdentifier dest)
817791 WithImplicitReconnect
818792 pInfo
819793
820− -- TODO: make this available to other functions?
821− qLength :: LocalProcess -> NC (Maybe Int)
822− qLength lp = do
823− liftIO $ putStrLn "getting qLen"
824− qRef <- liftIO $ deRefWeak (processWeakQ lp)
825− liftIO $ putStrLn "checking length..."
826− case qRef of
827− Nothing -> return $ Nothing
828− Just q -> do
829− len <- liftIO $ Mailbox.length q
830− return $ Just len
831−
832794 registeredNames = Map.foldlWithKey (\ks k v -> if v == pid
833795 then (k:ks)
834796 else ks) []
@@ -925,7 +887,6 @@ postAsMessage pid = postMessage pid . createMessage
925887
926888postMessage :: ProcessId -> Message -> NC ()
927889postMessage pid msg = do
928− liftIO $ putStrLn ("posting message to " ++ show pid)
929890 withLocalProc pid $ \p -> enqueue (processQueue p) msg
930891
931892throwException :: Exception e => ProcessId -> e -> NC ()