{-# LANGUAGE ScopedTypeVariables #-}

module MusicScroll.RealMain (realMain) where

import Control.Concurrent.Async (waitAnyCancel, withAsync, withAsyncBound)
import Control.Concurrent.MVar
import Control.Concurrent.STM.TBQueue (newTBQueue)
import Control.Concurrent.STM.TMVar
import Control.Concurrent.STM.TVar
import Control.Exception (bracket)
import Data.Functor (void)
import Database.SQLite.Simple
import MusicScroll.DatabaseUtils (getDBPath, sqlDBCreate)
import MusicScroll.EventLoop
import MusicScroll.MPRIS
import MusicScroll.Pipeline
import MusicScroll.UI
import Pipes.Concurrent

realMain :: IO ()
realMain :: IO ()
realMain = do
  TMVar UIContext
appCtxTMvar <- STM (TMVar UIContext) -> IO (TMVar UIContext)
forall a. STM a -> IO a
atomically STM (TMVar UIContext)
forall a. STM (TMVar a)
newEmptyTMVar
  TVar (Maybe TrackSuplement)
suplTVar <- STM (TVar (Maybe TrackSuplement))
-> IO (TVar (Maybe TrackSuplement))
forall a. STM a -> IO a
atomically (Maybe TrackSuplement -> STM (TVar (Maybe TrackSuplement))
forall a. a -> STM (TVar a)
newTVar Maybe TrackSuplement
forall a. Maybe a
Nothing)
  TBQueue UICallback
uiCallbackTB <- STM (TBQueue UICallback) -> IO (TBQueue UICallback)
forall a. STM a -> IO a
atomically (Natural -> STM (TBQueue UICallback)
forall a. Natural -> STM (TBQueue a)
newTBQueue Natural
5)
  IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsyncBound (TMVar UIContext
-> TBQueue UICallback -> TVar (Maybe TrackSuplement) -> IO ()
uiThread TMVar UIContext
appCtxTMvar TBQueue UICallback
uiCallbackTB TVar (Maybe TrackSuplement)
suplTVar) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
uiA -> do
    (Input TrackIdentifier
trackin, Input ErrorCause
errorin, Producer DBusSignal IO ()
singleProd, Output TrackIdentifier
trackout, Output ErrorCause
errorout) <- IO
  (Input TrackIdentifier, Input ErrorCause,
   Producer DBusSignal IO (), Output TrackIdentifier,
   Output ErrorCause)
musicSpawn
    IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (Output TrackIdentifier -> Output ErrorCause -> IO ()
forall a. Output TrackIdentifier -> Output ErrorCause -> IO a
dbusThread Output TrackIdentifier
trackout Output ErrorCause
errorout) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
dbusA -> do
      FilePath
dbPath <- IO FilePath
getDBPath
      IO Connection
-> (Connection -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IO Connection
open FilePath
dbPath) Connection -> IO ()
close ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
        Connection -> Query -> IO ()
execute_ Connection
conn Query
sqlDBCreate
        MVar Connection
mconn <- Connection -> IO (MVar Connection)
forall a. a -> IO (MVar a)
newMVar Connection
conn
        UIContext
ctx <- STM UIContext -> IO UIContext
forall a. STM a -> IO a
atomically (TMVar UIContext -> STM UIContext
forall a. TMVar a -> STM a
takeTMVar TMVar UIContext
appCtxTMvar)
        let state :: AppState
state = UIContext
-> MVar Connection
-> TVar (Maybe TrackSuplement)
-> (Input TrackIdentifier, Input ErrorCause)
-> Producer DBusSignal IO ()
-> AppState
AppState UIContext
ctx MVar Connection
mconn TVar (Maybe TrackSuplement)
suplTVar (Input TrackIdentifier
trackin, Input ErrorCause
errorin) Producer DBusSignal IO ()
singleProd
        let evState :: EventLoopState
evState = AppState
-> TBQueue UICallback -> Maybe (Async ()) -> EventLoopState
EventLoopState AppState
state TBQueue UICallback
uiCallbackTB Maybe (Async ())
forall a. Maybe a
Nothing
        IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (UICallback
staticPipeline AppState
state) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
staticA ->
          IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (EventLoopState -> IO ()
forall a. EventLoopState -> IO a
eventLoop EventLoopState
evState) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
evLoopA ->
            IO (Async (), ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async (), ()) -> IO ()) -> IO (Async (), ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Async ()] -> IO (Async (), ())
forall a. [Async a] -> IO (Async a, a)
waitAnyCancel [Async ()
staticA, Async ()
evLoopA, Async ()
uiA, Async ()
dbusA]