{-# LANGUAGE LambdaCase #-}

module MusicScroll.MPRIS (dbusThread) where

import Control.Exception (bracket)
import Control.Monad (forever)
import Control.Monad.Trans.State (StateT, evalStateT)
import DBus.Client
import MusicScroll.ConnState
import MusicScroll.DBusSignals
import MusicScroll.LyricsPipeline
import MusicScroll.TrackInfo
import Pipes as P
import Pipes.Concurrent

dbusThread :: Output TrackIdentifier -> Output ErrorCause -> IO a
dbusThread :: forall a. Output TrackIdentifier -> Output ErrorCause -> IO a
dbusThread Output TrackIdentifier
trackout Output ErrorCause
errorout =
  IO Client -> (Client -> IO ()) -> (Client -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    IO Client
connectSession
    Client -> IO ()
disconnect
    (StateT ConnState IO a -> ConnState -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT ConnState IO a
forall a. StateT ConnState IO a
loop (ConnState -> IO a) -> (Client -> ConnState) -> Client -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Client -> ConnState
newConnState)
  where
    loop :: StateT ConnState IO a
    loop :: forall a. StateT ConnState IO a
loop =
      StateT ConnState IO () -> StateT ConnState IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (StateT ConnState IO () -> StateT ConnState IO a)
-> StateT ConnState IO () -> StateT ConnState IO a
forall a b. (a -> b) -> a -> b
$
        StateT ConnState IO (Either DBusError TrackIdentifier)
forall (m :: * -> *).
(MonadState ConnState m, MonadIO m) =>
m (Either DBusError TrackIdentifier)
tryGetInfo StateT ConnState IO (Either DBusError TrackIdentifier)
-> (Either DBusError TrackIdentifier -> StateT ConnState IO ())
-> StateT ConnState IO ()
forall a b.
StateT ConnState IO a
-> (a -> StateT ConnState IO b) -> StateT ConnState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left (NoMusicClient MethodError
_) -> StateT ConnState IO ()
forall (m :: * -> *). (MonadState ConnState m, MonadIO m) => m ()
changeMusicClient
          Left DBusError
NoSong ->
            do
              Effect (StateT ConnState IO) () -> StateT ConnState IO ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Effect (StateT ConnState IO) () -> StateT ConnState IO ())
-> Effect (StateT ConnState IO) () -> StateT ConnState IO ()
forall a b. (a -> b) -> a -> b
$ ErrorCause -> Proxy X () () ErrorCause (StateT ConnState IO) ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield ErrorCause
ENoSong Proxy X () () ErrorCause (StateT ConnState IO) ()
-> Proxy () ErrorCause () X (StateT ConnState IO) ()
-> Effect (StateT ConnState IO) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Output ErrorCause -> Consumer' ErrorCause (StateT ConnState IO) ()
forall (m :: * -> *) a. MonadIO m => Output a -> Consumer' a m ()
toOutput Output ErrorCause
errorout
              MatchRule -> StateT ConnState IO ()
forall (m :: * -> *).
(MonadState ConnState m, MonadIO m) =>
MatchRule -> m ()
waitForChange MatchRule
mediaPropChangeRule
          Right TrackIdentifier
trackIdent ->
            do
              Effect (StateT ConnState IO) () -> StateT ConnState IO ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Effect (StateT ConnState IO) () -> StateT ConnState IO ())
-> Effect (StateT ConnState IO) () -> StateT ConnState IO ()
forall a b. (a -> b) -> a -> b
$ TrackIdentifier
-> Proxy X () () TrackIdentifier (StateT ConnState IO) ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield TrackIdentifier
trackIdent Proxy X () () TrackIdentifier (StateT ConnState IO) ()
-> Proxy () TrackIdentifier () X (StateT ConnState IO) ()
-> Effect (StateT ConnState IO) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Output TrackIdentifier
-> Consumer' TrackIdentifier (StateT ConnState IO) ()
forall (m :: * -> *) a. MonadIO m => Output a -> Consumer' a m ()
toOutput Output TrackIdentifier
trackout
              MatchRule -> StateT ConnState IO ()
forall (m :: * -> *).
(MonadState ConnState m, MonadIO m) =>
MatchRule -> m ()
waitForChange MatchRule
mediaPropChangeRule