module MusicScroll.EventLoop where

import Control.Concurrent.Async
import Control.Concurrent.STM
import Data.Foldable (traverse_)
import MusicScroll.Pipeline

-- | This callbacks ought to update the UI themselves via postGUI
type UICallback = AppState -> IO ()

data EventLoopState = EventLoopState
  { EventLoopState -> AppState
evAppState :: AppState,
    EventLoopState -> TBQueue UICallback
evUiCallbacks :: TBQueue UICallback,
    EventLoopState -> Maybe (Async ())
evEphemeral :: Maybe (Async ())
  }

eventLoop :: EventLoopState -> IO a
eventLoop :: forall a. EventLoopState -> IO a
eventLoop EventLoopState
st =
  do
    UICallback
newCallback <- STM UICallback -> IO UICallback
forall a. STM a -> IO a
atomically (STM UICallback -> IO UICallback)
-> (TBQueue UICallback -> STM UICallback)
-> TBQueue UICallback
-> IO UICallback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TBQueue UICallback -> STM UICallback
forall a. TBQueue a -> STM a
readTBQueue (TBQueue UICallback -> IO UICallback)
-> TBQueue UICallback -> IO UICallback
forall a b. (a -> b) -> a -> b
$ EventLoopState -> TBQueue UICallback
evUiCallbacks EventLoopState
st
    (Async () -> IO ()) -> Maybe (Async ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Async () -> IO ()
forall a. Async a -> IO ()
cancel (EventLoopState -> Maybe (Async ())
evEphemeral EventLoopState
st)
    Async ()
newAsync <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (UICallback
newCallback (EventLoopState -> AppState
evAppState EventLoopState
st))
    let st' :: EventLoopState
st' = EventLoopState
st {evEphemeral :: Maybe (Async ())
evEphemeral = Async () -> Maybe (Async ())
forall a. a -> Maybe a
Just Async ()
newAsync}
    EventLoopState -> IO a
forall a. EventLoopState -> IO a
eventLoop EventLoopState
st'