module Mpv.Data.MpvEvent where

import Data.Aeson (FromJSON (parseJSON), ToJSON, withObject, (.:))
import Data.Some (Some (Some))
import Polysemy.Conc (ChanConsumer)

import qualified Mpv.Data.Event as Event
import Mpv.Data.Event (Event)
import qualified Mpv.Data.EventName as EventName
import Mpv.Data.EventName (EventName)

data MpvEvent =
  MpvEvent {
    MpvEvent -> EventName
name :: EventName,
    MpvEvent -> Some Event
payload :: Some Event
  }
  deriving stock (MpvEvent -> MpvEvent -> Bool
(MpvEvent -> MpvEvent -> Bool)
-> (MpvEvent -> MpvEvent -> Bool) -> Eq MpvEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MpvEvent -> MpvEvent -> Bool
$c/= :: MpvEvent -> MpvEvent -> Bool
== :: MpvEvent -> MpvEvent -> Bool
$c== :: MpvEvent -> MpvEvent -> Bool
Eq, Int -> MpvEvent -> ShowS
[MpvEvent] -> ShowS
MpvEvent -> String
(Int -> MpvEvent -> ShowS)
-> (MpvEvent -> String) -> ([MpvEvent] -> ShowS) -> Show MpvEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MpvEvent] -> ShowS
$cshowList :: [MpvEvent] -> ShowS
show :: MpvEvent -> String
$cshow :: MpvEvent -> String
showsPrec :: Int -> MpvEvent -> ShowS
$cshowsPrec :: Int -> MpvEvent -> ShowS
Show, (forall x. MpvEvent -> Rep MpvEvent x)
-> (forall x. Rep MpvEvent x -> MpvEvent) -> Generic MpvEvent
forall x. Rep MpvEvent x -> MpvEvent
forall x. MpvEvent -> Rep MpvEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MpvEvent x -> MpvEvent
$cfrom :: forall x. MpvEvent -> Rep MpvEvent x
Generic)

instance FromJSON MpvEvent where
  parseJSON :: Value -> Parser MpvEvent
parseJSON Value
value =
    String -> (Object -> Parser MpvEvent) -> Value -> Parser MpvEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MpvEvent" Object -> Parser MpvEvent
parse Value
value
    where
      parse :: Object -> Parser MpvEvent
parse Object
o = do
        EventName
name <- Object
o Object -> Text -> Parser EventName
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event"
        Some Event
pl <- EventName -> Parser (Some Event)
payload EventName
name
        pure (EventName -> Some Event -> MpvEvent
MpvEvent EventName
name Some Event
pl)
      payload :: EventName -> Parser (Some Event)
payload = \case
        EventName
EventName.FileLoaded ->
          Some Event -> Parser (Some Event)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event 'FileLoaded -> Some Event
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some Event 'FileLoaded
Event.FileLoaded)
        EventName
EventName.EndFile ->
          Event 'EndFile -> Some Event
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Event 'EndFile -> Some Event)
-> (EndFile -> Event 'EndFile) -> EndFile -> Some Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndFile -> Event 'EndFile
Event.EndFile (EndFile -> Some Event) -> Parser EndFile -> Parser (Some Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser EndFile
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
        EventName
EventName.Pause ->
          Some Event -> Parser (Some Event)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event 'Pause -> Some Event
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some Event 'Pause
Event.Pause)
        EventName.Other Text
_ ->
          Some Event -> Parser (Some Event)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event 'Unknown -> Some Event
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Value -> Event 'Unknown
Event.Unknown Value
value))
        EventName
EventName.Unknown ->
          Some Event -> Parser (Some Event)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event 'Unknown -> Some Event
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Value -> Event 'Unknown
Event.Unknown Value
value))

instance ToJSON MpvEvent where

type MpvEventConsumer =
  ChanConsumer MpvEvent