Permalink
Browse files

Update SimpleLoupe to ALens' for lens-3.8 and forward

  • Loading branch information...
1 parent a0eb330 commit 60d57004866faa690f9f5a8e4e36d83eada377ff @glguy glguy committed Jan 31, 2013
View
@@ -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,
@@ -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
@@ -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,14 +83,14 @@ 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)
{-# INLINE withTop #-}
------------------------------------------------------------------------------
-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)
@@ -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
@@ -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

0 comments on commit 60d5700

Please sign in to comment.