module WebDriverPreCore.BiDi.Event
  ( mkSubscription,
    mkMultiSubscription,
    mkOffSpecSubscription,
    Subscription (..),
    Event (..),
  )
where

import Data.Aeson (FromJSON (..), Value (..), withObject, (.:))
import Data.Aeson.Types (Parser)
import Data.Text (Text, isPrefixOf, unpack)
import GHC.Generics (Generic)
import WebDriverPreCore.BiDi.BrowsingContext (BrowsingContextEvent (..))
import WebDriverPreCore.BiDi.CoreTypes (BrowsingContext, KnownSubscriptionType (..), SubscriptionType (..), UserContext, OffSpecSubscriptionType (..))
import WebDriverPreCore.BiDi.Input (FileDialogOpened)
import WebDriverPreCore.BiDi.Log (LogEvent)
import WebDriverPreCore.BiDi.Network (NetworkEvent (..))
import WebDriverPreCore.BiDi.Script (ScriptEvent (..))

mkSubscription ::
  forall m r.
  (FromJSON r) =>
  KnownSubscriptionType ->
  [BrowsingContext] ->
  [UserContext] ->
  (r -> m ()) ->
  Subscription m
mkSubscription :: forall (m :: * -> *) r.
FromJSON r =>
KnownSubscriptionType
-> [BrowsingContext]
-> [UserContext]
-> (r -> m ())
-> Subscription m
mkSubscription KnownSubscriptionType
subType =
  SubscriptionType
-> [BrowsingContext]
-> [UserContext]
-> (r -> m ())
-> Subscription m
forall (m :: * -> *) r.
FromJSON r =>
SubscriptionType
-> [BrowsingContext]
-> [UserContext]
-> (r -> m ())
-> Subscription m
SingleSubscription (KnownSubscriptionType -> SubscriptionType
KnownSubscriptionType KnownSubscriptionType
subType)

mkMultiSubscription ::
  [KnownSubscriptionType] ->
  [BrowsingContext] ->
  [UserContext] ->
  (Event -> m ()) ->
  Subscription m
mkMultiSubscription :: forall (m :: * -> *).
[KnownSubscriptionType]
-> [BrowsingContext]
-> [UserContext]
-> (Event -> m ())
-> Subscription m
mkMultiSubscription [KnownSubscriptionType]
ks =
  [SubscriptionType]
-> [BrowsingContext]
-> [UserContext]
-> (Event -> m ())
-> Subscription m
forall (m :: * -> *).
[SubscriptionType]
-> [BrowsingContext]
-> [UserContext]
-> (Event -> m ())
-> Subscription m
MultiSubscription (KnownSubscriptionType -> SubscriptionType
KnownSubscriptionType (KnownSubscriptionType -> SubscriptionType)
-> [KnownSubscriptionType] -> [SubscriptionType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KnownSubscriptionType]
ks)

-- | Create a subscription for off-specification event types.
--
-- Use this only as a fallback when a driver supports events not covered by
-- this library. Prefer using standard subscription constructors when available.
mkOffSpecSubscription ::
  [OffSpecSubscriptionType] ->
  [BrowsingContext] ->
  [UserContext] ->
  (Value -> m ()) ->
  Subscription m
mkOffSpecSubscription :: forall (m :: * -> *).
[OffSpecSubscriptionType]
-> [BrowsingContext]
-> [UserContext]
-> (Value -> m ())
-> Subscription m
mkOffSpecSubscription [OffSpecSubscriptionType]
ks =
  [SubscriptionType]
-> [BrowsingContext]
-> [UserContext]
-> (Value -> m ())
-> Subscription m
forall (m :: * -> *).
[SubscriptionType]
-> [BrowsingContext]
-> [UserContext]
-> (Value -> m ())
-> Subscription m
OffSpecSubscription (OffSpecSubscriptionType -> SubscriptionType
OffSpecSubscriptionType (OffSpecSubscriptionType -> SubscriptionType)
-> [OffSpecSubscriptionType] -> [SubscriptionType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OffSpecSubscriptionType]
ks)

data Subscription m where
  SingleSubscription ::
    forall m r.
    (FromJSON r) =>
    { forall (m :: * -> *). Subscription m -> SubscriptionType
subscriptionType :: SubscriptionType,
      forall (m :: * -> *). Subscription m -> [BrowsingContext]
browsingContexts :: [BrowsingContext],
      forall (m :: * -> *). Subscription m -> [UserContext]
userContexts :: [UserContext],
      ()
action :: r -> m ()
    } ->
    Subscription m
  MultiSubscription ::
    { forall (m :: * -> *). Subscription m -> [SubscriptionType]
subscriptionTypes :: [SubscriptionType],
      browsingContexts :: [BrowsingContext],
      userContexts :: [UserContext],
      forall (m :: * -> *). Subscription m -> Event -> m ()
nAction :: Event -> m ()
    } ->
    Subscription m
  OffSpecSubscription ::
    { subscriptionTypes :: [SubscriptionType],
      browsingContexts :: [BrowsingContext],
      userContexts :: [UserContext],
      forall (m :: * -> *). Subscription m -> Value -> m ()
nValueAction :: Value -> m ()
    } ->
    Subscription m

data Event
  = BrowsingContextEvent BrowsingContextEvent
  | InputEvent FileDialogOpened
  | LogEvent LogEvent
  | NetworkEvent NetworkEvent
  | ScriptEvent ScriptEvent
  deriving
    ( Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show,
      Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq,
      (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Event -> Rep Event x
from :: forall x. Event -> Rep Event x
$cto :: forall x. Rep Event x -> Event
to :: forall x. Rep Event x -> Event
Generic
    )

instance FromJSON Event where
  parseJSON :: Value -> Parser Event
  parseJSON :: Value -> Parser Event
parseJSON = String -> (Object -> Parser Event) -> Value -> Parser Event
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Event" ((Object -> Parser Event) -> Value -> Parser Event)
-> (Object -> Parser Event) -> Value -> Parser Event
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
    params <- o .: "params"
    let methodPrefix :: Text -> Bool
        methodPrefix = (Text -> Text -> Bool
`isPrefixOf` Text
m)
        parseVal :: forall a. (FromJSON a) => Parser a
        parseVal = Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        -- For input events, parse from params directly (consistent with SingleSubscription)
        parseParams :: forall a. (FromJSON a) => Parser a
        parseParams = Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
params
    if
      | methodPrefix "browsingContext" -> BrowsingContextEvent <$> parseVal
      | methodPrefix "input" -> InputEvent <$> parseParams
      | methodPrefix "log" -> LogEvent <$> parseVal
      | methodPrefix "network" -> NetworkEvent <$> parseVal
      | methodPrefix "script" -> ScriptEvent <$> parseVal
      | otherwise -> fail $ "Unknown event type: " <> unpack m