    {-# LANGUAGE CPP #-}
    {-# OPTIONS_HADDOCK hide #-}
    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.OpenGL.GL.IOState
    -- Copyright   :  (c) Sven Panne 2002-2019
    -- License     :  BSD3
    --
    -- Maintainer  :  Sven Panne <svenpanne@gmail.com>
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- This is a purely internal module for an IO monad with a pointer as an
    -- additional state, basically a /StateT (Ptr s) IO a/.
    --
    --------------------------------------------------------------------------------

    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, 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 ; runIOState (k a) 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 <- IOState a (Ptr a)
    forall s. IOState s (Ptr s)
    getIOState
       x <- liftIOState $ peek ptr
       putIOState (ptr `plusPtr` sizeOf x)
       return 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 <- IO a
    m ; return (a, 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, _) <- 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 ; return 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)