musicScroll-0.3.3: src/MusicScroll/RealMain.hs

{-# 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 = do
  appCtxTMvar <- atomically newEmptyTMVar
  suplTVar <- atomically (newTVar Nothing)
  uiCallbackTB <- atomically (newTBQueue 5)
  withAsyncBound (uiThread appCtxTMvar uiCallbackTB suplTVar) $ \uiA -> do
    (trackin, errorin, singleProd, trackout, errorout) <- musicSpawn
    withAsync (dbusThread trackout errorout) $ \dbusA -> do
      dbPath <- getDBPath
      bracket (open dbPath) close $ \conn -> do
        execute_ conn sqlDBCreate
        mconn <- newMVar conn
        ctx <- atomically (takeTMVar appCtxTMvar)
        let state = AppState ctx mconn suplTVar (trackin, errorin) singleProd
        let evState = EventLoopState state uiCallbackTB Nothing
        withAsync (staticPipeline state) $ \staticA ->
          withAsync (eventLoop evState) $ \evLoopA ->
            void $ waitAnyCancel [staticA, evLoopA, uiA, dbusA]