module Mpv.MpvResources where import Control.Concurrent.STM (TVar, newTVarIO) import Control.Concurrent.STM.TBMQueue (TBMQueue) import Data.Aeson (Value) import Network.Socket (Socket) import Polysemy.Conc (withAsync_) import Polysemy.Conc.Interpreter.Queue.TBM (withTBMQueue) import Mpv.Data.MpvError (MpvError) import Mpv.Data.MpvEvent (MpvEvent) import Mpv.Data.MpvProcessConfig (MpvProcessConfig) import Mpv.Data.MpvResources (InMessage, MpvResources (MpvResources), OutMessage, Requests (Requests)) import Mpv.Process (withMpvProcess, withTempSocketPath) import Mpv.Response (responseListener) import Mpv.Socket (withSocket) import Mpv.SocketQueues (withSocketQueues) withMpvSocket :: Members [Reader MpvProcessConfig, Resource, Time t d, Race, Embed IO, Final IO] r => (Either MpvError Socket -> Sem r a) -> Sem r a withMpvSocket :: forall t d (r :: [(* -> *) -> * -> *]) a. Members '[Reader MpvProcessConfig, Resource, Time t d, Race, Embed IO, Final IO] r => (Either MpvError Socket -> Sem r a) -> Sem r a withMpvSocket Either MpvError Socket -> Sem r a action = (Path Abs File -> Sem r a) -> Sem r a forall (r :: [(* -> *) -> * -> *]) a. Members '[Resource, Embed IO] r => (Path Abs File -> Sem r a) -> Sem r a withTempSocketPath \ Path Abs File socketPath -> Path Abs File -> (Either MpvError (Process () () ()) -> Sem r a) -> Sem r a forall (r :: [(* -> *) -> * -> *]) a. Members '[Reader MpvProcessConfig, Resource, Embed IO, Final IO] r => Path Abs File -> (Either MpvError (Process () () ()) -> Sem r a) -> Sem r a withMpvProcess Path Abs File socketPath \case Right Process () () () _ -> Path Abs File -> (Either MpvError Socket -> Sem r a) -> Sem r a forall t d (r :: [(* -> *) -> * -> *]) a. Members '[Resource, Race, Time t d, Embed IO] r => Path Abs File -> (Either MpvError Socket -> Sem r a) -> Sem r a withSocket Path Abs File socketPath Either MpvError Socket -> Sem r a action Left MpvError err -> Either MpvError Socket -> Sem r a action (MpvError -> Either MpvError Socket forall a b. a -> Either a b Left MpvError err) withIpcIO :: Members [Events t MpvEvent, Resource, Race, Async, Log, Embed IO, Final IO] r => (MpvResources Value -> Sem r a) -> Socket -> TBMQueue (OutMessage Value) -> TBMQueue (InMessage Value) -> TVar (Requests Value) -> Sem r a withIpcIO :: forall t (r :: [(* -> *) -> * -> *]) a. Members '[Events t MpvEvent, Resource, Race, Async, Log, Embed IO, Final IO] r => (MpvResources Value -> Sem r a) -> Socket -> TBMQueue (OutMessage Value) -> TBMQueue (InMessage Value) -> TVar (Requests Value) -> Sem r a withIpcIO MpvResources Value -> Sem r a action Socket socket TBMQueue (OutMessage Value) outQ TBMQueue (InMessage Value) inQ TVar (Requests Value) requests = MpvResources Value -> InterpretersFor '[Queue (InMessage Value), Queue (OutMessage Value)] r forall (r :: [(* -> *) -> * -> *]). Members '[Resource, Async, Race, Log, Embed IO] r => MpvResources Value -> InterpretersFor '[Queue (InMessage Value), Queue (OutMessage Value)] r withSocketQueues MpvResources Value res do TVar (Requests Value) -> Sem (AtomicState (Requests Value) : Queue (InMessage Value) : Queue (OutMessage Value) : r) a -> Sem (Queue (InMessage Value) : Queue (OutMessage Value) : r) a forall (r :: [(* -> *) -> * -> *]) s a. Member (Embed IO) r => TVar s -> Sem (AtomicState s : r) a -> Sem r a runAtomicStateTVar TVar (Requests Value) requests do Sem (AtomicState (Requests Value) : Queue (InMessage Value) : Queue (OutMessage Value) : r) () -> Sem (AtomicState (Requests Value) : Queue (InMessage Value) : Queue (OutMessage Value) : r) a -> Sem (AtomicState (Requests Value) : Queue (InMessage Value) : Queue (OutMessage Value) : r) a forall (r :: [(* -> *) -> * -> *]) b a. Members '[Resource, Race, Async] r => Sem r b -> Sem r a -> Sem r a withAsync_ Sem (AtomicState (Requests Value) : Queue (InMessage Value) : Queue (OutMessage Value) : r) () forall t (r :: [(* -> *) -> * -> *]). Members '[Events t MpvEvent, Queue (InMessage Value), AtomicState (Requests Value), Log, Embed IO] r => Sem r () responseListener do forall (index :: Nat) (inserted :: [(* -> *) -> * -> *]) (head :: [(* -> *) -> * -> *]) (oldTail :: [(* -> *) -> * -> *]) (tail :: [(* -> *) -> * -> *]) (old :: [(* -> *) -> * -> *]) (full :: [(* -> *) -> * -> *]) a. (ListOfLength index head, WhenStuck index InsertAtUnprovidedIndex, old ~ Append head oldTail, tail ~ Append inserted oldTail, full ~ Append head tail, InsertAtIndex index head tail oldTail full inserted) => Sem old a -> Sem full a insertAt @0 (MpvResources Value -> Sem r a action MpvResources Value res) where res :: MpvResources Value res = Socket -> TBMQueue (OutMessage Value) -> TBMQueue (InMessage Value) -> TVar (Requests Value) -> MpvResources Value forall fmt. Socket -> TBMQueue (OutMessage fmt) -> TBMQueue (InMessage fmt) -> TVar (Requests fmt) -> MpvResources fmt MpvResources Socket socket TBMQueue (OutMessage Value) outQ TBMQueue (InMessage Value) inQ TVar (Requests Value) requests withSTMResources :: Members [Resource, Embed IO] r => (TBMQueue (OutMessage fmt) -> TBMQueue (InMessage fmt) -> TVar (Requests Value) -> Sem r a) -> Sem r a withSTMResources :: forall (r :: [(* -> *) -> * -> *]) fmt a. Members '[Resource, Embed IO] r => (TBMQueue (OutMessage fmt) -> TBMQueue (InMessage fmt) -> TVar (Requests Value) -> Sem r a) -> Sem r a withSTMResources TBMQueue (OutMessage fmt) -> TBMQueue (InMessage fmt) -> TVar (Requests Value) -> Sem r a action = do TVar (Requests Value) reqs <- IO (TVar (Requests Value)) -> Sem r (TVar (Requests Value)) forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a. Member (Embed m) r => m a -> Sem r a embed (Requests Value -> IO (TVar (Requests Value)) forall a. a -> IO (TVar a) newTVarIO (RequestId -> Map RequestId (MVar (Either ResponseError Value)) -> Requests Value forall fmt. RequestId -> Map RequestId (MVar (Either ResponseError fmt)) -> Requests fmt Requests RequestId 0 Map RequestId (MVar (Either ResponseError Value)) forall a. Monoid a => a mempty)) Int -> (TBMQueue (OutMessage fmt) -> Sem r a) -> Sem r a forall d (r :: [(* -> *) -> * -> *]) a. Members '[Resource, Embed IO] r => Int -> (TBMQueue d -> Sem r a) -> Sem r a withTBMQueue Int 64 \ TBMQueue (OutMessage fmt) outQ -> Int -> (TBMQueue (InMessage fmt) -> Sem r a) -> Sem r a forall d (r :: [(* -> *) -> * -> *]) a. Members '[Resource, Embed IO] r => Int -> (TBMQueue d -> Sem r a) -> Sem r a withTBMQueue Int 64 \ TBMQueue (InMessage fmt) inQ -> TBMQueue (OutMessage fmt) -> TBMQueue (InMessage fmt) -> TVar (Requests Value) -> Sem r a action TBMQueue (OutMessage fmt) outQ TBMQueue (InMessage fmt) inQ TVar (Requests Value) reqs withMpvResources :: Members [Reader MpvProcessConfig, Events token MpvEvent] r => Members [Resource, Race, Async, Log, Time t d, Embed IO, Final IO] r => (Either MpvError (MpvResources Value) -> Sem r a) -> Sem r a withMpvResources :: forall token (r :: [(* -> *) -> * -> *]) t d a. (Members '[Reader MpvProcessConfig, Events token MpvEvent] r, Members '[Resource, Race, Async, Log, Time t d, Embed IO, Final IO] r) => (Either MpvError (MpvResources Value) -> Sem r a) -> Sem r a withMpvResources Either MpvError (MpvResources Value) -> Sem r a run = (Either MpvError Socket -> Sem r a) -> Sem r a forall t d (r :: [(* -> *) -> * -> *]) a. Members '[Reader MpvProcessConfig, Resource, Time t d, Race, Embed IO, Final IO] r => (Either MpvError Socket -> Sem r a) -> Sem r a withMpvSocket \case Right Socket socket -> (TBMQueue (OutMessage Value) -> TBMQueue (InMessage Value) -> TVar (Requests Value) -> Sem r a) -> Sem r a forall (r :: [(* -> *) -> * -> *]) fmt a. Members '[Resource, Embed IO] r => (TBMQueue (OutMessage fmt) -> TBMQueue (InMessage fmt) -> TVar (Requests Value) -> Sem r a) -> Sem r a withSTMResources ((MpvResources Value -> Sem r a) -> Socket -> TBMQueue (OutMessage Value) -> TBMQueue (InMessage Value) -> TVar (Requests Value) -> Sem r a forall t (r :: [(* -> *) -> * -> *]) a. Members '[Events t MpvEvent, Resource, Race, Async, Log, Embed IO, Final IO] r => (MpvResources Value -> Sem r a) -> Socket -> TBMQueue (OutMessage Value) -> TBMQueue (InMessage Value) -> TVar (Requests Value) -> Sem r a withIpcIO (Either MpvError (MpvResources Value) -> Sem r a run (Either MpvError (MpvResources Value) -> Sem r a) -> (MpvResources Value -> Either MpvError (MpvResources Value)) -> MpvResources Value -> Sem r a forall b c a. (b -> c) -> (a -> b) -> a -> c . MpvResources Value -> Either MpvError (MpvResources Value) forall a b. b -> Either a b Right) Socket socket) Left MpvError err -> Either MpvError (MpvResources Value) -> Sem r a run (MpvError -> Either MpvError (MpvResources Value) forall a b. a -> Either a b Left MpvError err)