sdl-example-develmain.hs

-- |
-- Copyright:  (c) 2017 Ertugrul Söylemez
-- License:    BSD3
-- Maintainer: Ertugrul Söylemez <[email protected]>

module DevelMain (update) where

import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception
import Control.Monad
import Control.Monad.Codensity
import Control.Monad.IO.Class
import Main
import Rapid


cBracket :: IO a -> (a -> IO b) -> Codensity IO a
cBracket o c = Codensity (bracket o c)


cBracket_ :: IO a -> IO b -> Codensity IO a
cBracket_ o c = cBracket o (\_ -> c)


update :: IO ()
update =
    rapid 0 $ \r -> do
        sdlVar <- createRef r "sdl-var" newEmptyMVar

        startWith asyncBound r "sdl-win" . lowerCodensity $ do
            win <- newAppWindow
            actionVar <- liftIO newEmptyMVar
            cBracket_ (putMVar sdlVar (win, actionVar)) (takeMVar sdlVar)
            let go = join (takeMVar actionVar) >> go
            liftIO go

        restart r "sdl-app" $ do
            (win, actionVar) <- readMVar sdlVar
            mainWith win $ \c -> do
                resVar <- newEmptyMVar
                putMVar actionVar (c >>= putMVar resVar)
                takeMVar resVar