module Mpv.Interpreter.Commands where

import Data.Aeson (ToJSON (toJSON), Value)
import Data.SOP (All, I (I), K (K), NP (Nil, (:*)), hcmap, hcollapse, unI)
import Exon (exon)
import Polysemy.Time (convert)
import Polysemy.Time.Data.TimeUnit (unMilliSeconds, unNanoSeconds)

import Mpv.Data.AudioDelay (unAudioDelay)
import qualified Mpv.Data.Command as Command
import Mpv.Data.Command (Command)
import qualified Mpv.Data.PlaybackState as PlaybackState
import qualified Mpv.Data.Property as Property
import Mpv.Data.Property (Property, propertyName)
import Mpv.Data.Request (Request (Request))
import Mpv.Data.RequestId (RequestId)
import Mpv.Data.Response (ResponseError (ResponseError))
import qualified Mpv.Data.SeekFlags as SeekUnit
import Mpv.Data.SeekFlags (SeekFlags (SeekFlags), SeekUnit)
import Mpv.Data.SubDelay (unSubDelay)
import Mpv.Data.VideoDuration (unVideoDuration)
import Mpv.Data.VideoExpired (unVideoExpired)
import Mpv.Data.Volume (unVolume)
import qualified Mpv.Effect.Commands as Commands
import Mpv.Effect.Commands (Commands)
import Mpv.Json (jsonDecodeValue)
import Mpv.Seek (seekRestartArg, seekStyleArg)

percentToRatio ::
  Fractional a =>
  Double ->
  a
percentToRatio :: forall a. Fractional a => Double -> a
percentToRatio Double
pos =
  Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double
pos Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100))))

ratioToPercent ::
  Real a =>
  a ->
  Double
ratioToPercent :: forall a. Real a => a -> Double
ratioToPercent a
pos =
  Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (a -> Rational
forall a. Real a => a -> Rational
toRational (a -> a -> a
forall a. Ord a => a -> a -> a
min a
100 (a -> a -> a
forall a. Ord a => a -> a -> a
max a
0 (a
pos a -> a -> a
forall a. Num a => a -> a -> a
* a
100))))

seekValue :: Double -> SeekUnit -> Double
seekValue :: Double -> SeekUnit -> Double
seekValue Double
value = \case
  SeekUnit
SeekUnit.Percent -> Double
value Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
  SeekUnit
SeekUnit.Time -> Double
value

secondsFrac ::
  TimeUnit u =>
  u ->
  Double
secondsFrac :: forall u. TimeUnit u => u -> Double
secondsFrac u
u =
  Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NanoSeconds -> Int64
unNanoSeconds (u -> NanoSeconds
forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert u
u)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9

encodeCommand ::
  Text ->
  [Value] ->
  RequestId ->
  Bool ->
  Value
encodeCommand :: Text -> [Value] -> RequestId -> Bool -> Value
encodeCommand Text
cmd [Value]
args RequestId
requestId Bool
async' =
  Request -> Value
forall a. ToJSON a => a -> Value
toJSON (RequestId -> [Value] -> Bool -> Request
Request RequestId
requestId (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
cmd Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
args) Bool
async')

encodeCommandGen ::
  All ToJSON as =>
  Text ->
  NP I as ->
  RequestId ->
  Bool ->
  Value
encodeCommandGen :: forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
cmd NP I as
args =
  Text -> [Value] -> RequestId -> Bool -> Value
encodeCommand Text
cmd [Value]
CollapseTo NP Value
argValues
  where
    argValues :: CollapseTo NP Value
argValues =
      NP (K Value) as -> CollapseTo NP Value
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (Proxy ToJSON
-> (forall a. ToJSON a => I a -> K Value a)
-> NP I as
-> NP (K Value) as
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
forall {t :: * -> Constraint}. Proxy t
Proxy @ToJSON) (Value -> K Value a
forall k a (b :: k). a -> K a b
K (Value -> K Value a) -> (I a -> Value) -> I a -> K Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> (I a -> a) -> I a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  I a -> a
forall a. I a -> a
unI) NP I as
args)

encodeProp :: Property v -> v -> Value
encodeProp :: forall v. Property v -> v -> Value
encodeProp = \case
  Property.Custom Text
_ ->
    v -> Value
forall a. ToJSON a => a -> Value
toJSON
  Property v
Property.Duration ->
    Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> Value)
-> (VideoDuration -> Double) -> VideoDuration -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NanoSeconds -> Double
forall u. TimeUnit u => u -> Double
secondsFrac (NanoSeconds -> Double)
-> (VideoDuration -> NanoSeconds) -> VideoDuration -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoDuration -> NanoSeconds
unVideoDuration
  Property v
Property.SubFps ->
    v -> Value
forall a. ToJSON a => a -> Value
toJSON
  Property v
Property.SubDelay ->
    Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> Value) -> (SubDelay -> Double) -> SubDelay -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NanoSeconds -> Double
forall u. TimeUnit u => u -> Double
secondsFrac (NanoSeconds -> Double)
-> (SubDelay -> NanoSeconds) -> SubDelay -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubDelay -> NanoSeconds
unSubDelay
  Property v
Property.AudioDelay ->
    Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> Value) -> (AudioDelay -> Double) -> AudioDelay -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NanoSeconds -> Double
forall u. TimeUnit u => u -> Double
secondsFrac (NanoSeconds -> Double)
-> (AudioDelay -> NanoSeconds) -> AudioDelay -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AudioDelay -> NanoSeconds
unAudioDelay
  Property v
Property.TrackList ->
    v -> Value
forall a. ToJSON a => a -> Value
toJSON
  Property v
Property.PercentPos ->
    Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> Value) -> (v -> Double) -> v -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Double
forall a. Real a => a -> Double
ratioToPercent
  Property v
Property.TimePos ->
    Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> Value)
-> (VideoExpired -> Double) -> VideoExpired -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NanoSeconds -> Double
forall u. TimeUnit u => u -> Double
secondsFrac (NanoSeconds -> Double)
-> (VideoExpired -> NanoSeconds) -> VideoExpired -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoExpired -> NanoSeconds
unVideoExpired
  Property v
Property.Paused ->
    Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value)
-> (PlaybackState -> Bool) -> PlaybackState -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaybackState -> Bool
PlaybackState.toBool
  Property v
Property.Volume ->
    Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> Value) -> (Volume -> Double) -> Volume -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Volume -> Double
unVolume

mpvCommand :: Command a -> RequestId -> Bool -> Value
mpvCommand :: forall a. Command a -> RequestId -> Bool -> Value
mpvCommand = \case
  Command.Load Path Abs File
path (Just LoadOption
opts) ->
    Text
-> NP I '[Path Abs File, LoadOption] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"loadfile" (Path Abs File -> I (Path Abs File)
forall a. a -> I a
I Path Abs File
path I (Path Abs File)
-> NP I '[LoadOption] -> NP I '[Path Abs File, LoadOption]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* LoadOption -> I LoadOption
forall a. a -> I a
I LoadOption
opts I LoadOption -> NP I '[] -> NP I '[LoadOption]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command.Load Path Abs File
path Maybe LoadOption
Nothing ->
    Text -> NP I '[Path Abs File] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"loadfile" (Path Abs File -> I (Path Abs File)
forall a. a -> I a
I Path Abs File
path I (Path Abs File) -> NP I '[] -> NP I '[Path Abs File]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command a
Command.Stop ->
    Text -> NP I '[] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"quit" NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil
  Command.Seek Double
pos (SeekFlags SeekReference
reference SeekUnit
unit' SeekRestart
restart) ->
    Text -> NP I '[Double, Text] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"seek" (Double -> I Double
forall a. a -> I a
I (Double -> SeekUnit -> Double
seekValue Double
pos SeekUnit
unit') I Double -> NP I '[Text] -> NP I '[Double, Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Text -> I Text
forall a. a -> I a
I Text
spec I Text -> NP I '[] -> NP I '[Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
    where
      spec :: Text
spec =
        [exon|#{seekStyleArg unit' reference}+#{seekRestartArg restart}|]
  Command.Manual Maybe EventName
_ Text
name [Value]
args ->
    Text -> [Value] -> RequestId -> Bool -> Value
encodeCommand Text
name [Value]
args
  Command.Prop Property a
prop ->
    Text -> NP I '[Text] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"get_property" (Text -> I Text
forall a. a -> I a
I (Property a -> Text
forall v. Property v -> Text
propertyName Property a
prop) I Text -> NP I '[] -> NP I '[Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command.SetProp Property v
prop v
value ->
    Text -> NP I '[Text, Value] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"set_property" (Text -> I Text
forall a. a -> I a
I (Property v -> Text
forall v. Property v -> Text
propertyName Property v
prop) I Text -> NP I '[Value] -> NP I '[Text, Value]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Value -> I Value
forall a. a -> I a
I (Property v -> v -> Value
forall v. Property v -> v -> Value
encodeProp Property v
prop v
value) I Value -> NP I '[] -> NP I '[Value]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command.AddProp Property v
prop (Just v
value) ->
    Text -> NP I '[Text, Value] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"add_property" (Text -> I Text
forall a. a -> I a
I (Property v -> Text
forall v. Property v -> Text
propertyName Property v
prop) I Text -> NP I '[Value] -> NP I '[Text, Value]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Value -> I Value
forall a. a -> I a
I (Property v -> v -> Value
forall v. Property v -> v -> Value
encodeProp Property v
prop v
value) I Value -> NP I '[] -> NP I '[Value]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command.AddProp Property v
prop Maybe v
Nothing ->
    Text -> NP I '[Text] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"add_property" (Text -> I Text
forall a. a -> I a
I (Property v -> Text
forall v. Property v -> Text
propertyName Property v
prop) I Text -> NP I '[] -> NP I '[Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command.CycleProp Property v
prop (Just CycleDirection
direction) ->
    Text -> NP I '[Text, CycleDirection] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"cycle_property" (Text -> I Text
forall a. a -> I a
I (Property v -> Text
forall v. Property v -> Text
propertyName Property v
prop) I Text -> NP I '[CycleDirection] -> NP I '[Text, CycleDirection]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* CycleDirection -> I CycleDirection
forall a. a -> I a
I CycleDirection
direction I CycleDirection -> NP I '[] -> NP I '[CycleDirection]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command.CycleProp Property v
prop Maybe CycleDirection
Nothing ->
    Text -> NP I '[Text] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"cycle_property" (Text -> I Text
forall a. a -> I a
I (Property v -> Text
forall v. Property v -> Text
propertyName Property v
prop) I Text -> NP I '[] -> NP I '[Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command.MultiplyProp Property v
prop v
value ->
    Text -> NP I '[Text, Value] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"multiply_property" (Text -> I Text
forall a. a -> I a
I (Property v -> Text
forall v. Property v -> Text
propertyName Property v
prop) I Text -> NP I '[Value] -> NP I '[Text, Value]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Value -> I Value
forall a. a -> I a
I (Property v -> v -> Value
forall v. Property v -> v -> Value
encodeProp Property v
prop v
value) I Value -> NP I '[] -> NP I '[Value]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command.SetOption Text
key Text
value ->
    Text -> NP I '[Text, Text] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"set" (Text -> I Text
forall a. a -> I a
I Text
key I Text -> NP I '[Text] -> NP I '[Text, Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Text -> I Text
forall a. a -> I a
I Text
value I Text -> NP I '[] -> NP I '[Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command.ShowText Text
txt u
duration OsdLevel
level ->
    Text -> NP I '[Text, Int64, OsdLevel] -> RequestId -> Bool -> Value
forall (as :: [*]).
All ToJSON as =>
Text -> NP I as -> RequestId -> Bool -> Value
encodeCommandGen Text
"show_text" (Text -> I Text
forall a. a -> I a
I Text
txt I Text -> NP I '[Int64, OsdLevel] -> NP I '[Text, Int64, OsdLevel]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Int64 -> I Int64
forall a. a -> I a
I (MilliSeconds -> Int64
unMilliSeconds (u -> MilliSeconds
forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert u
duration)) I Int64 -> NP I '[OsdLevel] -> NP I '[Int64, OsdLevel]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* OsdLevel -> I OsdLevel
forall a. a -> I a
I OsdLevel
level I OsdLevel -> NP I '[] -> NP I '[OsdLevel]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)
  Command a
Command.ShowProgress ->
    Text -> [Value] -> RequestId -> Bool -> Value
encodeCommand Text
"show_progress" []

decodeProp ::
  Property v ->
  Value ->
  Either Text v
decodeProp :: forall v. Property v -> Value -> Either Text v
decodeProp = \case
  Property.Custom Text
_ ->
    Value -> Either Text v
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Property v
Property.Duration ->
    (Rational -> v) -> Either Text Rational -> Either Text v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> v
forall a. Fractional a => Rational -> a
fromRational (Either Text Rational -> Either Text v)
-> (Value -> Either Text Rational) -> Value -> Either Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either Text Rational
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Property v
Property.SubFps ->
    Value -> Either Text v
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Property v
Property.SubDelay ->
    (Rational -> v) -> Either Text Rational -> Either Text v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> v
forall a. Fractional a => Rational -> a
fromRational (Either Text Rational -> Either Text v)
-> (Value -> Either Text Rational) -> Value -> Either Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either Text Rational
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Property v
Property.AudioDelay ->
    (Rational -> v) -> Either Text Rational -> Either Text v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> v
forall a. Fractional a => Rational -> a
fromRational (Either Text Rational -> Either Text v)
-> (Value -> Either Text Rational) -> Value -> Either Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either Text Rational
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Property v
Property.TrackList ->
    Value -> Either Text v
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Property v
Property.PercentPos ->
    (Double -> v) -> Either Text Double -> Either Text v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> v
forall a. Fractional a => Double -> a
percentToRatio (Either Text Double -> Either Text v)
-> (Value -> Either Text Double) -> Value -> Either Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either Text Double
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Property v
Property.TimePos ->
    (Rational -> v) -> Either Text Rational -> Either Text v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> v
forall a. Fractional a => Rational -> a
fromRational (Either Text Rational -> Either Text v)
-> (Value -> Either Text Rational) -> Value -> Either Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either Text Rational
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Property v
Property.Paused ->
    (Bool -> PlaybackState)
-> Either Text Bool -> Either Text PlaybackState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> PlaybackState
PlaybackState.fromBool (Either Text Bool -> Either Text PlaybackState)
-> (Value -> Either Text Bool)
-> Value
-> Either Text PlaybackState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either Text Bool
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Property v
Property.Volume ->
    Value -> Either Text v
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue

decodeResult ::
  Command a ->
  Value ->
  Either Text a
decodeResult :: forall a. Command a -> Value -> Either Text a
decodeResult = \case
  Command.Manual Maybe EventName
_ Text
_ [Value]
_ ->
    Value -> Either Text a
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Command.Load Path Abs File
_ Maybe LoadOption
_ ->
    Value -> Either Text a
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Command a
Command.Stop ->
    Value -> Either Text a
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Command.Seek Double
_ SeekFlags
_ ->
    Value -> Either Text a
forall a. FromJSON a => Value -> Either Text a
jsonDecodeValue
  Command.Prop Property a
prop ->
    Property a -> Value -> Either Text a
forall v. Property v -> Value -> Either Text v
decodeProp Property a
prop
  Command.SetProp Property v
_ v
_ ->
    Either Text () -> Value -> Either Text ()
forall a b. a -> b -> a
const Either Text ()
forall (f :: * -> *). Applicative f => f ()
unit
  Command.AddProp Property v
_ Maybe v
_ ->
    Either Text () -> Value -> Either Text ()
forall a b. a -> b -> a
const Either Text ()
forall (f :: * -> *). Applicative f => f ()
unit
  Command.CycleProp Property v
_ Maybe CycleDirection
_ ->
    Either Text () -> Value -> Either Text ()
forall a b. a -> b -> a
const Either Text ()
forall (f :: * -> *). Applicative f => f ()
unit
  Command.MultiplyProp Property v
_ v
_ ->
    Either Text () -> Value -> Either Text ()
forall a b. a -> b -> a
const Either Text ()
forall (f :: * -> *). Applicative f => f ()
unit
  Command.SetOption Text
_ Text
_ ->
    Either Text () -> Value -> Either Text ()
forall a b. a -> b -> a
const Either Text ()
forall (f :: * -> *). Applicative f => f ()
unit
  Command.ShowText Text
_ u
_ OsdLevel
_ ->
    Either Text () -> Value -> Either Text ()
forall a b. a -> b -> a
const Either Text ()
forall (f :: * -> *). Applicative f => f ()
unit
  Command a
Command.ShowProgress ->
    Either Text () -> Value -> Either Text ()
forall a b. a -> b -> a
const Either Text ()
forall (f :: * -> *). Applicative f => f ()
unit

decodeError :: Text -> ResponseError
decodeError :: Text -> ResponseError
decodeError Text
err =
  Text -> ResponseError
ResponseError [exon|mpv response decode: #{err}|]

interpretCommandsJson :: InterpreterFor (Commands Value Command) r
interpretCommandsJson :: forall (r :: [Effect]). InterpreterFor (Commands Value Command) r
interpretCommandsJson =
  (forall (rInitial :: [Effect]) x.
 Commands Value Command (Sem rInitial) x -> Sem r x)
-> Sem (Commands Value Command : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Commands.Encode RequestId
requestId Bool
async' Command a1
cmd ->
      Value -> Sem r Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Command a1 -> RequestId -> Bool -> Value
forall a. Command a -> RequestId -> Bool -> Value
mpvCommand Command a1
cmd RequestId
requestId Bool
async')
    Commands.Decode Command a1
cmd Value
value ->
      Either ResponseError a1 -> Sem r (Either ResponseError a1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text -> ResponseError)
-> Either Text a1 -> Either ResponseError a1
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> ResponseError
decodeError (Command a1 -> Value -> Either Text a1
forall a. Command a -> Value -> Either Text a
decodeResult Command a1
cmd Value
value))