Avoid awkward "flip (maybe ...)" pattern.

1 files changed, 30 insertions, 30 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 0efde53b..19e721b0 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -32,6 +32,7 @@ module XMPPServer
     , Server
     , flushPassThrough
     , greet'
+    , (<&>)
     ) where
 
 import ConnectionKey
@@ -504,7 +505,7 @@ sendReply donevar stype reply replychan = do
         isInternal (InternalEnableHack {}) = True
         isInternal (InternalCacheId {}) = True
         isInternal _ = False
-    flip (maybe $ return ())
+    forM_
          (fmap (const ()) stanzaTag `mplus` guard (isInternal stype))
          . const $ do
     replyStanza <- liftIO . atomically $ do
@@ -558,11 +559,11 @@ stanzaFromList stype reply = do
 grokStanzaIQGet :: Monad m => XML.Event -> NestingXML o m (Maybe StanzaType)
 grokStanzaIQGet stanza = do
     mtag <- nextElement
-    flip (maybe $ return Nothing)  mtag $ \tag -> do
+    forM  mtag $ \tag -> do
     case tagName tag of
-        "{urn:xmpp:ping}ping" -> return $ Just Ping
-        "{jabber:iq:roster}query" -> return $ Just RequestRoster
-        name -> return . Just $ UnrecognizedQuery name
+        "{urn:xmpp:ping}ping"     -> return Ping
+        "{jabber:iq:roster}query" -> return RequestRoster
+        name                      -> return $ UnrecognizedQuery name
 
 parseClientVersion :: NestingXML o IO (Maybe StanzaType)
 parseClientVersion = parseit Nothing Nothing
@@ -574,7 +575,7 @@ parseClientVersion = parseit Nothing Nothing
     parseit :: Maybe Text -> Maybe Text -> NestingXML o IO (Maybe StanzaType)
     parseit mname mver = do
         mtag <- nextElement
-        flip (maybe $ reportit mname mver) mtag $ \tag -> do
+        fromMaybe (reportit mname mver) $ mtag <&> \tag -> do
         case tagName tag of
             "{jabber:iq:version}name" -> do
                 x <- XML.content
@@ -588,7 +589,7 @@ parseClientVersion = parseit Nothing Nothing
 grokStanzaIQResult :: XML.Event -> NestingXML o IO (Maybe StanzaType)
 grokStanzaIQResult stanza = do
     mtag <- nextElement
-    flip (maybe $ return (Just Pong))  mtag $ \tag -> do
+    fromMaybe (return $ Just Pong) $ mtag <&> \tag -> do
     case tagName tag of
         "{jabber:iq:version}query" | nameNamespace (tagName stanza)==Just "jabber:client"
             -> parseClientVersion
@@ -597,19 +598,18 @@ grokStanzaIQResult stanza = do
 grokStanzaIQSet :: XML.Event -> NestingXML o IO (Maybe StanzaType)
 grokStanzaIQSet stanza = do
     mtag <- nextElement
-    flip (maybe $ return Nothing)  mtag $ \tag -> do
-    case tagName tag of
-        "{urn:ietf:params:xml:ns:xmpp-bind}bind" -> do
-            mchild <- nextElement
-            case fmap tagName mchild of
-                Just "{urn:ietf:params:xml:ns:xmpp-bind}resource" -> do
-                    rsc <- XML.content -- TODO: MonadThrow???
-                    return . Just $ RequestResource Nothing (Just rsc)
-                Just _ -> return Nothing
-                Nothing -> return . Just $ RequestResource Nothing Nothing
-        "{urn:ietf:params:xml:ns:xmpp-session}session" -> do
-            return $ Just SessionRequest
-        _ -> return Nothing
+    case tagName <$> mtag of
+        Just "{urn:ietf:params:xml:ns:xmpp-bind}bind"
+            -> do mchild <- nextElement
+                  case tagName <$> mchild of
+                    Just "{urn:ietf:params:xml:ns:xmpp-bind}resource"
+                            -> do rsc <- XML.content -- TODO: MonadThrow???
+                                  return . Just $ RequestResource Nothing (Just rsc)
+                    Just _  -> return Nothing
+                    Nothing -> return . Just $ RequestResource Nothing Nothing
+        Just "{urn:ietf:params:xml:ns:xmpp-session}session"
+            -> return $ Just SessionRequest
+        _   -> return Nothing
 
 
 {-
@@ -650,7 +650,7 @@ parsePresenceStatus ns stanzaTag = do
     statusv <- liftIO . atomically $ newTChan
     fix $ \loop -> do
         mtag <- nextElement
-        flip (maybe $ return ()) mtag $ \tag -> do
+        forM_ mtag $ \tag -> do
         when (nameNamespace (tagName tag) == Just ns) $ do
             case nameLocalName (tagName tag) of
                 "show" -> do t <- XML.content
@@ -749,11 +749,11 @@ parseMessage ns stanza = do
 
 findConditionTag :: Monad m => NestingXML o m (Maybe XML.Event)
 findConditionTag = do
-    x <- nextElement
-    flip (maybe $ return Nothing) x $ \x -> do
+    mx <- nextElement
+    fmap join $ forM mx $ \x -> do
     case nameNamespace (tagName x) of
         Just "urn:ietf:params:xml:ns:xmpp-stanzas" -> return (Just x)
-        _ -> findConditionTag
+        _                                          -> findConditionTag
 
 conditionFromText :: Text -> Maybe StanzaError
 conditionFromText t = fmap fst $ listToMaybe ss
@@ -765,8 +765,8 @@ conditionFromText t = fmap fst $ listToMaybe ss
 findErrorTag :: Monad m => Text -> NestingXML o m (Maybe StanzaError)
 findErrorTag ns = do
     x <- nextElement
-    flip (maybe $ return Nothing) x $ \x -> do
-    case tagName x of
+    fmap join $ forM x $ \x ->
+      case tagName x of
         n | nameNamespace n==Just ns && nameLocalName n=="error"
             -> do
                  mtag <- findConditionTag
@@ -958,7 +958,7 @@ xmppInbound sv xmpp k laddr pingflag stanzas output donevar = doNestingXML $ do
                               }
                 ioWriteChan stanzas s
           you <- liftIO tellyourname
-          flip (maybe $ unrecog) dispatch $ \dispatch ->
+          fromMaybe unrecog $ dispatch <&> \dispatch ->
             case dispatch of
               -- Checking that the to-address matches this server.
               -- Otherwise it could be a client-to-client ping or a
@@ -1150,7 +1150,7 @@ wrapStanzaList xs = do
 wrapStanzaConduit :: Monad m => StanzaWrap a -> ConduitM Event (Either (StanzaWrap Event) Event) m ()
 wrapStanzaConduit stanza = do
     mfirst <- await
-    flip (maybe $ return ()) mfirst $ \first -> do
+    forM_ mfirst $ \first -> do
     yield . Left $ stanza { stanzaChan = first }
     awaitForever $ yield . Right
 
@@ -1349,7 +1349,7 @@ forkConnection sv xmpp k laddr pingflag src snk stanzas = do
                             wlog $ "handling Error hacks"
                             b <- atomically $ do m <- readTVar hacks
                                                  cached <- readTVar msgids
-                                                 flip (maybe $ return False) (stanzaId stanza) $ \id' -> do
+                                                 fromMaybe (return False) $ stanzaId stanza <&> \id' -> do
                                                  return $ Map.member SimulatedChatErrors m
                                                             && elem id' cached
                             ids <- atomically $ readTVar msgids
@@ -1442,7 +1442,7 @@ sendRoster query xmpp clientKey replyto = do
     let k = case stanzaOrigin query of
              NetworkOrigin k _ -> Just k
              LocalPeer -> Nothing -- local peer requested roster?
-    flip (maybe $ return ()) k $ \k -> do
+    forM_ k $ \k -> do
     hostname <- xmppTellMyNameToClient xmpp clientKey
     let getlist f = do
             bs <- f xmpp k