{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
module Graphics.Rendering.OpenGL.GL.IOState (
IOState(..), getIOState, peekIOState, evalIOState, nTimes
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ( Applicative(..) )
#endif
import Control.Monad ( ap, liftM, replicateM )
import Foreign.Ptr ( Ptr, plusPtr )
import Foreign.Storable ( Storable(sizeOf,peek) )
newtype IOState s a = IOState { forall s a. IOState s a -> Ptr s -> IO (a, Ptr s)
runIOState :: Ptr s -> IO (a, Ptr s) }
instance Applicative (IOState s) where
pure :: forall a. a -> IOState s a
pure = a -> IOState s a
forall a. a -> IOState s a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. IOState s (a -> b) -> IOState s a -> IOState s b
(<*>) = IOState s (a -> b) -> IOState s a -> IOState s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Functor (IOState s) where
fmap :: forall a b. (a -> b) -> IOState s a -> IOState s b
fmap = (a -> b) -> IOState s a -> IOState s b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Monad (IOState s) where
return :: forall a. a -> IOState s a
return a
a = (Ptr s -> IO (a, Ptr s)) -> IOState s a
forall s a. (Ptr s -> IO (a, Ptr s)) -> IOState s a
IOState ((Ptr s -> IO (a, Ptr s)) -> IOState s a)
-> (Ptr s -> IO (a, Ptr s)) -> IOState s a
forall a b. (a -> b) -> a -> b
$ \Ptr s
s -> (a, Ptr s) -> IO (a, Ptr s)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Ptr s
s)
IOState s a
m >>= :: forall a b. IOState s a -> (a -> IOState s b) -> IOState s b
>>= a -> IOState s b
k = (Ptr s -> IO (b, Ptr s)) -> IOState s b
forall s a. (Ptr s -> IO (a, Ptr s)) -> IOState s a
IOState ((Ptr s -> IO (b, Ptr s)) -> IOState s b)
-> (Ptr s -> IO (b, Ptr s)) -> IOState s b
forall a b. (a -> b) -> a -> b
$ \Ptr s
s -> do (a
a, Ptr s
s') <- IOState s a -> Ptr s -> IO (a, Ptr s)
forall s a. IOState s a -> Ptr s -> IO (a, Ptr s)
runIOState IOState s a
m Ptr s
s ; IOState s b -> Ptr s -> IO (b, Ptr s)
forall s a. IOState s a -> Ptr s -> IO (a, Ptr s)
runIOState (a -> IOState s b
k a
a) Ptr s
s'
#if MIN_VERSION_base(4,13,0)
instance MonadFail (IOState s) where
#endif
fail :: forall a. String -> IOState s a
fail String
str = (Ptr s -> IO (a, Ptr s)) -> IOState s a
forall s a. (Ptr s -> IO (a, Ptr s)) -> IOState s a
IOState ((Ptr s -> IO (a, Ptr s)) -> IOState s a)
-> (Ptr s -> IO (a, Ptr s)) -> IOState s a
forall a b. (a -> b) -> a -> b
$ \Ptr s
_ -> String -> IO (a, Ptr s)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
str
getIOState :: IOState s (Ptr s)
getIOState :: forall s. IOState s (Ptr s)
getIOState = (Ptr s -> IO (Ptr s, Ptr s)) -> IOState s (Ptr s)
forall s a. (Ptr s -> IO (a, Ptr s)) -> IOState s a
IOState ((Ptr s -> IO (Ptr s, Ptr s)) -> IOState s (Ptr s))
-> (Ptr s -> IO (Ptr s, Ptr s)) -> IOState s (Ptr s)
forall a b. (a -> b) -> a -> b
$ \Ptr s
s -> (Ptr s, Ptr s) -> IO (Ptr s, Ptr s)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr s
s, Ptr s
s)
putIOState :: Ptr s -> IOState s ()
putIOState :: forall s. Ptr s -> IOState s ()
putIOState Ptr s
s = (Ptr s -> IO ((), Ptr s)) -> IOState s ()
forall s a. (Ptr s -> IO (a, Ptr s)) -> IOState s a
IOState ((Ptr s -> IO ((), Ptr s)) -> IOState s ())
-> (Ptr s -> IO ((), Ptr s)) -> IOState s ()
forall a b. (a -> b) -> a -> b
$ \Ptr s
_ -> ((), Ptr s) -> IO ((), Ptr s)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), Ptr s
s)
peekIOState :: Storable a => IOState a a
peekIOState :: forall a. Storable a => IOState a a
peekIOState = do
Ptr a
ptr <- IOState a (Ptr a)
forall s. IOState s (Ptr s)
getIOState
a
x <- IO a -> IOState a a
forall a s. IO a -> IOState s a
liftIOState (IO a -> IOState a a) -> IO a -> IOState a a
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
Ptr a -> IOState a ()
forall s. Ptr s -> IOState s ()
putIOState (Ptr a
ptr Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf a
x)
a -> IOState a a
forall a. a -> IOState a a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
liftIOState :: IO a -> IOState s a
liftIOState :: forall a s. IO a -> IOState s a
liftIOState IO a
m = (Ptr s -> IO (a, Ptr s)) -> IOState s a
forall s a. (Ptr s -> IO (a, Ptr s)) -> IOState s a
IOState ((Ptr s -> IO (a, Ptr s)) -> IOState s a)
-> (Ptr s -> IO (a, Ptr s)) -> IOState s a
forall a b. (a -> b) -> a -> b
$ \Ptr s
s -> do a
a <- IO a
m ; (a, Ptr s) -> IO (a, Ptr s)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Ptr s
s)
evalIOState :: IOState s a -> Ptr s -> IO a
evalIOState :: forall s a. IOState s a -> Ptr s -> IO a
evalIOState IOState s a
m Ptr s
s = do (a
a, Ptr s
_) <- IOState s a -> Ptr s -> IO (a, Ptr s)
forall s a. IOState s a -> Ptr s -> IO (a, Ptr s)
runIOState IOState s a
m Ptr s
s ; a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
nTimes :: Integral a => a -> IOState b c -> IOState b [c]
nTimes :: forall a b c. Integral a => a -> IOState b c -> IOState b [c]
nTimes a
n = Int -> IOState b c -> IOState b [c]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)