module Mpv.Response where

import Data.Aeson (Value (Null), fromJSON)
import qualified Data.Map.Strict as Map
import Exon (exon)
import qualified Polysemy.Conc as Events
import qualified Polysemy.Conc as Queue
import qualified Polysemy.Log as Log

import Mpv.Data.Message (Message (ResponseEvent, ResponseMessage))
import Mpv.Data.MpvEvent (MpvEvent)
import Mpv.Data.MpvResources (InMessage (InMessage, InMessageError), Requests (Requests))
import Mpv.Data.RequestId (RequestId (RequestId))
import Mpv.Data.Response (Response (Response), ResponseError (ResponseError))
import Mpv.Json (aesonToEither)

decodePayload :: Text -> Maybe Value -> Either ResponseError Value
decodePayload :: Text -> Maybe Value -> Either ResponseError Value
decodePayload Text
"success" Maybe Value
value =
  Value -> Either ResponseError Value
forall a b. b -> Either a b
Right (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null Maybe Value
value)
decodePayload Text
err Maybe Value
_ =
  ResponseError -> Either ResponseError Value
forall a b. a -> Either a b
Left (Text -> ResponseError
ResponseError Text
err)

decodeMessage ::
  Message ->
  Either MpvEvent (Response Value)
decodeMessage :: Message -> Either MpvEvent (Response Value)
decodeMessage = \case
  ResponseMessage Int
requestId Text
err Maybe Value
value ->
    Response Value -> Either MpvEvent (Response Value)
forall a b. b -> Either a b
Right (RequestId -> Either ResponseError Value -> Response Value
forall fmt. RequestId -> Either ResponseError fmt -> Response fmt
Response (Int -> RequestId
RequestId Int
requestId) (Text -> Maybe Value -> Either ResponseError Value
decodePayload Text
err Maybe Value
value))
  ResponseEvent MpvEvent
event ->
    MpvEvent -> Either MpvEvent (Response Value)
forall a b. a -> Either a b
Left MpvEvent
event

decodeInMessage ::
  InMessage Value ->
  Either Text (Either MpvEvent (Response Value))
decodeInMessage :: InMessage Value -> Either Text (Either MpvEvent (Response Value))
decodeInMessage (InMessage Value
msg) = do
  Message
message <- Result Message -> Either Text Message
forall a. Result a -> Either Text a
aesonToEither (Value -> Result Message
forall a. FromJSON a => Value -> Result a
fromJSON Value
msg)
  pure (Message -> Either MpvEvent (Response Value)
decodeMessage Message
message)
decodeInMessage (InMessageError Text
err) =
  Text -> Either Text (Either MpvEvent (Response Value))
forall a b. a -> Either a b
Left Text
err

parseError ::
  Show fmt =>
  Member Log r =>
  InMessage fmt ->
  Text ->
  Sem r ()
parseError :: forall fmt (r :: [(* -> *) -> * -> *]).
(Show fmt, Member Log r) =>
InMessage fmt -> Text -> Sem r ()
parseError InMessage fmt
msg Text
err =
  Text -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.error [exon|mpv response parse error: #{err}; #{show msg}|]

notifyResponse ::
  Members [AtomicState (Requests Value), Log, Embed IO] r =>
  RequestId ->
  Either ResponseError Value ->
  Sem r ()
notifyResponse :: forall (r :: [(* -> *) -> * -> *]).
Members '[AtomicState (Requests Value), Log, Embed IO] r =>
RequestId -> Either ResponseError Value -> Sem r ()
notifyResponse RequestId
requestId Either ResponseError Value
result =
  (Requests Value
 -> (Requests Value, Maybe (MVar (Either ResponseError Value))))
-> Sem r (Maybe (MVar (Either ResponseError Value)))
forall s a (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' Requests Value
-> (Requests Value, Maybe (MVar (Either ResponseError Value)))
fetch Sem r (Maybe (MVar (Either ResponseError Value)))
-> (Maybe (MVar (Either ResponseError Value)) -> Sem r ())
-> Sem r ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just MVar (Either ResponseError Value)
notify ->
      IO () -> Sem r ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar (Either ResponseError Value)
-> Either ResponseError Value -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either ResponseError Value)
notify Either ResponseError Value
result)
    Maybe (MVar (Either ResponseError Value))
Nothing ->
      Text -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|unknown mpv request with id #{show requestId}: #{show result}|]
  where
    fetch :: Requests Value
-> (Requests Value, Maybe (MVar (Either ResponseError Value)))
fetch (Requests RequestId
n Map RequestId (MVar (Either ResponseError Value))
p) =
      (RequestId
-> Map RequestId (MVar (Either ResponseError Value))
-> Requests Value
forall fmt.
RequestId
-> Map RequestId (MVar (Either ResponseError fmt)) -> Requests fmt
Requests RequestId
n (RequestId
-> Map RequestId (MVar (Either ResponseError Value))
-> Map RequestId (MVar (Either ResponseError Value))
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete RequestId
requestId Map RequestId (MVar (Either ResponseError Value))
p), RequestId
-> Map RequestId (MVar (Either ResponseError Value))
-> Maybe (MVar (Either ResponseError Value))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RequestId
requestId Map RequestId (MVar (Either ResponseError Value))
p)

processMessage ::
  Members [Events t MpvEvent, AtomicState (Requests Value), Log, Embed IO] r =>
  InMessage Value ->
  Either Text (Either MpvEvent (Response Value)) ->
  Sem r ()
processMessage :: forall t (r :: [(* -> *) -> * -> *]).
Members
  '[Events t MpvEvent, AtomicState (Requests Value), Log, Embed IO]
  r =>
InMessage Value
-> Either Text (Either MpvEvent (Response Value)) -> Sem r ()
processMessage InMessage Value
msg = \case
  Right (Right (Response RequestId
requestId Either ResponseError Value
payload)) ->
    RequestId -> Either ResponseError Value -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members '[AtomicState (Requests Value), Log, Embed IO] r =>
RequestId -> Either ResponseError Value -> Sem r ()
notifyResponse RequestId
requestId Either ResponseError Value
payload
  Right (Left MpvEvent
event) ->
    MpvEvent -> Sem r ()
forall e resource (r :: [(* -> *) -> * -> *]).
Member (Events resource e) r =>
e -> Sem r ()
Events.publish MpvEvent
event
  Left Text
err ->
    InMessage Value -> Text -> Sem r ()
forall fmt (r :: [(* -> *) -> * -> *]).
(Show fmt, Member Log r) =>
InMessage fmt -> Text -> Sem r ()
parseError InMessage Value
msg Text
err

responseListener ::
  Members [Events t MpvEvent, Queue (InMessage Value), AtomicState (Requests Value), Log, Embed IO] r =>
  Sem r ()
responseListener :: forall t (r :: [(* -> *) -> * -> *]).
Members
  '[Events t MpvEvent, Queue (InMessage Value),
    AtomicState (Requests Value), Log, Embed IO]
  r =>
Sem r ()
responseListener =
  (InMessage Value -> Sem r ()) -> Sem r ()
forall d (r :: [(* -> *) -> * -> *]).
Member (Queue d) r =>
(d -> Sem r ()) -> Sem r ()
Queue.loop \ InMessage Value
msg -> InMessage Value
-> Either Text (Either MpvEvent (Response Value)) -> Sem r ()
forall t (r :: [(* -> *) -> * -> *]).
Members
  '[Events t MpvEvent, AtomicState (Requests Value), Log, Embed IO]
  r =>
InMessage Value
-> Either Text (Either MpvEvent (Response Value)) -> Sem r ()
processMessage InMessage Value
msg (InMessage Value -> Either Text (Either MpvEvent (Response Value))
decodeInMessage InMessage Value
msg)