{-# LANGUAGE RankNTypes #-}
module MonadVar.Lens
  ( (./)
  , effectful
  , (.!)
  , _VarM
  , _Var
  ) where

import           MonadVar.Prelude
import           MonadVar.Compat
import           MonadVar.Classes
import           Data.Functor.Identity
import           Data.Functor.Compose

infixl 8 ^.
infixr 8 ./
infixr 9 .!

-- We define our own lenses just to not depend on anything.
type LensLike f s t a b = (a -> f b) -> s -> f t
type Lens       s t a b = forall f. Functor f => LensLike f s t a b
type ASetter    s t a b = LensLike Identity s t a b

(^.) :: s -> LensLike (Const a) s t a b -> a
s
s ^. :: s -> LensLike (Const a) s t a b -> a
^. LensLike (Const a) s t a b
_L = Const a t -> a
forall a k (b :: k). Const a b -> a
getConst (LensLike (Const a) s t a b
_L a -> Const a b
forall k a (b :: k). a -> Const a b
Const s
s)
{-# INLINE (^.) #-}

_Of :: (s -> a) -> LensLike f s b a b
_Of :: (s -> a) -> LensLike f s b a b
_Of s -> a
f a -> f b
g = a -> f b
g (a -> f b) -> (s -> a) -> s -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a
f
{-# INLINE _Of #-}

-- | Go down by the first lens into a data structure and
-- apply the second lens to the result.
-- This throws away the part of the structure skipped by the first lens, e.g.
--
-- @
-- (\'a\', (\'b\', \'c\')) & _2 ./ _2 %~ succ
-- @
--
-- results in
--
-- @
-- (\'b\',\'d\')
-- @
--
(./)
  :: LensLike (Const s) v x s y
  -> LensLike  f        s t a b
  -> LensLike  f        v t a b
LensLike (Const s) v x s y
_L ./ :: LensLike (Const s) v x s y
-> LensLike f s t a b -> LensLike f v t a b
./ LensLike f s t a b
_M = (v -> s) -> LensLike f v t s t
forall s a (f :: * -> *) b. (s -> a) -> LensLike f s b a b
_Of (v -> LensLike (Const s) v x s y -> s
forall s a t b. s -> LensLike (Const a) s t a b -> a
^. LensLike (Const s) v x s y
_L) LensLike f v t s t -> LensLike f s t a b -> LensLike f v t a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike f s t a b
_M
{-# INLINE (./) #-}

-- | Make a lens that runs with an effect out of a simple lens. E.g.
--
-- @
-- (\"a\", \"b\") & effectful _2 .~ getLine
-- @
--
-- asks for a string and replaces the second element of the tuple with it.
effectful :: Functor f => Lens s t a b -> Lens s (f t) a (f b)
effectful :: Lens s t a b -> Lens s (f t) a (f b)
effectful Lens s t a b
_L a -> f (f b)
f = Compose f f t -> f (f t)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose f f t -> f (f t)) -> (s -> Compose f f t) -> s -> f (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike (Compose f f) s t a b
Lens s t a b
_L (f (f b) -> Compose f f b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (f b) -> Compose f f b) -> (a -> f (f b)) -> a -> Compose f f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f (f b)
f)
{-# INLINE effectful #-}

-- | Compose a simple lens and a lens that runs with some effect.
(.!)
  :: (Functor f, Functor g)
  => Lens       v  w    s t
  -> LensLike g s (f t) a b
  -> LensLike g v (f w) a b
Lens v w s t
_L .! :: Lens v w s t -> LensLike g s (f t) a b -> LensLike g v (f w) a b
.! LensLike g s (f t) a b
_M = Lens v w s t -> Lens v (f w) s (f t)
forall (f :: * -> *) s t a b.
Functor f =>
Lens s t a b -> Lens s (f t) a (f b)
effectful Lens v w s t
_L LensLike g v (f w) s (f t)
-> LensLike g s (f t) a b -> LensLike g v (f w) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike g s (f t) a b
_M
{-# INLINE (.!) #-}

-- | A monadic setter for a variable. E.g.
--
-- @
-- do
--   v <- newIORef \'a\'
--   v & _VarM %~ \\a -> succ a <$ putStr (show a)
--   readIORef v >>= print
-- @
--
-- prints
--
-- @
-- \'a\'\'b\'
-- @
--
_VarM :: forall m n v a. MonadMutateM_ m n v => ASetter (v a) (n ()) a (m a)
_VarM :: ASetter (v a) (n ()) a (m a)
_VarM a -> Identity (m a)
f v a
v = n () -> Identity (n ())
forall a. a -> Identity a
Identity (n () -> Identity (n ()))
-> ((a -> m a) -> n ()) -> (a -> m a) -> Identity (n ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> (a -> m a) -> n ()
forall (f :: * -> *) (m :: * -> *) (v :: * -> *) a.
MonadMutateM_ f m v =>
v a -> (a -> f a) -> m ()
mutateM_ v a
v ((a -> m a) -> Identity (n ())) -> (a -> m a) -> Identity (n ())
forall a b. (a -> b) -> a -> b
$ Identity (m a) -> m a
forall a. Identity a -> a
runIdentity (Identity (m a) -> m a) -> (a -> Identity (m a)) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity (m a)
f
{-# INLINE _VarM #-}

-- | A setter for a variable. E.g.
--
-- @
-- do
--   v <- newIORef \'a\'
--   v & _Var %~ succ
--   readIORef v >>= print
-- @
--
-- prints
--
-- @
-- \'b\'
-- @
--
_Var :: forall m v a. MonadMutate_ m v => ASetter (v a) (m ()) a a
_Var :: ASetter (v a) (m ()) a a
_Var a -> Identity a
f v a
v = m () -> Identity (m ())
forall a. a -> Identity a
Identity (m () -> Identity (m ()))
-> ((a -> a) -> m ()) -> (a -> a) -> Identity (m ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> (a -> a) -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadMutate_ m v =>
v a -> (a -> a) -> m ()
mutate_ v a
v ((a -> a) -> Identity (m ())) -> (a -> a) -> Identity (m ())
forall a b. (a -> b) -> a -> b
$ Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
f
{-# INLINE _Var #-}