diff --git a/snap.cabal b/snap.cabal index fe738e16..767fa77c 100644 --- a/snap.cabal +++ b/snap.cabal @@ -155,7 +155,7 @@ Library filepath >= 1.1 && < 1.4, hashable >= 1.1 && < 1.3, heist >= 0.11 && < 0.12, - lens >= 3.7.0.1 && < 3.9, + lens >= 3.8.5 && < 3.9, logict >= 0.4.2 && < 0.6, mtl > 2.0 && < 2.2, mwc-random >= 0.8 && < 0.13, diff --git a/src/Snap/Snaplet/Internal/Initializer.hs b/src/Snap/Snaplet/Internal/Initializer.hs index 1eaa019e..9912a13d 100644 --- a/src/Snap/Snaplet/Internal/Initializer.hs +++ b/src/Snap/Snaplet/Internal/Initializer.hs @@ -121,7 +121,7 @@ upHook h = Initializer $ do ------------------------------------------------------------------------------ -- | Helper function for transforming hooks. -upHook' :: Monad m => SimpleLoupe b a -> (a -> m a) -> b -> m b +upHook' :: Monad m => ALens' b a -> (a -> m a) -> b -> m b upHook' l h b = do v <- h (b ^# l) return $ storing l v b diff --git a/src/Snap/Snaplet/Internal/LensT.hs b/src/Snap/Snaplet/Internal/LensT.hs index 4e3beca4..e465b70c 100644 --- a/src/Snap/Snaplet/Internal/LensT.hs +++ b/src/Snap/Snaplet/Internal/LensT.hs @@ -7,7 +7,6 @@ module Snap.Snaplet.Internal.LensT where import Control.Applicative import Control.Category -import Control.Lens (cloneLens) import Control.Lens.Loupe import Control.Monad.CatchIO import Control.Monad.Reader @@ -18,7 +17,7 @@ import Snap.Core import Snap.Snaplet.Internal.RST -newtype LensT b v s m a = LensT (RST (SimpleLoupe b v) s m a) +newtype LensT b v s m a = LensT (RST (ALens' b v) s m a) deriving ( Monad , MonadTrans , Functor @@ -27,7 +26,7 @@ newtype LensT b v s m a = LensT (RST (SimpleLoupe b v) s m a) , MonadPlus , MonadCatchIO , Alternative - , MonadReader (SimpleLoupe b v) + , MonadReader (ALens' b v) , MonadSnap ) @@ -68,14 +67,14 @@ lPut v = LensT $ do ------------------------------------------------------------------------------ -runLensT :: Monad m => LensT b v s m a -> SimpleLoupe b v -> s -> m (a, s) +runLensT :: Monad m => LensT b v s m a -> ALens' b v -> s -> m (a, s) runLensT (LensT m) l = runRST m l {-# INLINE runLensT #-} ------------------------------------------------------------------------------ withLensT :: Monad m - => (SimpleLoupe b' v' -> SimpleLoupe b v) + => (ALens' b' v' -> ALens' b v) -> LensT b v s m a -> LensT b' v' s m a withLensT f (LensT m) = LensT $ withRST f m @@ -84,7 +83,7 @@ withLensT f (LensT m) = LensT $ withRST f m ------------------------------------------------------------------------------ withTop :: Monad m - => SimpleLoupe b v' + => ALens' b v' -> LensT b v' s m a -> LensT b v s m a withTop subLens = withLensT (const subLens) @@ -92,6 +91,6 @@ withTop subLens = withLensT (const subLens) ------------------------------------------------------------------------------ -with :: Monad m => SimpleLoupe v v' -> LensT b v' s m a -> LensT b v s m a +with :: Monad m => ALens' v v' -> LensT b v' s m a -> LensT b v s m a with subLens = withLensT (\l -> cloneLens l . subLens) diff --git a/src/Snap/Snaplet/Internal/Lensed.hs b/src/Snap/Snaplet/Internal/Lensed.hs index a69ee952..30c78dca 100644 --- a/src/Snap/Snaplet/Internal/Lensed.hs +++ b/src/Snap/Snaplet/Internal/Lensed.hs @@ -5,7 +5,6 @@ module Snap.Snaplet.Internal.Lensed where import Control.Applicative -import Control.Lens (cloneLens) import Control.Lens.Loupe import Control.Monad import Control.Monad.Reader.Class @@ -19,7 +18,7 @@ import Snap.Core ------------------------------------------------------------------------------ newtype Lensed b v m a = Lensed - { unlensed :: SimpleLoupe b v -> v -> b -> m (a, v, b) } + { unlensed :: ALens' b v -> v -> b -> m (a, v, b) } ------------------------------------------------------------------------------ @@ -50,12 +49,12 @@ instance Monad m => MonadState v (Lensed b v m) where put v' = Lensed $ \_ _ s -> return ((), v', s) -instance Monad m => MonadReader (SimpleLoupe b v) (Lensed b v m) where +instance Monad m => MonadReader (ALens' b v) (Lensed b v m) where ask = Lensed $ \l v s -> return (l, v, s) local = lensedLocal ------------------------------------------------------------------------------ -lensedLocal :: Monad m => (SimpleLoupe b v -> SimpleLoupe b v') -> Lensed b v' m a -> Lensed b v m a +lensedLocal :: Monad m => (ALens' b v -> ALens' b v') -> Lensed b v' m a -> Lensed b v m a lensedLocal f g = do l <- ask withTop (f l) g @@ -107,7 +106,7 @@ globally (StateT f) = Lensed $ \l v s -> ------------------------------------------------------------------------------ -lensedAsState :: Monad m => Lensed b v m a -> SimpleLoupe b v -> StateT b m a +lensedAsState :: Monad m => Lensed b v m a -> ALens' b v -> StateT b m a lensedAsState (Lensed f) l = StateT $ \s -> do (a, v', s') <- f l (s ^# l) s return (a, storing l v' s') @@ -119,19 +118,19 @@ getBase = Lensed $ \_ v b -> return (b, v, b) ------------------------------------------------------------------------------ -withTop :: Monad m => SimpleLoupe b v' -> Lensed b v' m a -> Lensed b v m a +withTop :: Monad m => ALens' b v' -> Lensed b v' m a -> Lensed b v m a withTop l m = globally $ lensedAsState m l ------------------------------------------------------------------------------ -with :: Monad m => SimpleLoupe v v' -> Lensed b v' m a -> Lensed b v m a +with :: Monad m => ALens' v v' -> Lensed b v' m a -> Lensed b v m a with l g = do l' <- ask withTop (cloneLens l' . l) g ------------------------------------------------------------------------------ -embed :: Monad m => SimpleLoupe v v' -> Lensed v v' m a -> Lensed b v m a +embed :: Monad m => ALens' v v' -> Lensed v v' m a -> Lensed b v m a embed l m = locally $ lensedAsState m l @@ -144,7 +143,7 @@ locally (StateT f) = Lensed $ \_ v s -> ------------------------------------------------------------------------------ runLensed :: Monad m => Lensed t1 b m t - -> SimpleLoupe t1 b + -> ALens' t1 b -> t1 -> m (t, t1) runLensed (Lensed f) l s = do diff --git a/src/Snap/Snaplet/Internal/Types.hs b/src/Snap/Snaplet/Internal/Types.hs index bb7f7ee0..8eb008f9 100644 --- a/src/Snap/Snaplet/Internal/Types.hs +++ b/src/Snap/Snaplet/Internal/Types.hs @@ -112,7 +112,7 @@ snapletConfig :: SimpleLens (Snaplet a) SnapletConfig snapletValue :: SimpleLens (Snaplet a) a -} -type SnapletLens s a = SimpleLoupe s (Snaplet a) +type SnapletLens s a = ALens' s (Snaplet a) ------------------------------------------------------------------------------ -- | Transforms a lens of the type you get from makeLenses to an similar lens