module Mpv.Interpreter.Mpv where

import Data.Aeson (Value)
import Polysemy.Conc (ChanConsumer, interpretEventsChan)
import Polysemy.Conc.Effect.Events (Consume)
import Polysemy.Conc.Interpreter.Scoped (runScoped)

import qualified Mpv.Data.Command as Command
import Mpv.Data.Command (Command)
import Mpv.Data.EventName (EventName (EndFile, FileLoaded))
import Mpv.Data.MpvError (MpvError)
import Mpv.Data.MpvEvent (MpvEvent)
import Mpv.Data.MpvProcessConfig (MpvProcessConfig)
import Mpv.Data.MpvResources (MpvResources)
import qualified Mpv.Effect.Ipc as Ipc
import Mpv.Effect.Ipc (Ipc)
import qualified Mpv.Effect.Mpv as Mpv
import Mpv.Effect.Mpv (Mpv)
import Mpv.Interpreter.Commands (interpretCommandsJson)
import Mpv.Interpreter.Ipc (interpretIpc)
import Mpv.MpvError (optionError, propError, setPropError)
import Mpv.MpvResources (withMpvResources)

commandEvent :: Command a -> Maybe EventName
commandEvent :: forall a. Command a -> Maybe EventName
commandEvent = \case
  Command.Manual Maybe EventName
event Text
_ [Value]
_ -> Maybe EventName
event
  Command.Load Path Abs File
_ Maybe LoadOption
_ -> EventName -> Maybe EventName
forall a. a -> Maybe a
Just EventName
FileLoaded
  Command a
Command.Stop -> EventName -> Maybe EventName
forall a. a -> Maybe a
Just EventName
EndFile
  Command a
_ -> Maybe EventName
forall a. Maybe a
Nothing

waitEventCmd ::
  TimeUnit u =>
  Member (Ipc fmt Command) r =>
  u ->
  Command b ->
  Sem r a ->
  Sem r a
waitEventCmd :: forall u fmt (r :: [(* -> *) -> * -> *]) b a.
(TimeUnit u, Member (Ipc fmt Command) r) =>
u -> Command b -> Sem r a -> Sem r a
waitEventCmd u
wait (Command b -> Maybe EventName
forall a. Command a -> Maybe EventName
commandEvent -> Just EventName
event) Sem r a
ma =
  (Maybe (Some Event), a) -> a
forall a b. (a, b) -> b
snd ((Maybe (Some Event), a) -> a)
-> Sem r (Maybe (Some Event), a) -> Sem r a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventName -> u -> Sem r a -> Sem r (Maybe (Some Event), a)
forall fmt (command :: * -> *) (r :: [(* -> *) -> * -> *]) u a.
(MemberWithError (Ipc fmt command) r, TimeUnit u) =>
EventName -> u -> Sem r a -> Sem r (Maybe (Some Event), a)
Ipc.waitEvent EventName
event u
wait Sem r a
ma
waitEventCmd u
_ Command b
_ Sem r a
ma =
  Sem r a
ma

interpretMpvIpc ::
  Member (Ipc fmt Command !! MpvError) r =>
  InterpreterFor (Mpv !! MpvError) r
interpretMpvIpc :: forall fmt (r :: [(* -> *) -> * -> *]).
Member (Ipc fmt Command !! MpvError) r =>
InterpreterFor (Mpv !! MpvError) r
interpretMpvIpc =
  (forall x (r0 :: [(* -> *) -> * -> *]).
 Mpv (Sem r0) x -> Sem (Stop MpvError : r) x)
-> InterpreterFor (Mpv !! MpvError) r
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: [(* -> *) -> * -> *]).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    Mpv.CommandSync u
wait Command x
cmd ->
      Sem (Ipc fmt Command : Stop MpvError : r) x
-> Sem (Stop MpvError : r) x
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop (u
-> Command x
-> Sem (Ipc fmt Command : Stop MpvError : r) x
-> Sem (Ipc fmt Command : Stop MpvError : r) x
forall u fmt (r :: [(* -> *) -> * -> *]) b a.
(TimeUnit u, Member (Ipc fmt Command) r) =>
u -> Command b -> Sem r a -> Sem r a
waitEventCmd u
wait Command x
cmd (Command x -> Sem (Ipc fmt Command : Stop MpvError : r) x
forall fmt (command :: * -> *) (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Ipc fmt command) r =>
command a -> Sem r a
Ipc.sync Command x
cmd))
    Mpv.Prop Property x
prop ->
      (MpvError -> MpvError)
-> Sem (Ipc fmt Command : Stop MpvError : r) x
-> Sem (Stop MpvError : r) x
forall err (eff :: (* -> *) -> * -> *) err'
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (Property x -> MpvError -> MpvError
forall v. Property v -> MpvError -> MpvError
propError Property x
prop) (Command x -> Sem (Ipc fmt Command : Stop MpvError : r) x
forall fmt (command :: * -> *) (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Ipc fmt command) r =>
command a -> Sem r a
Ipc.sync (Property x -> Command x
forall a. Property a -> Command a
Command.Prop Property x
prop))
    Mpv.SetProp Property v
prop v
value ->
      (MpvError -> MpvError)
-> Sem (Ipc fmt Command : Stop MpvError : r) ()
-> Sem (Stop MpvError : r) ()
forall err (eff :: (* -> *) -> * -> *) err'
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (Property v -> MpvError -> MpvError
forall v. Property v -> MpvError -> MpvError
setPropError Property v
prop) (Command () -> Sem (Ipc fmt Command : Stop MpvError : r) ()
forall fmt (command :: * -> *) (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Ipc fmt command) r =>
command a -> Sem r a
Ipc.sync (Property v -> v -> Command ()
forall v. Show v => Property v -> v -> Command ()
Command.SetProp Property v
prop v
value))
    Mpv.AddProp Property v
prop Maybe v
value ->
      (MpvError -> MpvError)
-> Sem (Ipc fmt Command : Stop MpvError : r) ()
-> Sem (Stop MpvError : r) ()
forall err (eff :: (* -> *) -> * -> *) err'
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (Property v -> MpvError -> MpvError
forall v. Property v -> MpvError -> MpvError
setPropError Property v
prop) (Command () -> Sem (Ipc fmt Command : Stop MpvError : r) ()
forall fmt (command :: * -> *) (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Ipc fmt command) r =>
command a -> Sem r a
Ipc.sync (Property v -> Maybe v -> Command ()
forall v. Show v => Property v -> Maybe v -> Command ()
Command.AddProp Property v
prop Maybe v
value))
    Mpv.CycleProp Property v
prop Maybe CycleDirection
direction ->
      (MpvError -> MpvError)
-> Sem (Ipc fmt Command : Stop MpvError : r) ()
-> Sem (Stop MpvError : r) ()
forall err (eff :: (* -> *) -> * -> *) err'
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (Property v -> MpvError -> MpvError
forall v. Property v -> MpvError -> MpvError
setPropError Property v
prop) (Command () -> Sem (Ipc fmt Command : Stop MpvError : r) ()
forall fmt (command :: * -> *) (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Ipc fmt command) r =>
command a -> Sem r a
Ipc.sync (Property v -> Maybe CycleDirection -> Command ()
forall v.
Show v =>
Property v -> Maybe CycleDirection -> Command ()
Command.CycleProp Property v
prop Maybe CycleDirection
direction))
    Mpv.MultiplyProp Property v
prop v
value ->
      (MpvError -> MpvError)
-> Sem (Ipc fmt Command : Stop MpvError : r) ()
-> Sem (Stop MpvError : r) ()
forall err (eff :: (* -> *) -> * -> *) err'
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (Property v -> MpvError -> MpvError
forall v. Property v -> MpvError -> MpvError
setPropError Property v
prop) (Command () -> Sem (Ipc fmt Command : Stop MpvError : r) ()
forall fmt (command :: * -> *) (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Ipc fmt command) r =>
command a -> Sem r a
Ipc.sync (Property v -> v -> Command ()
forall v. Show v => Property v -> v -> Command ()
Command.MultiplyProp Property v
prop v
value))
    Mpv.SetOption Text
key Text
value ->
      (MpvError -> MpvError)
-> Sem (Ipc fmt Command : Stop MpvError : r) ()
-> Sem (Stop MpvError : r) ()
forall err (eff :: (* -> *) -> * -> *) err'
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (Text -> Text -> MpvError -> MpvError
optionError Text
key Text
value) (Command () -> Sem (Ipc fmt Command : Stop MpvError : r) ()
forall fmt (command :: * -> *) (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Ipc fmt command) r =>
command a -> Sem r a
Ipc.sync (Text -> Text -> Command ()
Command.SetOption Text
key Text
value))

interpretMpvResources ::
  Members [EventConsumer token MpvEvent, Resource, Async, Race, Log, Embed IO, Final IO] r =>
  Either MpvError (MpvResources Value) ->
  InterpreterFor (Mpv !! MpvError) r
interpretMpvResources :: forall token (r :: [(* -> *) -> * -> *]).
Members
  '[EventConsumer token MpvEvent, Resource, Async, Race, Log,
    Embed IO, Final IO]
  r =>
Either MpvError (MpvResources Value)
-> InterpreterFor (Mpv !! MpvError) r
interpretMpvResources = \case
  Right MpvResources Value
res ->
    Sem (Commands Value Command : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]).
InterpreterFor (Commands Value Command) r
interpretCommandsJson (Sem (Commands Value Command : r) a -> Sem r a)
-> (Sem ((Mpv !! MpvError) : r) a
    -> Sem (Commands Value Command : r) a)
-> Sem ((Mpv !! MpvError) : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MpvResources Value
-> InterpreterFor
     (Ipc Value Command !! MpvError) (Commands Value Command : r)
forall fmt (command :: * -> *) token (r :: [(* -> *) -> * -> *]).
(Members '[Commands fmt command, EventConsumer token MpvEvent] r,
 Members '[Log, Resource, Async, Race, Embed IO] r) =>
MpvResources fmt -> InterpreterFor (Ipc fmt command !! MpvError) r
interpretIpc MpvResources Value
res (Sem
   ((Ipc Value Command !! MpvError) : Commands Value Command : r) a
 -> Sem (Commands Value Command : r) a)
-> (Sem ((Mpv !! MpvError) : r) a
    -> Sem
         ((Ipc Value Command !! MpvError) : Commands Value Command : r) a)
-> Sem ((Mpv !! MpvError) : r) a
-> Sem (Commands Value Command : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  ((Mpv !! MpvError)
     : (Ipc Value Command !! MpvError) : Commands Value Command : r)
  a
-> Sem
     ((Ipc Value Command !! MpvError) : Commands Value Command : r) a
forall fmt (r :: [(* -> *) -> * -> *]).
Member (Ipc fmt Command !! MpvError) r =>
InterpreterFor (Mpv !! MpvError) r
interpretMpvIpc (Sem
   ((Mpv !! MpvError)
      : (Ipc Value Command !! MpvError) : Commands Value Command : r)
   a
 -> Sem
      ((Ipc Value Command !! MpvError) : Commands Value Command : r) a)
-> (Sem ((Mpv !! MpvError) : r) a
    -> Sem
         ((Mpv !! MpvError)
            : (Ipc Value Command !! MpvError) : Commands Value Command : r)
         a)
-> Sem ((Mpv !! MpvError) : r) a
-> Sem
     ((Ipc Value Command !! MpvError) : Commands Value Command : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem ((Mpv !! MpvError) : r) a
-> Sem
     ((Mpv !! MpvError)
        : (Ipc Value Command !! MpvError) : Commands Value Command : r)
     a
forall (e2 :: (* -> *) -> * -> *) (e3 :: (* -> *) -> * -> *)
       (e1 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2
  Left MpvError
err ->
    (forall x (r0 :: [(* -> *) -> * -> *]).
 Mpv (Sem r0) x
 -> Tactical (Mpv !! MpvError) (Sem r0) (Stop MpvError : r) x)
-> forall {a}. Sem ((Mpv !! MpvError) : r) a -> Sem r a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
(forall x (r0 :: [(* -> *) -> * -> *]).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumableH \ Mpv (Sem r0) x
_ -> MpvError
-> Sem
     (WithTactics (Mpv !! MpvError) f (Sem r0) (Stop MpvError : r))
     (f x)
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop MpvError
err

interpretMpvNative ::
  Members [Reader MpvProcessConfig, Resource, Async, Race, Log, Time t d, Embed IO, Final IO] r =>
  InterpretersFor [Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError), ChanConsumer MpvEvent] r
interpretMpvNative :: forall t d (r :: [(* -> *) -> * -> *]).
Members
  '[Reader MpvProcessConfig, Resource, Async, Race, Log, Time t d,
    Embed IO, Final IO]
  r =>
InterpretersFor
  '[Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError),
    ChanConsumer MpvEvent]
  r
interpretMpvNative =
  Sem
  (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r) a
-> Sem r a
forall e (r :: [(* -> *) -> * -> *]).
Members '[Resource, Race, Async, Embed IO] r =>
InterpretersFor '[Events (OutChan e) e, ChanConsumer e] r
interpretEventsChan (Sem
   (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r) a
 -> Sem r a)
-> (Sem
      (Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError)
         : ChanConsumer MpvEvent : r)
      a
    -> Sem
         (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r) a)
-> Sem
     (Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError)
        : ChanConsumer MpvEvent : r)
     a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall x.
 (Either MpvError (MpvResources Value)
  -> Sem
       (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r) x)
 -> Sem
      (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r) x)
-> (Either MpvError (MpvResources Value)
    -> InterpreterFor
         (Mpv !! MpvError)
         (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r))
-> InterpreterFor
     (Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError))
     (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r)
forall resource (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
(forall x. (resource -> Sem r x) -> Sem r x)
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (Scoped resource effect) r
runScoped forall x.
(Either MpvError (MpvResources Value)
 -> Sem
      (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r) x)
-> Sem
     (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r) x
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)
-> InterpreterFor
     (Mpv !! MpvError)
     (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r)
forall token (r :: [(* -> *) -> * -> *]).
Members
  '[EventConsumer token MpvEvent, Resource, Async, Race, Log,
    Embed IO, Final IO]
  r =>
Either MpvError (MpvResources Value)
-> InterpreterFor (Mpv !! MpvError) r
interpretMpvResources (Sem
   (Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError)
      : Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r)
   a
 -> Sem
      (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r) a)
-> (Sem
      (Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError)
         : ChanConsumer MpvEvent : r)
      a
    -> Sem
         (Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError)
            : Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r)
         a)
-> Sem
     (Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError)
        : ChanConsumer MpvEvent : r)
     a
-> Sem
     (Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  (Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError)
     : ChanConsumer MpvEvent : r)
  a
-> Sem
     (Scoped (Either MpvError (MpvResources Value)) (Mpv !! MpvError)
        : Events (OutChan MpvEvent) MpvEvent : ChanConsumer MpvEvent : r)
     a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder

withMpv ::
  Member (Scoped resource (Mpv !! MpvError)) r =>
  InterpreterFor (Mpv !! MpvError) r
withMpv :: forall resource (r :: [(* -> *) -> * -> *]).
Member (Scoped resource (Mpv !! MpvError)) r =>
InterpreterFor (Mpv !! MpvError) r
withMpv =
  Sem ((Mpv !! MpvError) : r) a -> Sem r a
forall resource (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
Member (Scoped resource effect) r =>
InterpreterFor effect r
scoped

events ::
  Member (EventConsumer token MpvEvent) r =>
  InterpreterFor (Consume MpvEvent) r
events :: forall token (r :: [(* -> *) -> * -> *]).
Member (EventConsumer token MpvEvent) r =>
InterpreterFor (Consume MpvEvent) r
events =
  Sem (Consume MpvEvent : r) a -> Sem r a
forall resource (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
Member (Scoped resource effect) r =>
InterpreterFor effect r
scoped