{-# LANGUAGE BlockArguments #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      :  Disco.Effects.State
-- Copyright   :  disco team and contributors
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Utility functions for state effect.
module Disco.Effects.State (
  module Polysemy.State,
  zoom,
  use,
  (%=),
  (.=),
)
where

import Control.Lens (Getter, Lens', view, (%~), (.~))

import Polysemy
import Polysemy.State

-- | Use a lens to zoom into a component of a state.
zoom :: forall s a r c. Member (State s) r => Lens' s a -> Sem (State a ': r) c -> Sem r c
zoom :: forall s a (r :: EffectRow) c.
Member (State s) r =>
Lens' s a -> Sem (State a : r) c -> Sem r c
zoom Lens' s a
l = forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  State a (Sem rInitial) x
Get -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' s a
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (r :: EffectRow). Member (State s) r => Sem r s
get
  Put a
a -> forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify (Lens' s a
l forall s t a b. ASetter s t a b -> b -> s -> t
.~ a
a)

use :: Member (State s) r => Getter s a -> Sem r a
use :: forall s (r :: EffectRow) a.
Member (State s) r =>
Getter s a -> Sem r a
use Getter s a
g = forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter s a
g)

infix 4 .=, %=

(.=) :: Member (State s) r => Lens' s a -> a -> Sem r ()
Lens' s a
l .= :: forall s (r :: EffectRow) a.
Member (State s) r =>
Lens' s a -> a -> Sem r ()
.= a
a = forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify (Lens' s a
l forall s t a b. ASetter s t a b -> b -> s -> t
.~ a
a)

(%=) :: Member (State s) r => Lens' s a -> (a -> a) -> Sem r ()
Lens' s a
l %= :: forall s (r :: EffectRow) a.
Member (State s) r =>
Lens' s a -> (a -> a) -> Sem r ()
%= a -> a
f = forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify (Lens' s a
l forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> a
f)