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

import Control.Applicative ((<$>))
import Control.Monad (void)
import qualified Control.Monad.State as ST
import qualified Data.IORef as R

type StateIORef a = ST.StateT (R.IORef a) IO 

-- | map a function on the value of the IORef
mapIORef :: R.IORef a -> (a -> b) -> IO b
mapIORef :: forall a b. IORef a -> (a -> b) -> IO b
mapIORef IORef a
ref a -> b
f = a -> b
f (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef a -> IO a
forall a. IORef a -> IO a
R.readIORef IORef a
ref


{- functions to operate on the value of a IORef inside of a State -}

-- | get the value of the IORef inside of the State
get :: StateIORef a a
get :: forall a. StateIORef a a
get = do
   IORef a
ref <- StateT (IORef a) IO (IORef a)
forall s (m :: * -> *). MonadState s m => m s
ST.get
   IO a -> StateIORef a a
forall a. IO a -> StateT (IORef a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
ST.liftIO (IO a -> StateIORef a a) -> IO a -> StateIORef a a
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
R.readIORef IORef a
ref

-- | apply a function on the value of the IORef
gets :: (a -> b) -> StateIORef a b
gets :: forall a b. (a -> b) -> StateIORef a b
gets a -> b
f = do
   IORef a
ref <- StateT (IORef a) IO (IORef a)
forall s (m :: * -> *). MonadState s m => m s
ST.get
   IO b -> StateIORef a b
forall a. IO a -> StateT (IORef a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
ST.liftIO (IO b -> StateIORef a b) -> IO b -> StateIORef a b
forall a b. (a -> b) -> a -> b
$ IORef a -> (a -> b) -> IO b
forall a b. IORef a -> (a -> b) -> IO b
mapIORef IORef a
ref a -> b
f

-- | apply the getter lens on the value of the IORef inside of the State
getsL :: LE.Lens a b -> StateIORef a b
getsL :: forall a b. Lens a b -> StateIORef a b
getsL Lens a b
lens = do
   IORef a
ref <- StateT (IORef a) IO (IORef a)
forall s (m :: * -> *). MonadState s m => m s
ST.get
   IO b -> StateIORef a b
forall a. IO a -> StateT (IORef a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
ST.liftIO (IO b -> StateIORef a b) -> IO b -> StateIORef a b
forall a b. (a -> b) -> a -> b
$ IORef a -> Lens a b -> IO b
forall a b. IORef a -> Lens a b -> IO b
getL IORef a
ref Lens a b
lens

-- | set the value of the IORef inside of the State
put :: a -> StateIORef a ()
put :: forall a. a -> StateIORef a ()
put a
value = do
   IORef a
ref <- StateT (IORef a) IO (IORef a)
forall s (m :: * -> *). MonadState s m => m s
ST.get
   IO () -> StateIORef a ()
forall a. IO a -> StateT (IORef a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
ST.liftIO (IO () -> StateIORef a ()) -> IO () -> StateIORef a ()
forall a b. (a -> b) -> a -> b
$ IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
R.writeIORef IORef a
ref a
value

-- | put a value 
putL :: LE.Lens a b -> b -> StateIORef a ()
putL :: forall a b. Lens a b -> b -> StateIORef a ()
putL Lens a b
lens b
value = do
   IORef a
ref <- StateT (IORef a) IO (IORef a)
forall s (m :: * -> *). MonadState s m => m s
ST.get
   StateIORef a () -> StateIORef a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateIORef a () -> StateIORef a ())
-> StateIORef a () -> StateIORef a ()
forall a b. (a -> b) -> a -> b
$ IO () -> StateIORef a ()
forall a. IO a -> StateT (IORef a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
ST.liftIO (IO () -> StateIORef a ()) -> IO () -> StateIORef a ()
forall a b. (a -> b) -> a -> b
$ IORef a -> Lens a b -> b -> IO ()
forall a b. IORef a -> Lens a b -> b -> IO ()
setL IORef a
ref Lens a b
lens b
value

-- | modify the value of the IORef inside of the State with a lens
modify :: (a -> a) -> StateIORef a ()
modify :: forall a. (a -> a) -> StateIORef a ()
modify a -> a
f = do
   IORef a
ref <- StateT (IORef a) IO (IORef a)
forall s (m :: * -> *). MonadState s m => m s
ST.get
   IO () -> StateIORef a ()
forall a. IO a -> StateT (IORef a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
ST.liftIO (IO () -> StateIORef a ()) -> IO () -> StateIORef a ()
forall a b. (a -> b) -> a -> b
$ IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef IORef a
ref a -> a
f

-- | modify the value of the IORef inside of the State with a lens
modifyL :: LE.Lens a b -> (b -> b) -> StateIORef a ()
modifyL :: forall a b. Lens a b -> (b -> b) -> StateIORef a ()
modifyL Lens a b
lens b -> b
f = do
   IORef a
ref <- StateT (IORef a) IO (IORef a)
forall s (m :: * -> *). MonadState s m => m s
ST.get
   IO () -> StateIORef a ()
forall a. IO a -> StateT (IORef a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
ST.liftIO (IO () -> StateIORef a ()) -> IO () -> StateIORef a ()
forall a b. (a -> b) -> a -> b
$ IORef a -> Lens a b -> (b -> b) -> IO ()
forall a b. IORef a -> Lens a b -> (b -> b) -> IO ()
modL IORef a
ref Lens a b
lens b -> b
f


{- functions to apply a lens to the value of a IORef -}

-- | apply the getter of the lens on the value of the IORef  
getL :: R.IORef a -> LE.Lens a b -> IO b
getL :: forall a b. IORef a -> Lens a b -> IO b
getL IORef a
ref Lens a b
lens = IORef a -> (a -> b) -> IO b
forall a b. IORef a -> (a -> b) -> IO b
mapIORef IORef a
ref ((a -> b) -> IO b) -> (a -> b) -> IO 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 IORef  
setL :: R.IORef a -> LE.Lens a b -> b -> IO ()
setL :: forall a b. IORef a -> Lens a b -> b -> IO ()
setL IORef a
ref Lens a b
lens b
value = IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef IORef a
ref ((a -> a) -> IO ()) -> (a -> a) -> IO ()
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 IORef with a lens
modL :: R.IORef a -> LE.Lens a b -> (b -> b) -> IO ()
modL :: forall a b. IORef a -> Lens a b -> (b -> b) -> IO ()
modL IORef a
ref Lens a b
lens b -> b
f = IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef IORef a
ref ((a -> a) -> IO ()) -> (a -> a) -> IO ()
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