content: {-# 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 (Read, Show, Eq)
  
  data IMPresence = IMP { showStatus :: Maybe ShowStatus
                        , status     :: Maybe Text
                        , priority   :: Maybe Int
                        } deriving (Show, Eq)
  
  imPresence :: IMPresence
  imPresence = IMP { showStatus = Nothing
                   , status     = Nothing
                   , priority   = Nothing
                   }
  
  instance Default IMPresence where
      def = imPresence
  
  -- | Try to extract RFC6121 IM presence information from presence stanza.
  -- Returns Nothing when the data is malformed, (Just IMPresence) otherwise.
  getIMPresence :: Presence -> Maybe IMPresence
  getIMPresence pres = case unpickle xpIMPresence (presencePayload pres) of
      Left _ -> Nothing
      Right r -> Just r
  
  withIMPresence :: IMPresence -> Presence -> Presence
  withIMPresence imPres pres = pres{presencePayload = presencePayload pres
                                                     ++ pickleTree xpIMPresence
                                                                   imPres}
  
  --
  -- Picklers
  --
  
  xpIMPresence :: PU [Element] IMPresence
  xpIMPresence = xpUnliftElems .
                 xpWrap (\(s, st, p) -> IMP s st p)
                        (\(IMP s st p) -> (s, st, p)) .
                 xpClean $
                 xp3Tuple
                    (xpOption $ xpElemNodes "{jabber:client}show"
                       (xpContent xpShow))
                    -- TODO: Multiple status elements with different lang tags
                    (xpOption $ xpElemNodes "{jabber:client}status"
                       (xpContent xpText))
                    (xpOption $ xpElemNodes "{jabber:client}priority"
                       (xpContent xpPrim))
  
  xpShow :: PU Text ShowStatus
  xpShow = ("xpShow", "") <?>
          xpPartial ( \input -> case showStatusFromText input of
                                     Nothing -> Left "Could not parse show status."
                                     Just j -> Right j)
                    showStatusToText
    where
      showStatusFromText "away" = Just StatusAway
      showStatusFromText "chat" = Just StatusChat
      showStatusFromText "dnd" = Just StatusDnd
      showStatusFromText "xa" = Just StatusXa
      showStatusFromText _ = Nothing
      showStatusToText StatusAway = "away"
      showStatusToText StatusChat = "chat"
      showStatusToText StatusDnd = "dnd"
      showStatusToText StatusXa = "xa"
  