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