summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Presence/ConsoleWriter.hs11
-rw-r--r--xmppServer.hs2
2 files changed, 9 insertions, 4 deletions
diff --git a/Presence/ConsoleWriter.hs b/Presence/ConsoleWriter.hs
index 6e265e0c..5222258e 100644
--- a/Presence/ConsoleWriter.hs
+++ b/Presence/ConsoleWriter.hs
@@ -136,10 +136,15 @@ getPreferedLang = do
136 return $ lc_all `mplus` lc_messages `mplus` lang 136 return $ lc_all `mplus` lc_messages `mplus` lang
137 return $ maybe "en" (Text.pack . toBCP47) lang 137 return $ maybe "en" (Text.pack . toBCP47) lang
138 138
139cimatch w t = Text.toLower w == Text.toLower t
140cimatches w ts = dropWhile (not . cimatch w) ts
141
139-- rfc4647 lookup of best match language tag 142-- rfc4647 lookup of best match language tag
140lookupLang (w:ws) tags | Text.null w = lookupLang ws tags 143lookupLang (w:ws) tags
141 | w `elem` tags = Just w 144 | Text.null w = lookupLang ws tags
142 | otherwise = lookupLang (reduce w:ws) tags 145 | otherwise = case cimatches w tags of
146 (t:_) -> Just t
147 [] -> lookupLang (reduce w:ws) tags
143 where 148 where
144 reduce w = Text.concat $ reverse nopriv 149 reduce w = Text.concat $ reverse nopriv
145 where 150 where
diff --git a/xmppServer.hs b/xmppServer.hs
index af145906..d5ad7c6a 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -579,7 +579,7 @@ informPeerPresence state k stanza = do
579 is_avail <- atomically $ clientIsAvailable client 579 is_avail <- atomically $ clientIsAvailable client
580 when is_avail $ do 580 when is_avail $ do
581 putStrLn $ "reversing for client: " ++ show from 581 putStrLn $ "reversing for client: " ++ show from
582 froms <- do 582 froms <- flip (maybe $ return [from]) k . const $ do
583 let ClientKey laddr = ck 583 let ClientKey laddr = ck
584 (_,trip) <- multiplyJIDForClient laddr from 584 (_,trip) <- multiplyJIDForClient laddr from
585 return (map unsplitJID trip) 585 return (map unsplitJID trip)