module Gamgine.Lens.State where
#include "Gamgine/Utils.cpp"
IMPORT_LENS_AS_LE

import Control.Applicative ((<$>))
import qualified Control.Monad.State as ST

-- | apply the getter lens on the value of the state 
getL :: Monad m => LE.Lens a b -> ST.StateT a m b
getL :: forall (m :: * -> *) a b. Monad m => Lens a b -> StateT a m b
getL Lens a b
lens = (a -> b) -> StateT a m b
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
ST.gets ((a -> b) -> StateT a m b) -> (a -> b) -> StateT a m b
forall a b. (a -> b) -> a -> b
$ Lens a b -> a -> b
forall a b. Lens a b -> a -> b
LE.getL Lens a b
lens
  

-- | apply the setter of the lens on the value of the state
setL :: Monad m => LE.Lens a b -> b -> ST.StateT a m ()
setL :: forall (m :: * -> *) a b. Monad m => Lens a b -> b -> StateT a m ()
setL Lens a b
lens b
value = (a -> a) -> StateT a m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify ((a -> a) -> StateT a m ()) -> (a -> a) -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ Lens a b -> b -> a -> a
forall a b. Lens a b -> b -> a -> a
LE.setL Lens a b
lens b
value

-- | modify the value of the state with a lens
modL :: Monad m => LE.Lens a b -> (b -> b) -> ST.StateT a m ()
modL :: forall (m :: * -> *) a b.
Monad m =>
Lens a b -> (b -> b) -> StateT a m ()
modL Lens a b
lens b -> b
f =  (a -> a) -> StateT a m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify ((a -> a) -> StateT a m ()) -> (a -> a) -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ Lens a b -> (b -> b) -> a -> a
forall a b. Lens a b -> (b -> b) -> a -> a
LE.modL Lens a b
lens b -> b
f