From d17a918510aac40ac2278641766b253a4b445b97 Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Thu, 24 Jul 2014 13:12:28 +0200 Subject: [PATCH] lens and type cleanup --- pontarius-xmpp.cabal | 10 +++++----- source/Network/Xmpp/Lens.hs | 33 +++++++++++++-------------------- source/Network/Xmpp/Stream.hs | 3 ++- source/Network/Xmpp/Types.hs | 1 - 4 files changed, 20 insertions(+), 27 deletions(-) diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index 3170382..3507453 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -50,12 +50,14 @@ Library , dns >=0.3.0 , hslogger >=1.1.0 , iproute >=1.2.4 + , lens-family , lifted-base >=0.1.0.1 , mtl >=2.0.0.0 , network >=2.3.1.0 + , profunctors >= 4 , pureMD5 >=2.1.2.1 - , resourcet >=0.3.0 , random >=1.0.0.0 + , resourcet >=0.3.0 , split >=0.1.2.3 , stm >=2.4 , stringprep >=1.0.0 @@ -64,12 +66,10 @@ Library , transformers >=0.2.2.0 , unbounded-delays >=0.1 , void >=0.5.5 - , xml-types >=0.3.1 + , x509-system >=1.4 , xml-conduit >=1.1.0.7 , xml-picklers >=0.3.3 - , x509-system >=1.4 - , profunctors >= 4 - , lens-family + , xml-types >=0.3.1 If impl(ghc ==7.0.1) { Build-Depends: bytestring >=0.9.1.9 && <=0.9.2.1 diff --git a/source/Network/Xmpp/Lens.hs b/source/Network/Xmpp/Lens.hs index 9f61ddf..8e8d35a 100644 --- a/source/Network/Xmpp/Lens.hs +++ b/source/Network/Xmpp/Lens.hs @@ -33,9 +33,9 @@ module Network.Xmpp.Lens -- bring in a lens library to use the optics -- ** Lenses - , view + , LF.view , modify - , set + , LF.set -- * Traversals , getAll -- * Prisms @@ -43,7 +43,7 @@ module Network.Xmpp.Lens -- ** Construction , prism' , mkLens - + , mkIso -- * Lenses -- ** JID @@ -146,6 +146,7 @@ import Data.Profunctor import Data.Text (Text) import qualified Data.Text as Text import Data.XML.Types (Element) +import qualified Lens.Family2 as LF import Network.DNS (ResolvConf) import Network.TLS as TLS import Network.Xmpp.Concurrent.Types @@ -155,13 +156,15 @@ import Network.Xmpp.IM.Roster.Types import Network.Xmpp.Types -- | Van-Laarhoven lenses. +{-# DEPRECATED Lens "Use Lens' from lens-family or lens" #-} type Lens a b = Functor f => (b -> f b) -> a -> f a +{-# DEPRECATED Traversal "Use Traversal' from lens-family or lens" #-} type Traversal a b = Applicative f => (b -> f b) -> a -> f a type Prism a b = forall p f. (Choice p, Applicative f) => p b (f b) -> p a (f a) -type Iso a b = forall p f. (Profunctor p, Functor f) => p a (f a) -> p b (f b) +type Iso a b = forall p f. (Profunctor p, Functor f) => p b (f b) -> p a (f a) prism' :: (b -> s) -> (s -> Maybe b) -> Prism s b prism' bs sma = dimap (\s -> maybe (Left s) Right (sma s)) @@ -171,22 +174,7 @@ mkLens :: (a -> b) -> (b -> a -> a) -> Lens a b mkLens get set = \inj x -> fmap (flip set x) (inj $ get x) mkIso :: (a -> b) -> (b -> a) -> Iso a b -mkIso to from = dimap from (fmap to) - --- Accessors ---------------- - --- | Read the value the lens is pointing to -view :: Lens a b -> a -> b -view l x = getConst $ l Const x - --- | Replace the value the lens is pointing to -set :: Lens a b -> b -> a -> a -set l b x = modify l (const b) x - --- | modify the Value(s) a Lens or Traversal is pointing to -modify :: Traversal a b -> (b -> b) -> a -> a -modify t f = runIdentity . t (Identity . f) +mkIso t f = dimap t (fmap f) newtype Collect a b = Collect {getCollection :: [a]} deriving Functor @@ -194,10 +182,15 @@ instance Applicative (Collect a) where pure _ = Collect [] Collect xs <*> Collect ys = Collect $ xs ++ ys +{-# DEPRECATED getAll "use toListOf (lens-family), partsOf (lens) or similar" #-} -- | Return all the values a Traversal is pointing to in a list getAll :: Traversal a b -> a -> [b] getAll t = getCollection . t (Collect . pure) +{-# DEPRECATED modify "use over (lens-family, lens)" #-} +modify :: Traversal a b -> (b -> b) -> a -> a +modify t f = runIdentity . t (Identity . f) + -- Xmpp Lenses -------------------- diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index f23023f..b94b288 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -44,6 +44,7 @@ import System.IO import System.Log.Logger import System.Random (randomRIO) import Text.XML.Stream.Parse as XP +import Lens.Family2 (over) import Network.Xmpp.Utilities import qualified Network.Xmpp.Lens as L @@ -553,7 +554,7 @@ createStream realm config = do tlsIdentL = L.tlsParamsL . L.clientServerIdentificationL updateHost host ("", _) = (host, "") updateHost _ hst = hst - maybeSetTlsHost host = L.modify tlsIdentL (updateHost host) + maybeSetTlsHost host = over tlsIdentL (updateHost host) -- Connects using the specified method. Returns the Handle acquired, if any. connect :: HostName -> StreamConfiguration -> ErrorT XmppFailure IO diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 06de8ef..e066ba3 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -79,7 +79,6 @@ module Network.Xmpp.Types , parseJid , TlsBehaviour(..) , AuthFailure(..) - , versionFromText ) where import Control.Applicative ((<$>), (<|>), many)