diff options
Diffstat (limited to 'main/Test.hs')
| -rw-r--r-- | main/Test.hs | 21 |
1 files changed, 12 insertions, 9 deletions
diff --git a/main/Test.hs b/main/Test.hs index fd6258d..323b240 100644 --- a/main/Test.hs +++ b/main/Test.hs @@ -232,14 +232,16 @@ discoveryAttributes = (defaultServiceAttributes Proxy) { discoveryProvideTunnel = \_ _ -> False } -dmReceivedWatcher :: Output -> Stored DirectMessage -> IO () -dmReceivedWatcher out smsg = do - let msg = fromStored smsg - outLine out $ unwords - [ "dm-received" - , "from", maybe "<unnamed>" T.unpack $ idName $ msgFrom msg - , "text", T.unpack $ msgText msg - ] +dmThreadWatcher :: ComposedIdentity -> Output -> DirectMessageThread -> DirectMessageThread -> IO () +dmThreadWatcher self out prev cur = do + forM_ (reverse $ dmThreadToListSince prev cur) $ \msg -> do + outLine out $ unwords + [ if sameIdentity self (msgFrom msg) + then "dm-sent" + else "dm-received" + , "from", maybe "<unnamed>" T.unpack $ idName $ msgFrom msg + , "text", T.unpack $ msgText msg + ] newtype CommandM a = CommandM (ReaderT TestInput (StateT TestState (ExceptT ErebosError IO)) a) @@ -456,7 +458,8 @@ cmdHeadUnwatch = do initTestHead :: Head LocalState -> Command initTestHead h = do - _ <- liftIO . watchReceivedDirectMessages h . dmReceivedWatcher =<< asks tiOutput + let self = finalOwner $ headLocalIdentity h + _ <- liftIO . watchDirectMessageThreads h . dmThreadWatcher self =<< asks tiOutput modify $ \s -> s { tsHead = Just h } loadTestHead :: CommandM (Head LocalState) |