{-# 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')