{-# LANGUAGE RankNTypes #-}

module Nes.Render.Monad (
    -- * Monad
    Render (..),
    RenderStep (..),
    runRender,
    withFrameState,
    modifyFrameState,
    (>>=),
    (>>),
    return,

    -- * Operations
    whenR,
    liftIO,
    unsafeStep,
    unsafeCastRender,
    toSDL2ByteString,
) where

import qualified Control.Monad as IO
import Data.ByteString.Internal
import Foreign (castForeignPtr)
import Nes.Render.Frame
import Prelude hiding (return, (>>), (>>=))

data RenderStep = DirtyFrame | BGDrawn | BGAndSpritesDrawn | Renderable | Rendered deriving (RenderStep -> RenderStep -> Bool
(RenderStep -> RenderStep -> Bool)
-> (RenderStep -> RenderStep -> Bool) -> Eq RenderStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenderStep -> RenderStep -> Bool
== :: RenderStep -> RenderStep -> Bool
$c/= :: RenderStep -> RenderStep -> Bool
/= :: RenderStep -> RenderStep -> Bool
Eq)

-- | An operation that updates a 'FrameStep'
newtype Render (s0 :: RenderStep) (s1 :: RenderStep) r a = MkRender {forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
Render s0 s1 r a -> FrameState -> (FrameState -> a -> IO r) -> IO r
unRender :: FrameState -> (FrameState -> a -> IO r) -> IO r} deriving ((forall a b. (a -> b) -> Render s0 s1 r a -> Render s0 s1 r b)
-> (forall a b. a -> Render s0 s1 r b -> Render s0 s1 r a)
-> Functor (Render s0 s1 r)
forall a b. a -> Render s0 s1 r b -> Render s0 s1 r a
forall a b. (a -> b) -> Render s0 s1 r a -> Render s0 s1 r b
forall (s0 :: RenderStep) (s1 :: RenderStep) r a b.
a -> Render s0 s1 r b -> Render s0 s1 r a
forall (s0 :: RenderStep) (s1 :: RenderStep) r a b.
(a -> b) -> Render s0 s1 r a -> Render s0 s1 r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (s0 :: RenderStep) (s1 :: RenderStep) r a b.
(a -> b) -> Render s0 s1 r a -> Render s0 s1 r b
fmap :: forall a b. (a -> b) -> Render s0 s1 r a -> Render s0 s1 r b
$c<$ :: forall (s0 :: RenderStep) (s1 :: RenderStep) r a b.
a -> Render s0 s1 r b -> Render s0 s1 r a
<$ :: forall a b. a -> Render s0 s1 r b -> Render s0 s1 r a
Functor)

instance Applicative (Render s0 s1 r) where
    pure :: forall a. a -> Render s0 s1 r a
pure a
a = (FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> a -> IO r) -> IO r)
 -> Render s0 s1 r a)
-> (FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> a -> IO r
cont -> FrameState -> a -> IO r
cont FrameState
st a
a
    liftA2 :: forall a b c.
(a -> b -> c)
-> Render s0 s1 r a -> Render s0 s1 r b -> Render s0 s1 r c
liftA2 a -> b -> c
f (MkRender FrameState -> (FrameState -> a -> IO r) -> IO r
a) (MkRender FrameState -> (FrameState -> b -> IO r) -> IO r
b) = (FrameState -> (FrameState -> c -> IO r) -> IO r)
-> Render s0 s1 r c
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> c -> IO r) -> IO r)
 -> Render s0 s1 r c)
-> (FrameState -> (FrameState -> c -> IO r) -> IO r)
-> Render s0 s1 r c
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> c -> IO r
cont ->
        FrameState -> (FrameState -> a -> IO r) -> IO r
a FrameState
st ((FrameState -> a -> IO r) -> IO r)
-> (FrameState -> a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \FrameState
st' a
a' ->
            FrameState -> (FrameState -> b -> IO r) -> IO r
b FrameState
st' ((FrameState -> b -> IO r) -> IO r)
-> (FrameState -> b -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \FrameState
st'' b
b' ->
                FrameState -> c -> IO r
cont FrameState
st'' (a -> b -> c
f a
a' b
b')

{-# INLINE runRender #-}
runRender :: Render DirtyFrame Rendered r r -> FrameState -> IO r
runRender :: forall r. Render 'DirtyFrame 'Rendered r r -> FrameState -> IO r
runRender (MkRender FrameState -> (FrameState -> r -> IO r) -> IO r
f) FrameState
st = FrameState -> (FrameState -> r -> IO r) -> IO r
f FrameState
st ((FrameState -> r -> IO r) -> IO r)
-> (FrameState -> r -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \FrameState
_ r
res -> r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
res

{-# INLINE withFrameState #-}
withFrameState :: (FrameState -> IO a) -> Render b b r a
withFrameState :: forall a (b :: RenderStep) r.
(FrameState -> IO a) -> Render b b r a
withFrameState FrameState -> IO a
f = (FrameState -> (FrameState -> a -> IO r) -> IO r) -> Render b b r a
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> a -> IO r) -> IO r)
 -> Render b b r a)
-> (FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render b b r a
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> a -> IO r
cont -> FrameState -> IO a
f FrameState
st IO a -> (a -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
IO.>>= \(!a
i) -> FrameState -> a -> IO r
cont FrameState
st a
i

{-# INLINE modifyFrameState #-}
modifyFrameState :: (FrameState -> FrameState) -> Render b b r ()
modifyFrameState :: forall (b :: RenderStep) r.
(FrameState -> FrameState) -> Render b b r ()
modifyFrameState FrameState -> FrameState
f = (FrameState -> (FrameState -> () -> IO r) -> IO r)
-> Render b b r ()
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> () -> IO r) -> IO r)
 -> Render b b r ())
-> (FrameState -> (FrameState -> () -> IO r) -> IO r)
-> Render b b r ()
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> () -> IO r
cont -> FrameState -> () -> IO r
cont (FrameState -> FrameState
f FrameState
st) ()

{-# INLINE toSDL2ByteString #-}
toSDL2ByteString :: Render Rendered Rendered r ByteString
toSDL2ByteString :: forall r. Render 'Rendered 'Rendered r ByteString
toSDL2ByteString = (FrameState -> (FrameState -> ByteString -> IO r) -> IO r)
-> Render 'Rendered 'Rendered r ByteString
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> ByteString -> IO r) -> IO r)
 -> Render 'Rendered 'Rendered r ByteString)
-> (FrameState -> (FrameState -> ByteString -> IO r) -> IO r)
-> Render 'Rendered 'Rendered r ByteString
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> ByteString -> IO r
cont -> FrameState -> ByteString -> IO r
cont FrameState
st (ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr () -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr () -> ForeignPtr Word8)
-> ForeignPtr () -> ForeignPtr Word8
forall a b. (a -> b) -> a -> b
$ FrameState -> ForeignPtr ()
sdl2Frame FrameState
st) Int
frameLength)

{-# INLINE liftIO #-}
liftIO :: IO a -> Render b b r a
liftIO :: forall a (b :: RenderStep) r. IO a -> Render b b r a
liftIO IO a
io = (FrameState -> (FrameState -> a -> IO r) -> IO r) -> Render b b r a
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> a -> IO r) -> IO r)
 -> Render b b r a)
-> (FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render b b r a
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> a -> IO r
cont -> IO a
io IO a -> (a -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
IO.>>= \(!a
i) -> FrameState -> a -> IO r
cont FrameState
st a
i

{-# INLINE whenR #-}
whenR :: Bool -> Render a a r () -> Render a a r ()
whenR :: forall (a :: RenderStep) r.
Bool -> Render a a r () -> Render a a r ()
whenR Bool
cond (MkRender FrameState -> (FrameState -> () -> IO r) -> IO r
f) = (FrameState -> (FrameState -> () -> IO r) -> IO r)
-> Render a a r ()
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> () -> IO r) -> IO r)
 -> Render a a r ())
-> (FrameState -> (FrameState -> () -> IO r) -> IO r)
-> Render a a r ()
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> () -> IO r
cont -> if Bool
cond then FrameState -> (FrameState -> () -> IO r) -> IO r
f FrameState
st FrameState -> () -> IO r
cont else FrameState -> () -> IO r
cont FrameState
st ()

{-# INLINE unsafeCastRender #-}
unsafeCastRender :: Render a b r c -> Render a' b' r c
unsafeCastRender :: forall (a :: RenderStep) (b :: RenderStep) r c (a' :: RenderStep)
       (b' :: RenderStep).
Render a b r c -> Render a' b' r c
unsafeCastRender (MkRender FrameState -> (FrameState -> c -> IO r) -> IO r
f) = (FrameState -> (FrameState -> c -> IO r) -> IO r)
-> Render a' b' r c
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender FrameState -> (FrameState -> c -> IO r) -> IO r
f

{-# INLINE unsafeStep #-}
unsafeStep :: forall b a r. Render a b r ()
unsafeStep :: forall (b :: RenderStep) (a :: RenderStep) r. Render a b r ()
unsafeStep = (FrameState -> (FrameState -> () -> IO r) -> IO r)
-> Render a b r ()
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> () -> IO r) -> IO r)
 -> Render a b r ())
-> (FrameState -> (FrameState -> () -> IO r) -> IO r)
-> Render a b r ()
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> () -> IO r
cont -> FrameState -> () -> IO r
cont FrameState
st ()

{-# INLINE (>>=) #-}
(>>=) :: Render a b r s -> (s -> Render b c r s') -> Render a c r s'
(MkRender FrameState -> (FrameState -> s -> IO r) -> IO r
f) >>= :: forall (a :: RenderStep) (b :: RenderStep) r s (c :: RenderStep)
       s'.
Render a b r s -> (s -> Render b c r s') -> Render a c r s'
>>= s -> Render b c r s'
f' = (FrameState -> (FrameState -> s' -> IO r) -> IO r)
-> Render a c r s'
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> s' -> IO r) -> IO r)
 -> Render a c r s')
-> (FrameState -> (FrameState -> s' -> IO r) -> IO r)
-> Render a c r s'
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> s' -> IO r
cont -> FrameState -> (FrameState -> s -> IO r) -> IO r
f FrameState
st ((FrameState -> s -> IO r) -> IO r)
-> (FrameState -> s -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \FrameState
st' !s
s -> Render b c r s' -> FrameState -> (FrameState -> s' -> IO r) -> IO r
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
Render s0 s1 r a -> FrameState -> (FrameState -> a -> IO r) -> IO r
unRender (s -> Render b c r s'
f' s
s) FrameState
st' FrameState -> s' -> IO r
cont

{-# INLINE (>>) #-}
(>>) :: Render a b r s -> Render b c r s' -> Render a c r s'
(MkRender FrameState -> (FrameState -> s -> IO r) -> IO r
f) >> :: forall (a :: RenderStep) (b :: RenderStep) r s (c :: RenderStep)
       s'.
Render a b r s -> Render b c r s' -> Render a c r s'
>> Render b c r s'
f' = (FrameState -> (FrameState -> s' -> IO r) -> IO r)
-> Render a c r s'
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> s' -> IO r) -> IO r)
 -> Render a c r s')
-> (FrameState -> (FrameState -> s' -> IO r) -> IO r)
-> Render a c r s'
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> s' -> IO r
cont -> FrameState -> (FrameState -> s -> IO r) -> IO r
f FrameState
st ((FrameState -> s -> IO r) -> IO r)
-> (FrameState -> s -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \FrameState
st' !s
_ -> Render b c r s' -> FrameState -> (FrameState -> s' -> IO r) -> IO r
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
Render s0 s1 r a -> FrameState -> (FrameState -> a -> IO r) -> IO r
unRender Render b c r s'
f' FrameState
st' FrameState -> s' -> IO r
cont

{-# INLINE return #-}
return :: a -> Render b b r a
return :: forall a (b :: RenderStep) r. a -> Render b b r a
return a
a = (FrameState -> (FrameState -> a -> IO r) -> IO r) -> Render b b r a
forall (s0 :: RenderStep) (s1 :: RenderStep) r a.
(FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render s0 s1 r a
MkRender ((FrameState -> (FrameState -> a -> IO r) -> IO r)
 -> Render b b r a)
-> (FrameState -> (FrameState -> a -> IO r) -> IO r)
-> Render b b r a
forall a b. (a -> b) -> a -> b
$ \FrameState
st FrameState -> a -> IO r
cont -> FrameState -> a -> IO r
cont FrameState
st a
a