3178dec · distributed-process

git.iko.soy/distributed-process

Expose wrapMessageLocal and handle TraceEvLog properly

commit3178dec86e5b013fc804a0ef4f933483ed8b38d3 authorTim Watson <tim@rabbitmq.com> dateTue 30 Apr 2013, 16:33 (13 years ago) parent9290c4d

3 files changed+21−17

compare with master

unifiedsplit

src/Control/Distributed/Process/Internal/Primitives.hs+11−13 src/Control/Distributed/Process/Internal/Trace/Tracer.hs+9−3 src/Control/Distributed/Process/Internal/Trace/Types.hs+1−1

src/Control/Distributed/Process/Internal/Primitives.hs+11−13

@@ -27,7 +27,6 @@ module Control.Distributed.Process.Internal.Primitives

2727 , matchMessage

2828 , matchMessageIf

2929 , wrapMessage

30− , wrapMessageLocal

3130 , unwrapMessage

3231 , handleMessage

3332 , forward

@@ -393,27 +392,26 @@ forward msg them = do

393392

394393

395394-- | Wrap a 'Serializable' value in a 'Message'. Note that 'Message's are

396−-- 'Serializable' - like the datum they contain - but remember that deserializing

395+-- 'Serializable' - like the datum they contain - but also note, deserialising

397396-- a 'Message' will yield a 'Message', not the type within it! To obtain the

398397-- wrapped datum, use 'unwrapMessage' or 'handleMessage' with a specific type.

399398--

400399-- @

401400-- do

402−-- self <- getSelfPid

403−-- send self (wrapMessage "blah")

404−-- Nothing <- expectTimeout 1000000 :: Process (Maybe String)

405−-- (Just m) <- expectTimeout 1000000 :: Process (Maybe Message)

406−-- (Just "blah") <- unwrapMessage m :: Process (Maybe String)

401+-- self <- getSelfPid

402+-- send self (wrapMessage "blah")

403+-- Nothing <- expectTimeout 1000000 :: Process (Maybe String)

404+-- (Just m) <- expectTimeout 1000000 :: Process (Maybe Message)

405+-- (Just "blah") <- unwrapMessage m :: Process (Maybe String)

407406-- @

408407--

409408wrapMessage :: Serializable a => a -> Message

410−wrapMessage = createMessage

409+wrapMessage = createUnencodedMessage -- see [note Serializable UnencodedMessage]

411410

412−-- | Like 'wrapMessage', but produces a 'Message' that is only usable in the

413−-- local node. This is primarily useful when consuming the tracing and debugging

414−-- APIs in "Control.Distributed.Process.Debug".

415−wrapMessageLocal :: Serializable a => a -> Message

416−wrapMessageLocal = createUnencodedMessage

411+-- [note Serializable UnencodedMessage]

412+-- if we attempt to serialise an UnencodedMessage, it will be converted to an

413+-- EncodedMessage first, so we're ok here. See 'messageToPayload' in

414+-- Primitives.hs for the gory details

417415

418416-- | Attempt to unwrap a raw 'Message'.

419417-- If the type of the decoded message payload matches the expected type, the

src/Control/Distributed/Process/Internal/Trace/Tracer.hs+9−3

@@ -29,6 +29,7 @@ import Control.Distributed.Process.Internal.Primitives

2929 , matchAny

3030 , matchIf

3131 , handleMessage

32+ , unwrapMessage

3233 , matchUnknown

3334 )

3435import Control.Distributed.Process.Internal.Trace.Types

@@ -134,7 +135,8 @@ systemLoggerTracer = do

134135 sendTraceMsg :: LocalNode -> TraceEvent -> Process ()

135136 sendTraceMsg node ev = do

136137 now <- liftIO $ getCurrentTime

137− msg <- return $ (formatTime defaultTimeLocale "%c" now, (show ev))

138+ txt <- buildTxt ev

139+ msg <- return $ (formatTime defaultTimeLocale "%c" now, txt)

138140 emptyPid <- return $ (nullProcessId (localNodeId node))

139141 traceMsg <- return $ NCMsg {

140142 ctrlMsgSender = ProcessIdentifier (emptyPid)

@@ -143,6 +145,10 @@ systemLoggerTracer = do

143145 }

144146 liftIO $ writeChan (localCtrlChan node) traceMsg

145147

148+ buildTxt :: TraceEvent -> Process String

149+ buildTxt (TraceEvLog msg) = return msg

150+ buildTxt ev = return $ show ev

151+

146152eventLogTracer :: Process ()

147153eventLogTracer =

148154 -- NB: when the GHC event log supports tracing arbitrary (ish) data, we will

@@ -304,8 +310,8 @@ handleTrace st msg ev = do

304310 case (traceNodes (flags st)) of

305311 True -> sendTrace st msg

306312 False -> return ()

307− (TraceEvUser _) -> do

308− sendTrace st msg

313+ (TraceEvUser _) -> sendTrace st msg

314+ (TraceEvLog _) -> sendTrace st msg

309315 _ ->

310316 case (traceConnections (flags st)) of

311317 True -> sendTrace st msg

src/Control/Distributed/Process/Internal/Trace/Types.hs+1−1

@@ -146,7 +146,7 @@ data TraceOk = TraceOk

146146--------------------------------------------------------------------------------

147147

148148traceLog :: Tracer -> String -> IO ()

149−traceLog tr s = traceMessage tr (TraceEvLog s)

149+traceLog tr s = traceIt tr (createUnencodedMessage $ TraceEvLog s)

150150

151151traceLogFmt :: Tracer

152152 -> String