{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Network.Xmpp.IM.Presence where
import Data.Default
import Data.Text (Text)
import Data.XML.Pickle
import Data.XML.Types
import Network.Xmpp.Types
data ShowStatus = StatusAway
| StatusChat
| StatusDnd
| StatusXa deriving (ReadPrec [ShowStatus]
ReadPrec ShowStatus
Int -> ReadS ShowStatus
ReadS [ShowStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ShowStatus]
$creadListPrec :: ReadPrec [ShowStatus]
readPrec :: ReadPrec ShowStatus
$creadPrec :: ReadPrec ShowStatus
readList :: ReadS [ShowStatus]
$creadList :: ReadS [ShowStatus]
readsPrec :: Int -> ReadS ShowStatus
$creadsPrec :: Int -> ReadS ShowStatus
Read, Int -> ShowStatus -> ShowS
[ShowStatus] -> ShowS
ShowStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShowStatus] -> ShowS
$cshowList :: [ShowStatus] -> ShowS
show :: ShowStatus -> String
$cshow :: ShowStatus -> String
showsPrec :: Int -> ShowStatus -> ShowS
$cshowsPrec :: Int -> ShowStatus -> ShowS
Show, ShowStatus -> ShowStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowStatus -> ShowStatus -> Bool
$c/= :: ShowStatus -> ShowStatus -> Bool
== :: ShowStatus -> ShowStatus -> Bool
$c== :: ShowStatus -> ShowStatus -> Bool
Eq)
data IMPresence = IMP { IMPresence -> Maybe ShowStatus
showStatus :: Maybe ShowStatus
, IMPresence -> Maybe Text
status :: Maybe Text
, IMPresence -> Maybe Int
priority :: Maybe Int
} deriving (Int -> IMPresence -> ShowS
[IMPresence] -> ShowS
IMPresence -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IMPresence] -> ShowS
$cshowList :: [IMPresence] -> ShowS
show :: IMPresence -> String
$cshow :: IMPresence -> String
showsPrec :: Int -> IMPresence -> ShowS
$cshowsPrec :: Int -> IMPresence -> ShowS
Show, IMPresence -> IMPresence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IMPresence -> IMPresence -> Bool
$c/= :: IMPresence -> IMPresence -> Bool
== :: IMPresence -> IMPresence -> Bool
$c== :: IMPresence -> IMPresence -> Bool
Eq)
imPresence :: IMPresence
imPresence :: IMPresence
imPresence = IMP { showStatus :: Maybe ShowStatus
showStatus = forall a. Maybe a
Nothing
, status :: Maybe Text
status = forall a. Maybe a
Nothing
, priority :: Maybe Int
priority = forall a. Maybe a
Nothing
}
instance Default IMPresence where
def :: IMPresence
def = IMPresence
imPresence
getIMPresence :: Presence -> Maybe IMPresence
getIMPresence :: Presence -> Maybe IMPresence
getIMPresence Presence
pres = case forall t a. PU t a -> t -> Either UnpickleError a
unpickle PU [Element] IMPresence
xpIMPresence (Presence -> [Element]
presencePayload Presence
pres) of
Left UnpickleError
_ -> forall a. Maybe a
Nothing
Right IMPresence
r -> forall a. a -> Maybe a
Just IMPresence
r
withIMPresence :: IMPresence -> Presence -> Presence
withIMPresence :: IMPresence -> Presence -> Presence
withIMPresence IMPresence
imPres Presence
pres = Presence
pres{presencePayload :: [Element]
presencePayload = Presence -> [Element]
presencePayload Presence
pres
forall a. [a] -> [a] -> [a]
++ forall t a. PU t a -> a -> t
pickleTree PU [Element] IMPresence
xpIMPresence
IMPresence
imPres}
xpIMPresence :: PU [Element] IMPresence
xpIMPresence :: PU [Element] IMPresence
xpIMPresence = forall a. PU [Node] a -> PU [Element] a
xpUnliftElems forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap (\(Maybe ShowStatus
s, Maybe Text
st, Maybe Int
p) -> Maybe ShowStatus -> Maybe Text -> Maybe Int -> IMPresence
IMP Maybe ShowStatus
s Maybe Text
st Maybe Int
p)
(\(IMP Maybe ShowStatus
s Maybe Text
st Maybe Int
p) -> (Maybe ShowStatus
s, Maybe Text
st, Maybe Int
p)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall t a. PU t a -> PU t a
xpClean forall a b. (a -> b) -> a -> b
$
forall a a1 a2 a3.
PU [a] a1 -> PU [a] a2 -> PU [a] a3 -> PU [a] (a1, a2, a3)
xp3Tuple
(forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption forall a b. (a -> b) -> a -> b
$ forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{jabber:client}show"
(forall a. PU Text a -> PU [Node] a
xpContent PU Text ShowStatus
xpShow))
(forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption forall a b. (a -> b) -> a -> b
$ forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{jabber:client}status"
(forall a. PU Text a -> PU [Node] a
xpContent PU Text Text
xpText))
(forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption forall a b. (a -> b) -> a -> b
$ forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{jabber:client}priority"
(forall a. PU Text a -> PU [Node] a
xpContent forall a. (Show a, Read a) => PU Text a
xpPrim))
xpShow :: PU Text ShowStatus
xpShow :: PU Text ShowStatus
xpShow = (Text
"xpShow", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case forall {a}. (Eq a, IsString a) => a -> Maybe ShowStatus
showStatusFromText Text
input of
Maybe ShowStatus
Nothing -> forall a b. a -> Either a b
Left Text
"Could not parse show status."
Just ShowStatus
j -> forall a b. b -> Either a b
Right ShowStatus
j)
forall {a}. IsString a => ShowStatus -> a
showStatusToText
where
showStatusFromText :: a -> Maybe ShowStatus
showStatusFromText a
"away" = forall a. a -> Maybe a
Just ShowStatus
StatusAway
showStatusFromText a
"chat" = forall a. a -> Maybe a
Just ShowStatus
StatusChat
showStatusFromText a
"dnd" = forall a. a -> Maybe a
Just ShowStatus
StatusDnd
showStatusFromText a
"xa" = forall a. a -> Maybe a
Just ShowStatus
StatusXa
showStatusFromText a
_ = forall a. Maybe a
Nothing
showStatusToText :: ShowStatus -> a
showStatusToText ShowStatus
StatusAway = a
"away"
showStatusToText ShowStatus
StatusChat = a
"chat"
showStatusToText ShowStatus
StatusDnd = a
"dnd"
showStatusToText ShowStatus
StatusXa = a
"xa"