{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Snap.Snaplet.Internal.Lensed where
import Control.Applicative (Alternative (..),
Applicative (..), (<$>))
import Control.Category ((.))
import Control.Lens (ALens', cloneLens, storing, (^#))
import Control.Monad (MonadPlus (..), liftM)
import Control.Monad.Base (MonadBase (..))
import qualified Control.Monad.Fail as Fail
import Control.Monad.Reader (MonadReader (..))
import Control.Monad.State.Class (MonadState (..))
import Control.Monad.Trans (MonadIO (..), MonadTrans (..))
import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..),
MonadTransControl (..),
defaultLiftBaseWith,
defaultRestoreM)
import Control.Monad.Trans.State (StateT(..))
import Prelude (Functor (..), Monad (..), ($))
import Snap.Core (MonadSnap (..))
newtype Lensed b v m a = Lensed
{ forall b v (m :: * -> *) a.
Lensed b v m a -> ALens' b v -> v -> b -> m (a, v, b)
unlensed :: ALens' b v -> v -> b -> m (a, v, b) }
instance Functor m => Functor (Lensed b v m) where
fmap :: forall a b. (a -> b) -> Lensed b v m a -> Lensed b v m b
fmap a -> b
f (Lensed ALens' b v -> v -> b -> m (a, v, b)
g) = (ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b)
-> (ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b
forall a b. (a -> b) -> a -> b
$ \ALens' b v
l v
v b
s ->
(\(a
a,v
v',b
s') -> (a -> b
f a
a, v
v', b
s')) ((a, v, b) -> (b, v, b)) -> m (a, v, b) -> m (b, v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ALens' b v -> v -> b -> m (a, v, b)
g ALens' b v
l v
v b
s
instance (Functor m, Monad m) => Applicative (Lensed b v m) where
pure :: forall a. a -> Lensed b v m a
pure a
a = (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a)
-> (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ \ALens' b v
_ v
v b
s -> (a, v, b) -> m (a, v, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, v
v, b
s)
Lensed ALens' b v -> v -> b -> m (a -> b, v, b)
mf <*> :: forall a b.
Lensed b v m (a -> b) -> Lensed b v m a -> Lensed b v m b
<*> Lensed ALens' b v -> v -> b -> m (a, v, b)
ma = (ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b)
-> (ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b
forall a b. (a -> b) -> a -> b
$ \ALens' b v
l v
v b
s -> do
(a -> b
f, v
v', b
s') <- ALens' b v -> v -> b -> m (a -> b, v, b)
mf ALens' b v
l v
v b
s
(\(a
a,v
v'',b
s'') -> (a -> b
f a
a, v
v'', b
s'')) ((a, v, b) -> (b, v, b)) -> m (a, v, b) -> m (b, v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ALens' b v -> v -> b -> m (a, v, b)
ma ALens' b v
l v
v' b
s'
instance Fail.MonadFail m => Fail.MonadFail (Lensed b v m) where
fail :: forall a. String -> Lensed b v m a
fail String
s = (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a)
-> (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ \ALens' b v
_ v
_ b
_ -> String -> m (a, v, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
s
instance Monad m => Monad (Lensed b v m) where
return :: forall a. a -> Lensed b v m a
return a
a = (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a)
-> (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ \ALens' b v
_ v
v b
s -> (a, v, b) -> m (a, v, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, v
v, b
s)
Lensed ALens' b v -> v -> b -> m (a, v, b)
g >>= :: forall a b.
Lensed b v m a -> (a -> Lensed b v m b) -> Lensed b v m b
>>= a -> Lensed b v m b
k = (ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b)
-> (ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b
forall a b. (a -> b) -> a -> b
$ \ALens' b v
l v
v b
s -> do
(a
a, v
v', b
s') <- ALens' b v -> v -> b -> m (a, v, b)
g ALens' b v
l v
v b
s
Lensed b v m b -> ALens' b v -> v -> b -> m (b, v, b)
forall b v (m :: * -> *) a.
Lensed b v m a -> ALens' b v -> v -> b -> m (a, v, b)
unlensed (a -> Lensed b v m b
k a
a) ALens' b v
l v
v' b
s'
instance Monad m => MonadState v (Lensed b v m) where
get :: Lensed b v m v
get = (ALens' b v -> v -> b -> m (v, v, b)) -> Lensed b v m v
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (v, v, b)) -> Lensed b v m v)
-> (ALens' b v -> v -> b -> m (v, v, b)) -> Lensed b v m v
forall a b. (a -> b) -> a -> b
$ \ALens' b v
_ v
v b
s -> (v, v, b) -> m (v, v, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (v
v, v
v, b
s)
put :: v -> Lensed b v m ()
put v
v' = (ALens' b v -> v -> b -> m ((), v, b)) -> Lensed b v m ()
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m ((), v, b)) -> Lensed b v m ())
-> (ALens' b v -> v -> b -> m ((), v, b)) -> Lensed b v m ()
forall a b. (a -> b) -> a -> b
$ \ALens' b v
_ v
_ b
s -> ((), v, b) -> m ((), v, b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), v
v', b
s)
instance Monad m => MonadReader (ALens' b v) (Lensed b v m) where
ask :: Lensed b v m (ALens' b v)
ask = (ALens' b v -> v -> b -> m (ALens' b v, v, b))
-> Lensed b v m (ALens' b v)
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (ALens' b v, v, b))
-> Lensed b v m (ALens' b v))
-> (ALens' b v -> v -> b -> m (ALens' b v, v, b))
-> Lensed b v m (ALens' b v)
forall a b. (a -> b) -> a -> b
$ \ALens' b v
l v
v b
s -> (ALens' b v, v, b) -> m (ALens' b v, v, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ALens' b v
l, v
v, b
s)
local :: forall a.
(ALens' b v -> ALens' b v) -> Lensed b v m a -> Lensed b v m a
local = (ALens' b v -> ALens' b v) -> Lensed b v m a -> Lensed b v m a
forall (m :: * -> *) b v v' a.
Monad m =>
(ALens' b v -> ALens' b v') -> Lensed b v' m a -> Lensed b v m a
lensedLocal
lensedLocal :: Monad m => (ALens' b v -> ALens' b v') -> Lensed b v' m a -> Lensed b v m a
lensedLocal :: forall (m :: * -> *) b v v' a.
Monad m =>
(ALens' b v -> ALens' b v') -> Lensed b v' m a -> Lensed b v m a
lensedLocal ALens' b v -> ALens' b v'
f Lensed b v' m a
g = do
ALens' b v
l <- Lensed b v m (ALens' b v)
forall r (m :: * -> *). MonadReader r m => m r
ask
ALens' b v' -> Lensed b v' m a -> Lensed b v m a
forall (m :: * -> *) b v' a v.
Monad m =>
ALens' b v' -> Lensed b v' m a -> Lensed b v m a
withTop (ALens' b v -> ALens' b v'
f ALens' b v
l) Lensed b v' m a
g
instance MonadTrans (Lensed b v) where
lift :: forall (m :: * -> *) a. Monad m => m a -> Lensed b v m a
lift m a
m = (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a)
-> (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ \ALens' b v
_ v
v b
b -> do
a
res <- m a
m
(a, v, b) -> m (a, v, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
res, v
v, b
b)
instance MonadIO m => MonadIO (Lensed b v m) where
liftIO :: forall a. IO a -> Lensed b v m a
liftIO = m a -> Lensed b v m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Lensed b v m a) -> (IO a -> m a) -> IO a -> Lensed b v m a
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadPlus m => MonadPlus (Lensed b v m) where
mzero :: forall a. Lensed b v m a
mzero = m a -> Lensed b v m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Lensed b v m a
m mplus :: forall a. Lensed b v m a -> Lensed b v m a -> Lensed b v m a
`mplus` Lensed b v m a
n = (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a)
-> (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ \ALens' b v
l v
v b
b ->
Lensed b v m a -> ALens' b v -> v -> b -> m (a, v, b)
forall b v (m :: * -> *) a.
Lensed b v m a -> ALens' b v -> v -> b -> m (a, v, b)
unlensed Lensed b v m a
m ALens' b v
l v
v b
b m (a, v, b) -> m (a, v, b) -> m (a, v, b)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Lensed b v m a -> ALens' b v -> v -> b -> m (a, v, b)
forall b v (m :: * -> *) a.
Lensed b v m a -> ALens' b v -> v -> b -> m (a, v, b)
unlensed Lensed b v m a
n ALens' b v
l v
v b
b
instance (Monad m, Alternative m) => Alternative (Lensed b v m) where
empty :: forall a. Lensed b v m a
empty = m a -> Lensed b v m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall (f :: * -> *) a. Alternative f => f a
empty
Lensed ALens' b v -> v -> b -> m (a, v, b)
m <|> :: forall a. Lensed b v m a -> Lensed b v m a -> Lensed b v m a
<|> Lensed ALens' b v -> v -> b -> m (a, v, b)
n = (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a)
-> (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ \ALens' b v
l v
v b
b -> ALens' b v -> v -> b -> m (a, v, b)
m ALens' b v
l v
v b
b m (a, v, b) -> m (a, v, b) -> m (a, v, b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ALens' b v -> v -> b -> m (a, v, b)
n ALens' b v
l v
v b
b
instance MonadSnap m => MonadSnap (Lensed b v m) where
liftSnap :: forall a. Snap a -> Lensed b v m a
liftSnap = m a -> Lensed b v m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Lensed b v m a)
-> (Snap a -> m a) -> Snap a -> Lensed b v m a
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Snap a -> m a
forall (m :: * -> *) a. MonadSnap m => Snap a -> m a
liftSnap
instance MonadBase base m => MonadBase base (Lensed b v m) where
liftBase :: forall α. base α -> Lensed b v m α
liftBase = m α -> Lensed b v m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> Lensed b v m α)
-> (base α -> m α) -> base α -> Lensed b v m α
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. base α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
instance MonadBaseControl base m => MonadBaseControl base (Lensed b v m) where
type StM (Lensed b v m) a = ComposeSt (Lensed b v) m a
liftBaseWith :: forall a.
(RunInBase (Lensed b v m) base -> base a) -> Lensed b v m a
liftBaseWith = (RunInBase (Lensed b v m) base -> base a) -> Lensed b v m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
restoreM :: forall a. StM (Lensed b v m) a -> Lensed b v m a
restoreM = StM (Lensed b v m) a -> Lensed b v m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
{-# INLINE liftBaseWith #-}
{-# INLINE restoreM #-}
instance MonadTransControl (Lensed b v) where
type StT (Lensed b v) a = (a, v, b)
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (Lensed b v) -> m a) -> Lensed b v m a
liftWith Run (Lensed b v) -> m a
f = (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a)
-> (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ \ALens' b v
l v
v b
b -> do
a
res <- Run (Lensed b v) -> m a
f (Run (Lensed b v) -> m a) -> Run (Lensed b v) -> m a
forall a b. (a -> b) -> a -> b
$ \(Lensed ALens' b v -> v -> b -> n (b, v, b)
g) -> ALens' b v -> v -> b -> n (b, v, b)
g ALens' b v
l v
v b
b
(a, v, b) -> m (a, v, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
res, v
v, b
b)
restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (Lensed b v) a) -> Lensed b v m a
restoreT m (StT (Lensed b v) a)
k = (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a)
-> (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ \ALens' b v
_ v
_ b
_ -> m (a, v, b)
m (StT (Lensed b v) a)
k
{-# INLINE liftWith #-}
{-# INLINE restoreT #-}
globally :: Monad m => StateT b m a -> Lensed b v m a
globally :: forall (m :: * -> *) b a v.
Monad m =>
StateT b m a -> Lensed b v m a
globally (StateT b -> m (a, b)
f) = (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a)
-> (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ \ALens' b v
l v
v b
s ->
((a, b) -> (a, v, b)) -> m (a, b) -> m (a, v, b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\(a
a, b
s') -> (a
a, b
s' b -> ALens' b v -> v
forall s t a b. s -> ALens s t a b -> a
^# ALens' b v
l, b
s')) (m (a, b) -> m (a, v, b)) -> m (a, b) -> m (a, v, b)
forall a b. (a -> b) -> a -> b
$ b -> m (a, b)
f (ALens' b v -> v -> b -> b
forall s t a b. ALens s t a b -> b -> s -> t
storing ALens' b v
l v
v b
s)
lensedAsState :: Monad m => Lensed b v m a -> ALens' b v -> StateT b m a
lensedAsState :: forall (m :: * -> *) b v a.
Monad m =>
Lensed b v m a -> ALens' b v -> StateT b m a
lensedAsState (Lensed ALens' b v -> v -> b -> m (a, v, b)
f) ALens' b v
l = (b -> m (a, b)) -> StateT b m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((b -> m (a, b)) -> StateT b m a)
-> (b -> m (a, b)) -> StateT b m a
forall a b. (a -> b) -> a -> b
$ \b
s -> do
(a
a, v
v', b
s') <- ALens' b v -> v -> b -> m (a, v, b)
f ALens' b v
l (b
s b -> ALens' b v -> v
forall s t a b. s -> ALens s t a b -> a
^# ALens' b v
l) b
s
(a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, ALens' b v -> v -> b -> b
forall s t a b. ALens s t a b -> b -> s -> t
storing ALens' b v
l v
v' b
s')
getBase :: Monad m => Lensed b v m b
getBase :: forall (m :: * -> *) b v. Monad m => Lensed b v m b
getBase = (ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b)
-> (ALens' b v -> v -> b -> m (b, v, b)) -> Lensed b v m b
forall a b. (a -> b) -> a -> b
$ \ALens' b v
_ v
v b
b -> (b, v, b) -> m (b, v, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, v
v, b
b)
withTop :: Monad m => ALens' b v' -> Lensed b v' m a -> Lensed b v m a
withTop :: forall (m :: * -> *) b v' a v.
Monad m =>
ALens' b v' -> Lensed b v' m a -> Lensed b v m a
withTop ALens' b v'
l Lensed b v' m a
m = StateT b m a -> Lensed b v m a
forall (m :: * -> *) b a v.
Monad m =>
StateT b m a -> Lensed b v m a
globally (StateT b m a -> Lensed b v m a) -> StateT b m a -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ Lensed b v' m a -> ALens' b v' -> StateT b m a
forall (m :: * -> *) b v a.
Monad m =>
Lensed b v m a -> ALens' b v -> StateT b m a
lensedAsState Lensed b v' m a
m ALens' b v'
l
with :: Monad m => ALens' v v' -> Lensed b v' m a -> Lensed b v m a
with :: forall (m :: * -> *) v v' b a.
Monad m =>
ALens' v v' -> Lensed b v' m a -> Lensed b v m a
with ALens' v v'
l Lensed b v' m a
g = do
ALens b b v v
l' <- Lensed b v m (ALens b b v v)
forall r (m :: * -> *). MonadReader r m => m r
ask
ALens' b v' -> Lensed b v' m a -> Lensed b v m a
forall (m :: * -> *) b v' a v.
Monad m =>
ALens' b v' -> Lensed b v' m a -> Lensed b v m a
withTop (ALens b b v v -> Lens b b v v
forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens b b v v
l' ((v -> Pretext (->) v' v' v) -> b -> Pretext (->) v' v' b)
-> ALens' v v' -> ALens' b v'
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ALens' v v'
l) Lensed b v' m a
g
embed :: Monad m => ALens' v v' -> Lensed v v' m a -> Lensed b v m a
embed :: forall (m :: * -> *) v v' a b.
Monad m =>
ALens' v v' -> Lensed v v' m a -> Lensed b v m a
embed ALens' v v'
l Lensed v v' m a
m = StateT v m a -> Lensed b v m a
forall (m :: * -> *) v a b.
Monad m =>
StateT v m a -> Lensed b v m a
locally (StateT v m a -> Lensed b v m a) -> StateT v m a -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ Lensed v v' m a -> ALens' v v' -> StateT v m a
forall (m :: * -> *) b v a.
Monad m =>
Lensed b v m a -> ALens' b v -> StateT b m a
lensedAsState Lensed v v' m a
m ALens' v v'
l
locally :: Monad m => StateT v m a -> Lensed b v m a
locally :: forall (m :: * -> *) v a b.
Monad m =>
StateT v m a -> Lensed b v m a
locally (StateT v -> m (a, v)
f) = (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
Lensed ((ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a)
-> (ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
forall a b. (a -> b) -> a -> b
$ \ALens' b v
_ v
v b
s ->
((a, v) -> (a, v, b)) -> m (a, v) -> m (a, v, b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\(a
a, v
v') -> (a
a, v
v', b
s)) (m (a, v) -> m (a, v, b)) -> m (a, v) -> m (a, v, b)
forall a b. (a -> b) -> a -> b
$ v -> m (a, v)
f v
v
runLensed :: Monad m
=> Lensed t1 b m t
-> ALens' t1 b
-> t1
-> m (t, t1)
runLensed :: forall (m :: * -> *) t1 b t.
Monad m =>
Lensed t1 b m t -> ALens' t1 b -> t1 -> m (t, t1)
runLensed (Lensed ALens' t1 b -> b -> t1 -> m (t, b, t1)
f) ALens' t1 b
l t1
s = do
(t
a, b
v', t1
s') <- ALens' t1 b -> b -> t1 -> m (t, b, t1)
f ALens' t1 b
l (t1
s t1 -> ALens' t1 b -> b
forall s t a b. s -> ALens s t a b -> a
^# ALens' t1 b
l) t1
s
(t, t1) -> m (t, t1)
forall (m :: * -> *) a. Monad m => a -> m a
return (t
a, ALens' t1 b -> b -> t1 -> t1
forall s t a b. ALens s t a b -> b -> s -> t
storing ALens' t1 b
l b
v' t1
s')