diff options
author | 2012-11-10 02:18:19 -0400 | |
---|---|---|
committer | 2012-11-10 02:18:19 -0400 | |
commit | bce81d8cc7551cd790e7ff3c5adb80593a7c88ee (patch) | |
tree | 13eaab29500073e1b6f472d1f283b62cd386e412 /Assistant/Threads/XMPPClient.hs | |
parent | 095eee8594f6f36b90898504f306409edc6fdddf (diff) |
use a lookup table for speed
Diffstat (limited to 'Assistant/Threads/XMPPClient.hs')
-rw-r--r-- | Assistant/Threads/XMPPClient.hs | 27 |
1 files changed, 14 insertions, 13 deletions
diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index 4d34e7eb8..d1cd375ed 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -122,9 +122,9 @@ decodeStanza selfjid s@(ReceivedPresence p) | presenceFrom p == Just selfjid = [Ignorable s] | otherwise = maybe [PresenceMessage p] decode (getGitAnnexAttrValue p) where - decode (attr, v, _tag) + decode (attr, (val, _tag)) | attr == pushAttr = impliedp $ GotNetMessage $ NotifyPush $ - decodePushNotification v + decodePushNotification val | attr == queryAttr = impliedp $ GotNetMessage QueryPresence | otherwise = [Unknown s] {- Things sent via presence imply a presence message, @@ -134,18 +134,19 @@ decodeStanza selfjid s@(ReceivedMessage m) | messageFrom m == Nothing = [Ignorable s] | messageFrom m == Just selfjid = [Ignorable s] | messageType m == MessageError = [ProtocolError s] - | otherwise = maybe [Unknown s] decode (getGitAnnexAttrValue m) + | otherwise = [fromMaybe (Unknown s) $ decode =<< getGitAnnexAttrValue m] where - decode (attr, v, tag) - | attr == pairAttr = use $ decodePairingNotification v - | attr == canPushAttr = use decodeCanPush - | attr == pushRequestAttr = use decodePushRequest - | attr == startingPushAttr = use decodeStartingPush - | attr == receivePackAttr = use $ decodeReceivePackOutput tag - | attr == sendPackAttr = use $ decodeSendPackOutput tag - | attr == receivePackDoneAttr = use $ decodeReceivePackDone v - | otherwise = [Unknown s] - use v = [maybe (Unknown s) GotNetMessage (v m)] + decode (attr, (val, tag)) = GotNetMessage <$> + ((\d -> d m val tag) =<< M.lookup attr decoders) + decoders = M.fromList + [ (pairAttr, decodePairingNotification) + , (canPushAttr, decodeCanPush) + , (pushRequestAttr, decodePushRequest) + , (startingPushAttr, decodeStartingPush) + , (receivePackAttr, decodeReceivePackOutput) + , (sendPackAttr, decodeSendPackOutput) + , (receivePackDoneAttr, decodeReceivePackDone) + ] decodeStanza _ s = [Unknown s] {- Waits for a NetMessager message to be sent, and relays it to XMPP. -} |