{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Control.Effect.Optics
  ( -- * Reader operations
    Control.Effect.Optics.view,
    Control.Effect.Optics.views,
    locally,

    -- * State operations
    use,
    uses,
    preuse,
    assign,
    modifying,

    -- * Infix operators
    (.=),
    (?=),
    (%=),
    (<~),
  )
where

import Control.Effect.Reader as Reader
import Control.Effect.State as State
import Optics.Core

-- | View the target of a 'Lens', 'Iso', or 'Getter' in the current context.
--
-- Because functions implement 'Reader.Reader', you can use this wherever
-- you would use the @view@ function in @optics@, as well as the @gview@
-- operation in @optics-extra@.
view ::
  forall r a m sig k is.
  ( Is k A_Getter,
    Has (Reader.Reader r) sig m
  ) =>
  Optic' k is r a ->
  m a
view :: Optic' k is r a -> m a
view Optic' k is r a
l = (r -> a) -> m a
forall r (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Reader r) sig m =>
(r -> a) -> m a
Reader.asks (Optic' k is r a -> r -> a
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
Optics.Core.view Optic' k is r a
l)
{-# INLINE view #-}

-- | Apply a function to the target of a 'Lens', 'Iso', or 'Getter' in the current context.
views ::
  forall r a b m sig k is.
  ( Is k A_Getter,
    Has (Reader.Reader r) sig m
  ) =>
  Optic' k is r a ->
  (a -> b) ->
  m b
views :: Optic' k is r a -> (a -> b) -> m b
views Optic' k is r a
l a -> b
f = (r -> b) -> m b
forall r (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Reader r) sig m =>
(r -> a) -> m a
Reader.asks (a -> b
f (a -> b) -> (r -> a) -> r -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' k is r a -> r -> a
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
Optics.Core.view Optic' k is r a
l)
{-# INLINE views #-}

-- | Given a monadic argument, evaluate it in a context modified by applying
-- the provided function to the target of the provided 'Setter', 'Lens', or 'Traversal'.
locally ::
  ( Is k A_Setter,
    Has (Reader.Reader r) sig m
  ) =>
  Optic k is r r a b ->
  (a -> b) ->
  m c ->
  m c
locally :: Optic k is r r a b -> (a -> b) -> m c -> m c
locally Optic k is r r a b
l a -> b
f = (r -> r) -> m c -> m c
forall r (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Reader r) sig m =>
(r -> r) -> m a -> m a
Reader.local (Optic k is r r a b -> (a -> b) -> r -> r
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic k is r r a b
l a -> b
f)

-- | Use the target of a 'Lens', 'Iso', or 'Getter' in the current state.
use ::
  forall s a m sig k is.
  ( Is k A_Getter,
    Has (State.State s) sig m
  ) =>
  Optic' k is s a ->
  m a
use :: Optic' k is s a -> m a
use Optic' k is s a
l = (s -> a) -> m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> a) -> m a
State.gets (Optic' k is s a -> s -> a
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
Optics.Core.view Optic' k is s a
l)
{-# INLINE use #-}

-- | Apply a function to the target of a 'Lens', 'Iso', or 'Getter' in the current state.
uses ::
  forall s a b m sig k is.
  ( Is k A_Getter,
    Has (State.State s) sig m
  ) =>
  Optic' k is s a ->
  (a -> b) ->
  m b
uses :: Optic' k is s a -> (a -> b) -> m b
uses Optic' k is s a
l a -> b
f = (s -> b) -> m b
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> a) -> m a
State.gets (a -> b
f (a -> b) -> (s -> a) -> s -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' k is s a -> s -> a
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
Optics.Core.view Optic' k is s a
l)
{-# INLINE uses #-}

-- | Use the target of a 'AffineTraversal' or 'AffineFold' in the current state.
preuse ::
  forall s a m sig k is.
  ( Is k An_AffineFold,
    Has (State.State s) sig m
  ) =>
  Optic' k is s a ->
  m (Maybe a)
preuse :: Optic' k is s a -> m (Maybe a)
preuse Optic' k is s a
l = (s -> Maybe a) -> m (Maybe a)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> a) -> m a
State.gets (Optic' k is s a -> s -> Maybe a
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' k is s a
l)
{-# INLINE preuse #-}

-- | Replace the target(s) of an Optic in our monadic state with a new value, irrespective of the old.
-- The action and the optic operation are applied strictly.
--
-- This is aprefix form of '.='.
assign ::
  forall s a b m sig k is.
  ( Is k A_Setter,
    Has (State.State s) sig m
  ) =>
  Optic k is s s a b ->
  b ->
  m ()
assign :: Optic k is s s a b -> b -> m ()
assign Optic k is s s a b
l b
x = (s -> s) -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
State.modify (Optic k is s s a b -> b -> s -> s
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set' Optic k is s s a b
l b
x)
{-# INLINE assign #-}

-- | Map over the target(s) of an 'Optic' in our monadic state.
-- The action and the optic operation are applied strictly.
modifying ::
  ( Is k A_Setter,
    Has (State.State s) sig m
  ) =>
  Optic k is s s a b ->
  (a -> b) ->
  m ()
modifying :: Optic k is s s a b -> (a -> b) -> m ()
modifying Optic k is s s a b
l a -> b
x = (s -> s) -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
State.modify (Optic k is s s a b -> (a -> b) -> s -> s
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over' Optic k is s s a b
l a -> b
x)
{-# INLINE modifying #-}

-- * Operators

infix 4 .=

infix 4 ?=

infix 4 %=

-- | Replace the target(s) of an Optic in our monadic state with a new value, irrespective of the old.
-- The action and the optic operation are applied strictly.
--
-- This is an infix form of 'assign'.
(.=) ::
  forall s a b m sig k is.
  ( Is k A_Setter,
    Has (State.State s) sig m
  ) =>
  Optic k is s s a b ->
  b ->
  m ()
.= :: Optic k is s s a b -> b -> m ()
(.=) = Optic k is s s a b -> b -> m ()
forall s a b (m :: * -> *) (sig :: (* -> *) -> * -> *) k
       (is :: IxList).
(Is k A_Setter, Has (State s) sig m) =>
Optic k is s s a b -> b -> m ()
assign
{-# INLINE (.=) #-}

-- | Replace the target(s) of an Optic in our monadic state with 'Just' a new value, irrespective of the old.
-- The action and the optic operation are applied strictly.
(?=) ::
  forall s a b m sig k is.
  ( Is k A_Setter,
    Has (State.State s) sig m
  ) =>
  Optic k is s s a (Maybe b) ->
  b ->
  m ()
Optic k is s s a (Maybe b)
l ?= :: Optic k is s s a (Maybe b) -> b -> m ()
?= b
a = (s -> s) -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
State.modify (Optic k is s s a (Maybe b) -> Maybe b -> s -> s
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic k is s s a (Maybe b)
l (b -> Maybe b
forall a. a -> Maybe a
Just b
a))
{-# INLINE (?=) #-}

-- | Map over the target(s) of an 'Optic' in our monadic state.
-- The action and the optic operation are applied strictly.
(%=) ::
  ( Is k A_Setter,
    Has (State.State s) sig m
  ) =>
  Optic k is s s a b ->
  (a -> b) ->
  m ()
%= :: Optic k is s s a b -> (a -> b) -> m ()
(%=) = Optic k is s s a b -> (a -> b) -> m ()
forall k s (sig :: (* -> *) -> * -> *) (m :: * -> *) (is :: IxList)
       a b.
(Is k A_Setter, Has (State s) sig m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying
{-# INLINE (%=) #-}

-- | Run the provided monadic action and assign it to the target of a 'Setter'.
(<~) :: (Is k A_Setter, Has (State s) sig m) => Optic k is s s a b -> m b -> m ()
Optic k is s s a b
l <~ :: Optic k is s s a b -> m b -> m ()
<~ m b
mb = m b
mb m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Optic k is s s a b -> b -> m ()
forall s a b (m :: * -> *) (sig :: (* -> *) -> * -> *) k
       (is :: IxList).
(Is k A_Setter, Has (State s) sig m) =>
Optic k is s s a b -> b -> m ()
assign Optic k is s s a b
l