{-# 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 :: Lens' s a -> Sem (State a : r) c -> Sem r c
zoom Lens' s a
l = (forall (rInitial :: EffectRow) x.
 State a (Sem rInitial) x -> Sem r x)
-> Sem (State a : r) c -> Sem r c
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   -> Getting a s a -> s -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a s a
Lens' s a
l (s -> x) -> Sem r s -> Sem r x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r s
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
  Put a -> (s -> s) -> Sem r ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify ((a -> Identity a) -> s -> Identity s
Lens' s a
l ((a -> Identity a) -> s -> Identity s) -> a -> s -> s
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 :: Getter s a -> Sem r a
use Getter s a
g = (s -> a) -> Sem r a
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets (Getting a s a -> s -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a s a
Getter s a
g)

infix 4 .=, %=

(.=) :: Member (State s) r => Lens' s a -> a -> Sem r ()
Lens' s a
l .= :: Lens' s a -> a -> Sem r ()
.= a
a = (s -> s) -> Sem r ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify ((a -> Identity a) -> s -> Identity s
Lens' s a
l ((a -> Identity a) -> s -> Identity s) -> a -> s -> s
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 %= :: Lens' s a -> (a -> a) -> Sem r ()
%= a -> a
f = (s -> s) -> Sem r ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify ((a -> Identity a) -> s -> Identity s
Lens' s a
l ((a -> Identity a) -> s -> Identity s) -> (a -> a) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> a
f)