{-# LANGUAGE FlexibleContexts, RankNTypes #-}
-- | Provides combinators for the lens-based manipulation of state and
-- context types provided by the fused-effects library, similar to
-- those provided for mtl-based monad transformers.
module Control.Effect.Lens
  ( -- * Reader accessors
    Control.Effect.Lens.view
  , views
    -- * State getters/setters
  , use
  , uses
  , assign
  , modifying
    -- * Infix operators
  , (.=)
  , (?=)
  , (%=)
  , (<~)
    -- * Mathematical operators
  , (+=)
  , (-=)
  , (*=)
  , (//=)
  ) where

import Control.Algebra
import Control.Effect.Reader as Reader
import Control.Effect.State as State
import Lens.Micro as Lens
import Lens.Micro.Extras as Lens

-- | View the value pointed to by a @Getter@, 'Lens', 'Traversal', or
-- @Fold@ corresponding to the 'Reader' context of the given monadic
-- carrier.
view :: forall r a sig m . (Has (Reader.Reader r) sig m) => Getting a r a -> m a
view :: Getting a r a -> m a
view Getting a r a
l = (r -> a) -> m a
forall r (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Reader r) sig m =>
(r -> a) -> m a
Reader.asks (Getting a r a -> r -> a
forall a s. Getting a s a -> s -> a
Lens.view Getting a r a
l)
{-# INLINE view #-}

-- | View a function of the value pointed to by a @Getter@ or 'Lens',
-- or the result of folding over all the results of a @Fold@ or
-- 'Traversal', when applied to the 'Reader' context of the given
-- monadic carrier.
--
-- This is slightly more general in lens itself, but should suffice for our purposes.
views :: forall s a b sig m . (Has (Reader.Reader s) sig m) => Getting a s a -> (a -> b) -> m b
views :: Getting a s a -> (a -> b) -> m b
views Getting a s a
l a -> b
f = (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ((s -> a) -> m a
forall r (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Reader r) sig m =>
(r -> a) -> m a
Reader.asks (Getting a s a -> s -> a
forall a s. Getting a s a -> s -> a
Lens.view Getting a s a
l))
{-# INLINE views #-}

-- | Extract the target of a 'Lens' or @Getter@, or use a summary of a
-- @Fold@ or 'Traversal' that points to a monoidal value.
use :: forall s a sig m . (Has (State.State s) sig m) => Getting a s a -> m a
use :: Getting a s a -> m a
use Getting a s a
l = (s -> a) -> m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> a) -> m a
State.gets (Getting a s a -> s -> a
forall a s. Getting a s a -> s -> a
Lens.view Getting a s a
l)
{-# INLINE use #-}

-- | Use a function of the target of a 'Lens' or @Getter@ in the
-- current state, or use a summary of a @Fold@ or 'Traversal' that
-- points to a monoidal value.
uses :: forall s a b f sig . (Has (State.State s) sig f) => Getting a s a -> (a -> b) -> f b
uses :: Getting a s a -> (a -> b) -> f b
uses Getting a s a
l a -> b
f = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ((s -> a) -> f a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> a) -> m a
State.gets (Getting a s a -> s -> a
forall a s. Getting a s a -> s -> a
Lens.view Getting a s a
l))
{-# INLINE uses #-}

-- | Replace the target of a 'Lens' (or all the targets of a @Setter@
-- or 'Traversal') within the current monadic state, irrespective of
-- the old value.
--
-- This is a prefix version of '.='.
assign :: forall s a b sig m . (Has (State.State s) sig m) => ASetter s s a b -> b -> m ()
assign :: ASetter s s a b -> b -> m ()
assign ASetter s s a b
l b
b = (s -> s) -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
State.modify (ASetter s s a b -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter s s a b
l b
b)
{-# INLINE assign #-}

-- | Map over the target of a 'Lens', or all of the targets of a @Setter@
-- or 'Traversal', in the current monadic state.
--
-- This is a prefix version of '%='.
modifying :: forall s a b sig m . (Has (State.State s) sig m) => ASetter s s a b -> (a -> b) -> m ()
modifying :: ASetter s s a b -> (a -> b) -> m ()
modifying ASetter s s a b
l a -> b
f = (s -> s) -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
State.modify (ASetter s s a b -> (a -> b) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter s s a b
l a -> b
f)
{-# INLINE modifying #-}

infix 4 .=, %=, ?=, +=, -=, *=, //=
infixr 2 <~

-- | Replace the target of a 'Lens' (or all the targets of a @Setter@
-- or 'Traversal') within the current monadic state, irrespective of
-- the old value.
--
-- This is an infix version of 'assign'.
(.=) :: forall s a b sig m . (Has (State.State s) sig m) => ASetter s s a b -> b -> m ()
.= :: ASetter s s a b -> b -> m ()
(.=) = ASetter s s a b -> b -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
assign
{-# INLINE (.=) #-}

-- | Replace the target of a Lens or all of the targets of a @Setter@ or
-- 'Traversal' in our monadic state with Just a new value, irrespective
-- of the old.
(?=) :: forall s a b sig m . (Has (State.State s) sig m) => ASetter s s a (Maybe b) -> b -> m ()
ASetter s s a (Maybe b)
setter ?= :: ASetter s s a (Maybe b) -> b -> m ()
?= b
item = ASetter s s a (Maybe b)
setter ASetter s s a (Maybe b) -> Maybe b -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= b -> Maybe b
forall a. a -> Maybe a
Just b
item
{-# INLINE (?=) #-}

-- | Run a monadic action, and set all of the targets of a 'Lens', @Setter@
-- or 'Traversal' to its result.
(<~) :: forall s a b sig m . (Has (State s) sig m) => ASetter s s a b -> m b -> m ()
ASetter s s a b
setter <~ :: ASetter s s a b -> m b -> m ()
<~ m b
act = m b
act m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ASetter s s a b -> b -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
assign ASetter s s a b
setter
{-# INLINE (<~) #-}

-- | Map over the target of a 'Lens', or all of the targets of a @Setter@
-- or 'Traversal', in the current monadic state.
--
-- This is an infix version of 'modifying'.
(%=) :: forall s a b sig m . (Has (State.State s) sig m) => ASetter s s a b -> (a -> b) -> m ()
%= :: ASetter s s a b -> (a -> b) -> m ()
(%=) = ASetter s s a b -> (a -> b) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
modifying
{-# INLINE (%=) #-}

-- | Modify the target(s) of a 'Lens', @Iso@, @Setter@ or 'Traversal' by adding a value.
(+=) :: forall s a sig m . (Has (State.State s) sig m, Num a) => ASetter' s a -> a -> m ()
ASetter' s a
l += :: ASetter' s a -> a -> m ()
+= a
v = (s -> s) -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
State.modify (ASetter' s a
l ASetter' s a -> a -> s -> s
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ a
v)
{-# INLINE (+=) #-}

-- | Modify the target(s) of a 'Lens', @Iso@, @Setter@ or 'Traversal' by subtracting a value.
(-=) :: forall s a sig m . (Has (State.State s) sig m, Num a) => ASetter' s a -> a -> m ()
ASetter' s a
l -= :: ASetter' s a -> a -> m ()
-= a
v = (s -> s) -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
State.modify (ASetter' s a
l ASetter' s a -> a -> s -> s
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ a
v)
{-# INLINE (-=) #-}

-- | Modify the target(s) of a 'Lens', @Iso@, @Setter@ or 'Traversal' by subtracting a value.
(*=) :: forall s a sig m . (Has (State.State s) sig m, Num a) => ASetter' s a -> a -> m ()
ASetter' s a
l *= :: ASetter' s a -> a -> m ()
*= a
v = ASetter' s a -> (a -> a) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter' s a
l (a -> a -> a
forall a. Num a => a -> a -> a
* a
v)
{-# INLINE (*=) #-}

-- | Modify the target(s) of a 'Lens', @Iso@, @Setter@ or 'Traversal' by dividing a value.
(//=) :: forall s a sig m . (Has (State.State s) sig m, Fractional a) => ASetter' s a -> a -> m ()
ASetter' s a
l //= :: ASetter' s a -> a -> m ()
//= a
v = ASetter' s a -> (a -> a) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter' s a
l (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
v)
{-# INLINE (//=) #-}