diff options
Diffstat (limited to 'src/Test.hs')
| -rw-r--r-- | src/Test.hs | 20 |
1 files changed, 11 insertions, 9 deletions
diff --git a/src/Test.hs b/src/Test.hs index 678be18..c0b8aed 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -190,17 +190,18 @@ pairingAttributes _ out peers prefix = PairingAttributes directMessageAttributes :: Output -> DirectMessageAttributes directMessageAttributes out = DirectMessageAttributes - { dmReceived = \smsg -> do - let msg = fromStored smsg - afterCommit $ outLine out $ unwords - [ "dm-received" - , "from", maybe "<unnamed>" T.unpack $ idName $ msgFrom msg - , "text", T.unpack $ msgText msg - ] - - , dmOwnerMismatch = afterCommit $ outLine out "dm-owner-mismatch" + { dmOwnerMismatch = afterCommit $ outLine out "dm-owner-mismatch" } +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 + ] + newtype CommandM a = CommandM (ReaderT TestInput (StateT TestState (ExceptT String IO)) a) deriving (Functor, Applicative, Monad, MonadIO, MonadReader TestInput, MonadState TestState, MonadError String) @@ -313,6 +314,7 @@ cmdCreateIdentity = do , lsShared = shared } + _ <- liftIO . watchReceivedMessages h . dmReceivedWatcher =<< asks tiOutput modify $ \s -> s { tsHead = Just h } cmdStartServer :: Command |