Browse Source

more lenses

master
Philipp Balzarek 12 years ago
parent
commit
7225f2cdbc
  1. 20
      source/Network/Xmpp.hs
  2. 88
      source/Network/Xmpp/Lens.hs
  3. 2
      source/Network/Xmpp/Types.hs

20
source/Network/Xmpp.hs

@ -172,13 +172,31 @@ module Network.Xmpp
, StanzaErrorCondition(..) , StanzaErrorCondition(..)
, SaslFailure(..) , SaslFailure(..)
-- * Lenses -- * Lenses
-- | import Network.Xmpp.Lens for basic lens functions ('view', -- | You can import Network.Xmpp.Lens for basic lens functions ('view',
-- 'modify' and 'set') -- 'modify' and 'set')
-- ** Stanzas
, HasStanzaAttrs(..) , HasStanzaAttrs(..)
, HasStanzaID(..) , HasStanzaID(..)
, sid' , sid'
, HasStanzaPayload(..) , HasStanzaPayload(..)
, HasStanzaError(..) , HasStanzaError(..)
, messageTypeL
, presenceTypeL
, iqRequestTypeL
-- ** StanzaError
, stanzaErrorTypeL
, stanzaErrorConditionL
, stanzaErrorTextL
, stanzaErrorApplL
-- ** StreamConfiguration
, preferredLangL
, toJidL
, connectionDetailsL
, resolvConfL
, establishSessionL
, tlsBehaviourL
, tlsParamsL
-- * Threads -- * Threads
, dupSession , dupSession
-- * Miscellaneous -- * Miscellaneous

88
source/Network/Xmpp/Lens.hs

@ -5,7 +5,9 @@
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
-- | Van Laarhoven lenses for XMPP types. The lenses are designed to work with -- | Van Laarhoven lenses for XMPP types. The lenses are designed to work with
-- the lens library. -- the lens library. This module also provides 3 simple accessors ('view',
-- 'modify', 'set') so you don't need to pull in the lens library to get some
-- use out of them.
module Network.Xmpp.Lens module Network.Xmpp.Lens
( Lens ( Lens
-- * Accessors -- * Accessors
@ -15,11 +17,29 @@ module Network.Xmpp.Lens
, modify , modify
, set , set
-- * Lenses -- * Lenses
-- ** Stanzas
, HasStanzaAttrs(..) , HasStanzaAttrs(..)
, HasStanzaID(..) , HasStanzaID(..)
, sid' , sid'
, HasStanzaPayload(..) , HasStanzaPayload(..)
, HasStanzaError(..) , HasStanzaError(..)
, messageTypeL
, presenceTypeL
, iqRequestTypeL
-- ** StanzaError
, stanzaErrorTypeL
, stanzaErrorConditionL
, stanzaErrorTextL
, stanzaErrorApplL
-- ** StreamConfiguration
, preferredLangL
, toJidL
, connectionDetailsL
, resolvConfL
, establishSessionL
, tlsBehaviourL
, tlsParamsL
) )
where where
@ -28,6 +48,8 @@ import Data.Functor.Identity(Identity(..))
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.Text(Text) import Data.Text(Text)
import Data.XML.Types(Element) import Data.XML.Types(Element)
import Network.DNS(ResolvConf)
import Network.TLS (TLSParams)
import Network.Xmpp.Types import Network.Xmpp.Types
-- | Van-Laarhoven lenses. -- | Van-Laarhoven lenses.
@ -204,6 +226,70 @@ instance HasStanzaPayload PresenceError [Element] where
payload inj m@PresenceError{presenceErrorPayload = i} = payload inj m@PresenceError{presenceErrorPayload = i} =
(\i' -> m{presenceErrorPayload = i'}) <$> inj i (\i' -> m{presenceErrorPayload = i'}) <$> inj i
iqRequestTypeL :: Lens IQRequest IQRequestType
iqRequestTypeL inj p@IQRequest{iqRequestType = tp} =
(\tp' -> p{iqRequestType = tp'}) <$> inj tp
messageTypeL :: Lens Message MessageType
messageTypeL inj p@Message{messageType = tp} =
(\tp' -> p{messageType = tp'}) <$> inj tp
presenceTypeL :: Lens Presence PresenceType
presenceTypeL inj p@Presence{presenceType = tp} =
(\tp' -> p{presenceType = tp'}) <$> inj tp
-- StanzaError
-----------------------
stanzaErrorTypeL :: Lens StanzaError StanzaErrorType
stanzaErrorTypeL inj se@StanzaError{stanzaErrorType = x} =
(\x' -> se{stanzaErrorType = x'}) <$> inj x
stanzaErrorConditionL :: Lens StanzaError StanzaErrorCondition
stanzaErrorConditionL inj se@StanzaError{stanzaErrorCondition = x} =
(\x' -> se{stanzaErrorCondition = x'}) <$> inj x
stanzaErrorTextL :: Lens StanzaError (Maybe (Maybe LangTag, Text))
stanzaErrorTextL inj se@StanzaError{stanzaErrorText = x} =
(\x' -> se{stanzaErrorText = x'}) <$> inj x
stanzaErrorApplL :: Lens StanzaError (Maybe Element)
stanzaErrorApplL inj se@StanzaError{stanzaErrorApplicationSpecificCondition = x} =
(\x' -> se{stanzaErrorApplicationSpecificCondition = x'}) <$> inj x
-- StreamConfiguration
-----------------------
preferredLangL :: Lens StreamConfiguration (Maybe LangTag)
preferredLangL inj sc@StreamConfiguration{preferredLang = x}
= (\x' -> sc{preferredLang = x'}) <$> inj x
toJidL :: Lens StreamConfiguration (Maybe (Jid, Bool))
toJidL inj sc@StreamConfiguration{toJid = x}
= (\x' -> sc{toJid = x'}) <$> inj x
connectionDetailsL :: Lens StreamConfiguration ConnectionDetails
connectionDetailsL inj sc@StreamConfiguration{connectionDetails = x}
= (\x' -> sc{connectionDetails = x'}) <$> inj x
resolvConfL :: Lens StreamConfiguration ResolvConf
resolvConfL inj sc@StreamConfiguration{resolvConf = x}
= (\x' -> sc{resolvConf = x'}) <$> inj x
establishSessionL :: Lens StreamConfiguration Bool
establishSessionL inj sc@StreamConfiguration{establishSession = x}
= (\x' -> sc{establishSession = x'}) <$> inj x
tlsBehaviourL :: Lens StreamConfiguration TlsBehaviour
tlsBehaviourL inj sc@StreamConfiguration{tlsBehaviour = x}
= (\x' -> sc{tlsBehaviour = x'}) <$> inj x
tlsParamsL :: Lens StreamConfiguration TLSParams
tlsParamsL inj sc@StreamConfiguration{tlsParams = x}
= (\x' -> sc{tlsParams = x'}) <$> inj x
-- | Read the value the lens is pointing to -- | Read the value the lens is pointing to
view :: Lens a b -> a -> b view :: Lens a b -> a -> b

2
source/Network/Xmpp/Types.hs

@ -896,7 +896,7 @@ domainpart = domainpart_
resourcepart :: Jid -> Maybe Text resourcepart :: Jid -> Maybe Text
resourcepart = resourcepart_ resourcepart = resourcepart_
-- Parses an JID string and returns its three parts. It performs no validation -- Parses a JID string and returns its three parts. It performs no validation
-- or transformations. -- or transformations.
jidParts :: AP.Parser (Maybe Text, Text, Maybe Text) jidParts :: AP.Parser (Maybe Text, Text, Maybe Text)
jidParts = do jidParts = do

Loading…
Cancel
Save