Purged TraversableT usage.

1 files changed, 37 insertions, 39 deletions

diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index 2086133d..c2398607 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -42,7 +42,6 @@ import ControlMaybe
 import DNSCache (parseAddress, strip_brackets, withPort)
 import LockedChan (LockedChan)
 import Text.Read (readMaybe)
-import TraversableT
 import UTmp (ProcessID,users)
 import LocalPeerCred
 import XMPPServer
@@ -799,10 +798,9 @@ informClientPresence0 state mbk client stanza = do
     let connected = mapMaybe (flip Map.lookup ktc) addrs
     forM_ connected $ \con -> do
     let from' = clientJID con client
-    mto <- runTraversableT $ do
-            to <- liftT $ stanzaTo stanza
-            (to',_) <- liftMT $ rewriteJIDForPeer (manager state $ clientProfile client) to
-            return to'
+    mto <- maybe (return Nothing)
+                 (fmap (fmap fst) . rewriteJIDForPeer (manager state $ clientProfile client))
+                 (stanzaTo stanza)
     dup <- cloneStanza stanza
     sendModifiedStanzaToPeer dup { stanzaFrom = Just from'
                                  , stanzaTo = mto }
@@ -860,10 +858,11 @@ informPeerPresence state k stanza = do
         -- all clients, we'll filter available/authorized later
 
         ktc <- readTVar (ckeyToChan state)
-        runTraversableT $ do
-        (ck,client) <- liftMT $ fmap Map.toList $ readTVar (clients state)
-        con <- liftMaybe $ Map.lookup ck ktc
-        return (ck,con,client)
+        cmap <- readTVar (clients state)
+        return $ do
+            (ck,client) <- Map.toList cmap
+            con <- maybeToList $ Map.lookup ck ktc
+            return (ck,con,client)
     dput XJabber $ "xmppInformPeerPresence (length clients="++show (length clients)++")"
     (ctyp,cprof) <- atomically $ do
         mconn <- Map.lookup k <$> readTVar (pkeyToChan state)
@@ -899,18 +898,17 @@ answerProbe :: PresenceState stat -> Maybe Text -> PeerAddress -> TChan Stanza -
 answerProbe state mto k chan = do
     -- dput XJabber $ "answerProbe! " ++ show (stanzaType stanza)
     ktc <- atomically $ readTVar (pkeyToChan state)
-    muser <- runTraversableT $ do
-        to <- liftT $ mto
-        conn <- liftT $ Map.lookup k ktc
-        let (mu,h,_) = splitJID to -- TODO: currently resource-id is ignored on presence
-                                   --  probes.  Is this correct? Check the spec.
+    muser <- fmap join $ sequence $ do
+        to <- mto
+        conn <- Map.lookup k ktc
+        let (mu,h,_)   = splitJID to -- TODO: currently resource-id is ignored on presence
+                                     --  probes.  Is this correct? Check the spec.
             Left laddr = cdAddr $ auxData conn
-        liftMT $ guardPortStrippedAddress h laddr
-        u <- liftT mu
-        -- ORIG let ch = addrToText (auxAddr conn)
-        -- ORIG return (u,conn,ch)
-        let ch      = addrToText a where Local a = laddr
-        return (u,conn,ch)
+            ch         = addrToText a where Local a = laddr
+        u <- mu
+        Just $ do
+            guardPortStrippedAddress h laddr
+             <&> maybe Nothing (\_ -> Just (u,conn,ch))
 
     forM_ muser $ \(u,conn,ch) -> do
 
@@ -932,21 +930,22 @@ answerProbe state mto k chan = do
     --   reply <- makeInformSubscription "jabber:server" to from False
     when (not $ null whitelist) $ do
 
-    replies <- runTraversableT $ do
-        cbu <- lift . atomically $ readTVar (clientsByUser state)
+    replies <- catMaybes <$> do -- runTraversableT $ do
+        cbu <- atomically $ readTVar (clientsByUser state) -- Map Text LocalPresence
         let lpres = maybeToList $ Map.lookup u cbu
-        cw <- lift . atomically $ consoleClients state
-        clientState <- liftT $ (lpres >>= Map.elems . networkClients)
-                                ++ Map.elems cw
-        stanza <- liftIOMaybe $ atomically (readTVar (clientStatus clientState))
-        stanza <- lift $ cloneStanza stanza
-        let jid = unsplitJID (Just $ clientUser clientState
-                             , ch
-                             ,Just $ clientResource clientState)
-        return stanza { stanzaFrom = Just jid
-                      , stanzaType = (stanzaType stanza)
-                        { presenceWhiteList = whitelist }
-                      }
+        cw <- atomically $ consoleClients state -- Map Text ClientState
+        forM ((lpres >>= Map.elems . networkClients) ++ Map.elems cw) $ \clientState -> do
+            -- liftIOMaybe :: IO (Maybe a) -> TraversableT [] IO a
+            mstanza <- atomically $ readTVar (clientStatus clientState)
+            forM mstanza $ \stanza0 -> do
+                stanza <- cloneStanza stanza0
+                let jid = unsplitJID (Just $ clientUser clientState
+                                     , ch
+                                     ,Just $ clientResource clientState)
+                return stanza { stanzaFrom = Just jid
+                              , stanzaType = (stanzaType stanza)
+                                { presenceWhiteList = whitelist }
+                              }
 
     forM_ replies $ \reply -> do
         sendModifiedStanzaToPeer reply chan
@@ -1169,12 +1168,11 @@ resolvedFromRoster
   :: Connection.Manager s Text
      -> (ConfigFiles.User -> ConfigFiles.Profile -> IO [L.ByteString])
      -> UserName -> Text -> IO [(Maybe UserName, PeerAddress)]
-resolvedFromRoster man doit u profile = do
+resolvedFromRoster man doit u profile = concat <$> do
     subs <- configText doit u profile
-    runTraversableT $ do
-            (mu,h,_) <- liftT $ splitJID `fmap` subs
-            addr <- liftMT $ fmap nub $ resolvePeer man h
-            return (mu,addr)
+    forM (splitJID `fmap` subs) $ \(mu,h,_) -> do
+        addrs <- fmap nub $ resolvePeer man h
+        return $ map (mu,) addrs
 
 clientCons :: PresenceState stat
             -> Map ClientAddress t -> Text -> IO [(t, ClientState)]