1 files changed, 7 insertions, 9 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 9e7f4582..7d6b4046 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -1016,14 +1016,12 @@ noArgPing :: (x -> IO (Maybe r)) -> [String] -> x -> IO (Maybe r)
 noArgPing f [] x = f x
 noArgPing _ _  _ = return Nothing
 
--- todo: session parameter obsolete?
-newXmmpSource :: (IO (Maybe Tox.CryptoMessage)) -> Tox.NetCryptoSession -> C.Source IO Tox.CryptoMessage
-newXmmpSource receiveCrypto session = do
-    v <- liftIO receiveCrypto
-    case v of
-        Nothing            -> return () -- Nothing indicates EOF.
-        Just cryptomessage -> do C.yield cryptomessage
-                                 newXmmpSource receiveCrypto session
+-- | Create a Conduit Source by repeatedly calling an IO action.
+ioToSource :: IO (Maybe x) -> C.Source IO x
+ioToSource action = liftIO action >>= \case
+        Nothing   -> return () -- EOF.
+        Just item -> do C.yield item
+                        ioToSource action
 
 newXmmpSink :: Tox.NetCryptoSession -> C.Sink (Flush Tox.CryptoMessage) IO ()
 newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue, ncPacketQueue }) = C.awaitForever $ \flush_cyptomessage -> do
@@ -1409,7 +1407,7 @@ main = runResourceT $ liftBaseWith $ \resT -> do
                     atomically $ writeTMChan tmchan (Tox.bufferData cd)
                     return Nothing
 #ifdef XMPP
-                xmppSrc          = newXmmpSource receiveCrypto netcrypto
+                xmppSrc          = ioToSource receiveCrypto
                 xmppSink         = newXmmpSink netcrypto
             announceToxXMPPClients (xmppEventChannel sv) addrTox (Tox.ncSockAddr netcrypto) pingflag xmppSrc xmppSink
 #endif