{-# LANGUAGE RankNTypes #-}
module Network.IRC.Client.Internal.Lens where
import Control.Applicative (Const(..))
import Control.Concurrent.STM (STM, TVar, atomically, readTVar,
readTVarIO, writeTVar)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Functor.Contravariant (Contravariant)
import Data.Functor.Identity (Identity(..))
import Data.Monoid (First(..))
import Data.Profunctor (Choice)
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type Lens' s a = Lens s s a a
type Getter s a = forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s
type Getting r s a = (a -> Const r a) -> s -> Const r s
type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
type Prism' s a = Prism s s a a
{-# INLINE get #-}
get :: Getting a s a -> s -> a
get :: forall a s. Getting a s a -> s -> a
get Getting a s a
lens = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting a s a
lens forall {k} a (b :: k). a -> Const a b
Const
{-# INLINE set #-}
set :: Lens' s a -> a -> s -> s
set :: forall s a. Lens' s a -> a -> s -> s
set Lens' s a
lens a
a = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' s a
lens (\a
_ -> forall a. a -> Identity a
Identity a
a)
{-# INLINE modify #-}
modify :: Lens' s a -> (a -> a) -> s -> s
modify :: forall s a. Lens' s a -> (a -> a) -> s -> s
modify Lens' s a
lens a -> a
f s
s = let a :: a
a = forall a s. Getting a s a -> s -> a
get Lens' s a
lens s
s in forall s a. Lens' s a -> a -> s -> s
set Lens' s a
lens (a -> a
f a
a) s
s
{-# INLINE preview #-}
preview :: Prism' s a -> s -> Maybe a
preview :: forall s a. Prism' s a -> s -> Maybe a
preview Prism' s a
lens = forall a. First a -> Maybe a
getFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' s a
lens (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
snapshot :: MonadIO m => Getting (TVar a) s (TVar a) -> s -> m a
snapshot :: forall (m :: * -> *) a s.
MonadIO m =>
Getting (TVar a) s (TVar a) -> s -> m a
snapshot Getting (TVar a) s (TVar a)
lens = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> IO a
readTVarIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting a s a -> s -> a
get Getting (TVar a) s (TVar a)
lens
snapshotModify :: MonadIO m => Lens' s (TVar a) -> (a -> STM (a, b)) -> s -> m b
snapshotModify :: forall (m :: * -> *) s a b.
MonadIO m =>
Lens' s (TVar a) -> (a -> STM (a, b)) -> s -> m b
snapshotModify Lens' s (TVar a)
lens a -> STM (a, b)
f s
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
let avar :: TVar a
avar = forall a s. Getting a s a -> s -> a
get Lens' s (TVar a)
lens s
s
a
a <- forall a. TVar a -> STM a
readTVar TVar a
avar
(a
a', b
b) <- a -> STM (a, b)
f a
a
forall a. TVar a -> a -> STM ()
writeTVar TVar a
avar a
a'
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b