{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

module Snap.Snaplet.Internal.LensT where


------------------------------------------------------------------------------
import           Control.Applicative         (Alternative (..),
                                              Applicative (..))
import           Control.Category            ((.))
import           Control.Lens                (ALens', cloneLens, storing, (^#))
import           Control.Monad               (MonadPlus (..))
import           Control.Monad.Base          (MonadBase (..))
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,
                                              defaultLiftWith, defaultRestoreM,
                                              defaultRestoreT)
import           Prelude                     (Functor (..), Monad (..), const,
                                              ($), ($!))
import           Snap.Core                   (MonadSnap (..))
import           Snap.Snaplet.Internal.RST   (RST (..), runRST, withRST)
------------------------------------------------------------------------------


newtype LensT b v s m a = LensT (RST (ALens' b v) s m a)
  deriving ( forall a. a -> LensT b v s m a
forall a b. LensT b v s m a -> LensT b v s m b -> LensT b v s m b
forall a b.
LensT b v s m a -> (a -> LensT b v s m b) -> LensT b v s m b
forall {b} {v} {s} {m :: * -> *}.
Monad m =>
Applicative (LensT b v s m)
forall b v s (m :: * -> *) a. Monad m => a -> LensT b v s m a
forall b v s (m :: * -> *) a b.
Monad m =>
LensT b v s m a -> LensT b v s m b -> LensT b v s m b
forall b v s (m :: * -> *) a b.
Monad m =>
LensT b v s m a -> (a -> LensT b v s m b) -> LensT b v s m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> LensT b v s m a
$creturn :: forall b v s (m :: * -> *) a. Monad m => a -> LensT b v s m a
>> :: forall a b. LensT b v s m a -> LensT b v s m b -> LensT b v s m b
$c>> :: forall b v s (m :: * -> *) a b.
Monad m =>
LensT b v s m a -> LensT b v s m b -> LensT b v s m b
>>= :: forall a b.
LensT b v s m a -> (a -> LensT b v s m b) -> LensT b v s m b
$c>>= :: forall b v s (m :: * -> *) a b.
Monad m =>
LensT b v s m a -> (a -> LensT b v s m b) -> LensT b v s m b
Monad
           , forall b v s (m :: * -> *) a. Monad m => m a -> LensT b v s m a
forall (m :: * -> *) a. Monad m => m a -> LensT b v s m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> LensT b v s m a
$clift :: forall b v s (m :: * -> *) a. Monad m => m a -> LensT b v s m a
MonadTrans
           , forall a b. a -> LensT b v s m b -> LensT b v s m a
forall a b. (a -> b) -> LensT b v s m a -> LensT b v s m b
forall b v s (m :: * -> *) a b.
Functor m =>
a -> LensT b v s m b -> LensT b v s m a
forall b v s (m :: * -> *) a b.
Functor m =>
(a -> b) -> LensT b v s m a -> LensT b v s m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> LensT b v s m b -> LensT b v s m a
$c<$ :: forall b v s (m :: * -> *) a b.
Functor m =>
a -> LensT b v s m b -> LensT b v s m a
fmap :: forall a b. (a -> b) -> LensT b v s m a -> LensT b v s m b
$cfmap :: forall b v s (m :: * -> *) a b.
Functor m =>
(a -> b) -> LensT b v s m a -> LensT b v s m b
Functor
           , forall a. a -> LensT b v s m a
forall a b. LensT b v s m a -> LensT b v s m b -> LensT b v s m a
forall a b. LensT b v s m a -> LensT b v s m b -> LensT b v s m b
forall a b.
LensT b v s m (a -> b) -> LensT b v s m a -> LensT b v s m b
forall a b c.
(a -> b -> c)
-> LensT b v s m a -> LensT b v s m b -> LensT b v s m c
forall {b} {v} {s} {m :: * -> *}.
Monad m =>
Functor (LensT b v s m)
forall b v s (m :: * -> *) a. Monad m => a -> LensT b v s m a
forall b v s (m :: * -> *) a b.
Monad m =>
LensT b v s m a -> LensT b v s m b -> LensT b v s m a
forall b v s (m :: * -> *) a b.
Monad m =>
LensT b v s m a -> LensT b v s m b -> LensT b v s m b
forall b v s (m :: * -> *) a b.
Monad m =>
LensT b v s m (a -> b) -> LensT b v s m a -> LensT b v s m b
forall b v s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> LensT b v s m a -> LensT b v s m b -> LensT b v s m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. LensT b v s m a -> LensT b v s m b -> LensT b v s m a
$c<* :: forall b v s (m :: * -> *) a b.
Monad m =>
LensT b v s m a -> LensT b v s m b -> LensT b v s m a
*> :: forall a b. LensT b v s m a -> LensT b v s m b -> LensT b v s m b
$c*> :: forall b v s (m :: * -> *) a b.
Monad m =>
LensT b v s m a -> LensT b v s m b -> LensT b v s m b
liftA2 :: forall a b c.
(a -> b -> c)
-> LensT b v s m a -> LensT b v s m b -> LensT b v s m c
$cliftA2 :: forall b v s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> LensT b v s m a -> LensT b v s m b -> LensT b v s m c
<*> :: forall a b.
LensT b v s m (a -> b) -> LensT b v s m a -> LensT b v s m b
$c<*> :: forall b v s (m :: * -> *) a b.
Monad m =>
LensT b v s m (a -> b) -> LensT b v s m a -> LensT b v s m b
pure :: forall a. a -> LensT b v s m a
$cpure :: forall b v s (m :: * -> *) a. Monad m => a -> LensT b v s m a
Applicative
           , forall a. IO a -> LensT b v s m a
forall {b} {v} {s} {m :: * -> *}.
MonadIO m =>
Monad (LensT b v s m)
forall b v s (m :: * -> *) a. MonadIO m => IO a -> LensT b v s m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> LensT b v s m a
$cliftIO :: forall b v s (m :: * -> *) a. MonadIO m => IO a -> LensT b v s m a
MonadIO
           , forall a. LensT b v s m a
forall a. LensT b v s m a -> LensT b v s m a -> LensT b v s m a
forall {b} {v} {s} {m :: * -> *}.
MonadPlus m =>
Monad (LensT b v s m)
forall {b} {v} {s} {m :: * -> *}.
MonadPlus m =>
Alternative (LensT b v s m)
forall b v s (m :: * -> *) a. MonadPlus m => LensT b v s m a
forall b v s (m :: * -> *) a.
MonadPlus m =>
LensT b v s m a -> LensT b v s m a -> LensT b v s m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. LensT b v s m a -> LensT b v s m a -> LensT b v s m a
$cmplus :: forall b v s (m :: * -> *) a.
MonadPlus m =>
LensT b v s m a -> LensT b v s m a -> LensT b v s m a
mzero :: forall a. LensT b v s m a
$cmzero :: forall b v s (m :: * -> *) a. MonadPlus m => LensT b v s m a
MonadPlus
           , forall a. LensT b v s m a
forall a. LensT b v s m a -> LensT b v s m [a]
forall a. LensT b v s m a -> LensT b v s m a -> LensT b v s m a
forall {b} {v} {s} {m :: * -> *}.
MonadPlus m =>
Applicative (LensT b v s m)
forall b v s (m :: * -> *) a. MonadPlus m => LensT b v s m a
forall b v s (m :: * -> *) a.
MonadPlus m =>
LensT b v s m a -> LensT b v s m [a]
forall b v s (m :: * -> *) a.
MonadPlus m =>
LensT b v s m a -> LensT b v s m a -> LensT b v s m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. LensT b v s m a -> LensT b v s m [a]
$cmany :: forall b v s (m :: * -> *) a.
MonadPlus m =>
LensT b v s m a -> LensT b v s m [a]
some :: forall a. LensT b v s m a -> LensT b v s m [a]
$csome :: forall b v s (m :: * -> *) a.
MonadPlus m =>
LensT b v s m a -> LensT b v s m [a]
<|> :: forall a. LensT b v s m a -> LensT b v s m a -> LensT b v s m a
$c<|> :: forall b v s (m :: * -> *) a.
MonadPlus m =>
LensT b v s m a -> LensT b v s m a -> LensT b v s m a
empty :: forall a. LensT b v s m a
$cempty :: forall b v s (m :: * -> *) a. MonadPlus m => LensT b v s m a
Alternative
           , MonadReader (ALens' b v))


------------------------------------------------------------------------------
instance Monad m => MonadState v (LensT b v b m) where
    get :: LensT b v b m v
get = forall (m :: * -> *) b v. Monad m => LensT b v b m v
lGet
    put :: v -> LensT b v b m ()
put = forall (m :: * -> *) v b. Monad m => v -> LensT b v b m ()
lPut


instance MonadBase bs m => MonadBase bs (LensT b v s m) where
    liftBase :: forall α. bs α -> LensT b v s m α
liftBase = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase


instance MonadBaseControl bs m => MonadBaseControl bs (LensT b v s m) where
     type StM (LensT b v s m) a = ComposeSt (LensT b v s) m a
     liftBaseWith :: forall a. (RunInBase (LensT b v s m) bs -> bs a) -> LensT b v s m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
     restoreM :: forall a. StM (LensT b v s m) a -> LensT b v s m a
restoreM = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
     {-# INLINE liftBaseWith #-}
     {-# INLINE restoreM #-}


instance MonadTransControl (LensT b v s) where
    type StT (LensT b v s) a = StT (RST (ALens' b v) s) a
    liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (LensT b v s) -> m a) -> LensT b v s m a
liftWith = forall (m :: * -> *) (n :: (* -> *) -> * -> *)
       (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTransControl n) =>
(forall b. n m b -> t m b)
-> (forall (o :: * -> *) b. t o b -> n o b)
-> (RunDefault t n -> m a)
-> t m a
defaultLiftWith forall b v s (m :: * -> *) a.
RST (ALens' b v) s m a -> LensT b v s m a
LensT (\(LensT RST (ALens' b v) s o b
rst) -> RST (ALens' b v) s o b
rst)
    restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (LensT b v s) a) -> LensT b v s m a
restoreT = forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
       (t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT forall b v s (m :: * -> *) a.
RST (ALens' b v) s m a -> LensT b v s m a
LensT
    {-# INLINE liftWith #-}
    {-# INLINE restoreT #-}


instance MonadSnap m => MonadSnap (LensT b v s m) where
    liftSnap :: forall a. Snap a -> LensT b v s m a
liftSnap Snap a
m = forall b v s (m :: * -> *) a.
RST (ALens' b v) s m a -> LensT b v s m a
LensT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadSnap m => Snap a -> m a
liftSnap Snap a
m


------------------------------------------------------------------------------
getBase :: Monad m => LensT b v s m s
getBase :: forall (m :: * -> *) b v s. Monad m => LensT b v s m s
getBase = forall b v s (m :: * -> *) a.
RST (ALens' b v) s m a -> LensT b v s m a
LensT forall s (m :: * -> *). MonadState s m => m s
get
{-# INLINE getBase #-}


------------------------------------------------------------------------------
putBase :: Monad m => s -> LensT b v s m ()
putBase :: forall (m :: * -> *) s b v. Monad m => s -> LensT b v s m ()
putBase = forall b v s (m :: * -> *) a.
RST (ALens' b v) s m a -> LensT b v s m a
LensT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
{-# INLINE putBase #-}


------------------------------------------------------------------------------
lGet :: Monad m => LensT b v b m v
lGet :: forall (m :: * -> *) b v. Monad m => LensT b v b m v
lGet = forall b v s (m :: * -> *) a.
RST (ALens' b v) s m a -> LensT b v s m a
LensT forall a b. (a -> b) -> a -> b
$ do
           !ALens' b v
l <- forall r (m :: * -> *). MonadReader r m => m r
ask
           !b
b <- forall s (m :: * -> *). MonadState s m => m s
get
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! b
b forall s t a b. s -> ALens s t a b -> a
^# ALens' b v
l
{-# INLINE lGet #-}


------------------------------------------------------------------------------
lPut :: Monad m => v -> LensT b v b m ()
lPut :: forall (m :: * -> *) v b. Monad m => v -> LensT b v b m ()
lPut v
v = forall b v s (m :: * -> *) a.
RST (ALens' b v) s m a -> LensT b v s m a
LensT forall a b. (a -> b) -> a -> b
$ do
             !ALens' b v
l <- forall r (m :: * -> *). MonadReader r m => m r
ask
             !b
b <- forall s (m :: * -> *). MonadState s m => m s
get
             forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$! forall s t a b. ALens s t a b -> b -> s -> t
storing ALens' b v
l v
v b
b
{-# INLINE lPut #-}


------------------------------------------------------------------------------
runLensT :: Monad m => LensT b v s m a -> ALens' b v -> s -> m (a, s)
runLensT :: forall (m :: * -> *) b v s a.
Monad m =>
LensT b v s m a -> ALens' b v -> s -> m (a, s)
runLensT (LensT RST (ALens' b v) s m a
m) ALens' b v
l = forall r s (m :: * -> *) a. RST r s m a -> r -> s -> m (a, s)
runRST RST (ALens' b v) s m a
m ALens' b v
l
{-# INLINE runLensT #-}


------------------------------------------------------------------------------
withLensT :: Monad m
          => (ALens' b' v' -> ALens' b v)
          -> LensT b v s m a
          -> LensT b' v' s m a
withLensT :: forall (m :: * -> *) b' v' b v s a.
Monad m =>
(ALens' b' v' -> ALens' b v)
-> LensT b v s m a -> LensT b' v' s m a
withLensT ALens' b' v' -> ALens' b v
f (LensT RST (ALens' b v) s m a
m) = forall b v s (m :: * -> *) a.
RST (ALens' b v) s m a -> LensT b v s m a
LensT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r' r s a.
Monad m =>
(r' -> r) -> RST r s m a -> RST r' s m a
withRST ALens' b' v' -> ALens' b v
f RST (ALens' b v) s m a
m
{-# INLINE withLensT #-}


------------------------------------------------------------------------------
withTop :: Monad m
        => ALens' b v'
        -> LensT b v' s m a
        -> LensT b v  s m a
withTop :: forall (m :: * -> *) b v' s a v.
Monad m =>
ALens' b v' -> LensT b v' s m a -> LensT b v s m a
withTop ALens' b v'
subLens = forall (m :: * -> *) b' v' b v s a.
Monad m =>
(ALens' b' v' -> ALens' b v)
-> LensT b v s m a -> LensT b' v' s m a
withLensT (forall a b. a -> b -> a
const ALens' b v'
subLens)
{-# INLINE withTop #-}


------------------------------------------------------------------------------
with :: Monad m => ALens' v v' -> LensT b v' s m a -> LensT b v s m a
with :: forall (m :: * -> *) v v' b s a.
Monad m =>
ALens' v v' -> LensT b v' s m a -> LensT b v s m a
with ALens' v v'
subLens = forall (m :: * -> *) b' v' b v s a.
Monad m =>
(ALens' b' v' -> ALens' b v)
-> LensT b v s m a -> LensT b' v' s m a
withLensT (\ALens' b v
l -> forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens' b v
l 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'
subLens)