{-# 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
    { 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 :: (a -> b) -> Lensed b v m a -> Lensed b v m b
fmap f :: a -> b
f (Lensed g :: 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
$ \l :: ALens' b v
l v :: v
v s :: b
s ->
        (\(a :: a
a,v' :: v
v',s' :: 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 :: a -> Lensed b v m a
pure a :: 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
$ \_ v :: v
v s :: 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 mf :: ALens' b v -> v -> b -> m (a -> b, v, b)
mf <*> :: Lensed b v m (a -> b) -> Lensed b v m a -> Lensed b v m b
<*> Lensed ma :: 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
$ \l :: ALens' b v
l v :: v
v s :: b
s -> do
        (f :: a -> b
f, v' :: v
v', s' :: b
s') <- ALens' b v -> v -> b -> m (a -> b, v, b)
mf ALens' b v
l v
v b
s
        (\(a :: a
a,v'' :: v
v'',s'' :: 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 :: String -> Lensed b v m a
fail s :: 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
$ \_ _ _ -> 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 :: a -> Lensed b v m a
return a :: 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
$ \_ v :: v
v s :: 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 g :: ALens' b v -> v -> b -> m (a, v, b)
g >>= :: Lensed b v m a -> (a -> Lensed b v m b) -> Lensed b v m b
>>= k :: 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
$ \l :: ALens' b v
l v :: v
v s :: b
s -> do
        (a :: a
a, v' :: v
v', s' :: 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
$ \_ v :: v
v s :: 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
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
$ \_ _ s :: 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
$ \l :: ALens' b v
l v :: v
v s :: 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 :: (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 :: (ALens' b v -> ALens' b v') -> Lensed b v' m a -> Lensed b v m a
lensedLocal f :: ALens' b v -> ALens' b v'
f g :: 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 :: m a -> Lensed b v m a
lift m :: 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
$ \_ v :: v
v b :: 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 :: 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 :: 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
    m :: Lensed b v m a
m mplus :: Lensed b v m a -> Lensed b v m a -> Lensed b v m a
`mplus` n :: 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
$ \l :: ALens' b v
l v :: v
v b :: 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 :: 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 m :: ALens' b v -> v -> b -> m (a, v, b)
m <|> :: Lensed b v m a -> Lensed b v m a -> Lensed b v m a
<|> Lensed n :: 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
$ \l :: ALens' b v
l v :: v
v b :: 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 :: 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 :: 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 :: (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 :: 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 :: (Run (Lensed b v) -> m a) -> Lensed b v m a
liftWith f :: 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
$ \l :: ALens' b v
l v :: v
v b :: 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 g :: 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 :: m (StT (Lensed b v) a) -> Lensed b v m a
restoreT k :: 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
$ \_ _ _ -> 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 :: StateT b m a -> Lensed b v m a
globally (StateT f :: 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
$ \l :: ALens' b v
l v :: v
v s :: 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
a, s' :: 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 :: Lensed b v m a -> ALens' b v -> StateT b m a
lensedAsState (Lensed f :: ALens' b v -> v -> b -> m (a, v, b)
f) l :: 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
$ \s :: b
s -> do
    (a :: a
a, v' :: v
v', s' :: 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 :: 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
$ \_ v :: v
v b :: 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 :: ALens' b v' -> Lensed b v' m a -> Lensed b v m a
withTop l :: ALens' b v'
l m :: 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 :: ALens' v v' -> Lensed b v' m a -> Lensed b v m a
with l :: ALens' v v'
l g :: 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 :: ALens' v v' -> Lensed v v' m a -> Lensed b v m a
embed l :: ALens' v v'
l m :: 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 :: StateT v m a -> Lensed b v m a
locally (StateT f :: 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
$ \_ v :: v
v s :: 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
a, v' :: 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 :: Lensed t1 b m t -> ALens' t1 b -> t1 -> m (t, t1)
runLensed (Lensed f :: ALens' t1 b -> b -> t1 -> m (t, b, t1)
f) l :: ALens' t1 b
l s :: t1
s = do
    (a :: t
a, v' :: b
v', s' :: 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')