{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}


{- |
= Cast

A domain for interacting with Cast, Presentation API, and Remote Playback API
functionalities.
-}


module CDP.Domains.Cast (module CDP.Domains.Cast) where

import           Control.Applicative  ((<$>))
import           Control.Monad
import           Control.Monad.Loops
import           Control.Monad.Trans  (liftIO)
import qualified Data.Map             as M
import           Data.Maybe          
import Data.Functor.Identity
import Data.String
import qualified Data.Text as T
import qualified Data.List as List
import qualified Data.Text.IO         as TI
import qualified Data.Vector          as V
import Data.Aeson.Types (Parser(..))
import           Data.Aeson           (FromJSON (..), ToJSON (..), (.:), (.:?), (.=), (.!=), (.:!))
import qualified Data.Aeson           as A
import qualified Network.HTTP.Simple as Http
import qualified Network.URI          as Uri
import qualified Network.WebSockets as WS
import Control.Concurrent
import qualified Data.ByteString.Lazy as BS
import qualified Data.Map as Map
import Data.Proxy
import System.Random
import GHC.Generics
import Data.Char
import Data.Default

import CDP.Internal.Utils




-- | Type 'Cast.Sink'.
data CastSink = CastSink
  {
    CastSink -> Text
castSinkName :: T.Text,
    CastSink -> Text
castSinkId :: T.Text,
    -- | Text describing the current session. Present only if there is an active
    --   session on the sink.
    CastSink -> Maybe Text
castSinkSession :: Maybe T.Text
  }
  deriving (CastSink -> CastSink -> Bool
(CastSink -> CastSink -> Bool)
-> (CastSink -> CastSink -> Bool) -> Eq CastSink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CastSink -> CastSink -> Bool
$c/= :: CastSink -> CastSink -> Bool
== :: CastSink -> CastSink -> Bool
$c== :: CastSink -> CastSink -> Bool
Eq, Int -> CastSink -> ShowS
[CastSink] -> ShowS
CastSink -> String
(Int -> CastSink -> ShowS)
-> (CastSink -> String) -> ([CastSink] -> ShowS) -> Show CastSink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CastSink] -> ShowS
$cshowList :: [CastSink] -> ShowS
show :: CastSink -> String
$cshow :: CastSink -> String
showsPrec :: Int -> CastSink -> ShowS
$cshowsPrec :: Int -> CastSink -> ShowS
Show)
instance FromJSON CastSink where
  parseJSON :: Value -> Parser CastSink
parseJSON = String -> (Object -> Parser CastSink) -> Value -> Parser CastSink
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CastSink" ((Object -> Parser CastSink) -> Value -> Parser CastSink)
-> (Object -> Parser CastSink) -> Value -> Parser CastSink
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Maybe Text -> CastSink
CastSink
    (Text -> Text -> Maybe Text -> CastSink)
-> Parser Text -> Parser (Text -> Maybe Text -> CastSink)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser (Text -> Maybe Text -> CastSink)
-> Parser Text -> Parser (Maybe Text -> CastSink)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"id"
    Parser (Maybe Text -> CastSink)
-> Parser (Maybe Text) -> Parser CastSink
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"session"
instance ToJSON CastSink where
  toJSON :: CastSink -> Value
toJSON CastSink
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (CastSink -> Text
castSinkName CastSink
p),
    (Text
"id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (CastSink -> Text
castSinkId CastSink
p),
    (Text
"session" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CastSink -> Maybe Text
castSinkSession CastSink
p)
    ]

-- | Type of the 'Cast.sinksUpdated' event.
data CastSinksUpdated = CastSinksUpdated
  {
    CastSinksUpdated -> [CastSink]
castSinksUpdatedSinks :: [CastSink]
  }
  deriving (CastSinksUpdated -> CastSinksUpdated -> Bool
(CastSinksUpdated -> CastSinksUpdated -> Bool)
-> (CastSinksUpdated -> CastSinksUpdated -> Bool)
-> Eq CastSinksUpdated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CastSinksUpdated -> CastSinksUpdated -> Bool
$c/= :: CastSinksUpdated -> CastSinksUpdated -> Bool
== :: CastSinksUpdated -> CastSinksUpdated -> Bool
$c== :: CastSinksUpdated -> CastSinksUpdated -> Bool
Eq, Int -> CastSinksUpdated -> ShowS
[CastSinksUpdated] -> ShowS
CastSinksUpdated -> String
(Int -> CastSinksUpdated -> ShowS)
-> (CastSinksUpdated -> String)
-> ([CastSinksUpdated] -> ShowS)
-> Show CastSinksUpdated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CastSinksUpdated] -> ShowS
$cshowList :: [CastSinksUpdated] -> ShowS
show :: CastSinksUpdated -> String
$cshow :: CastSinksUpdated -> String
showsPrec :: Int -> CastSinksUpdated -> ShowS
$cshowsPrec :: Int -> CastSinksUpdated -> ShowS
Show)
instance FromJSON CastSinksUpdated where
  parseJSON :: Value -> Parser CastSinksUpdated
parseJSON = String
-> (Object -> Parser CastSinksUpdated)
-> Value
-> Parser CastSinksUpdated
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CastSinksUpdated" ((Object -> Parser CastSinksUpdated)
 -> Value -> Parser CastSinksUpdated)
-> (Object -> Parser CastSinksUpdated)
-> Value
-> Parser CastSinksUpdated
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CastSink] -> CastSinksUpdated
CastSinksUpdated
    ([CastSink] -> CastSinksUpdated)
-> Parser [CastSink] -> Parser CastSinksUpdated
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CastSink]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"sinks"
instance Event CastSinksUpdated where
  eventName :: Proxy CastSinksUpdated -> String
eventName Proxy CastSinksUpdated
_ = String
"Cast.sinksUpdated"

-- | Type of the 'Cast.issueUpdated' event.
data CastIssueUpdated = CastIssueUpdated
  {
    CastIssueUpdated -> Text
castIssueUpdatedIssueMessage :: T.Text
  }
  deriving (CastIssueUpdated -> CastIssueUpdated -> Bool
(CastIssueUpdated -> CastIssueUpdated -> Bool)
-> (CastIssueUpdated -> CastIssueUpdated -> Bool)
-> Eq CastIssueUpdated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CastIssueUpdated -> CastIssueUpdated -> Bool
$c/= :: CastIssueUpdated -> CastIssueUpdated -> Bool
== :: CastIssueUpdated -> CastIssueUpdated -> Bool
$c== :: CastIssueUpdated -> CastIssueUpdated -> Bool
Eq, Int -> CastIssueUpdated -> ShowS
[CastIssueUpdated] -> ShowS
CastIssueUpdated -> String
(Int -> CastIssueUpdated -> ShowS)
-> (CastIssueUpdated -> String)
-> ([CastIssueUpdated] -> ShowS)
-> Show CastIssueUpdated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CastIssueUpdated] -> ShowS
$cshowList :: [CastIssueUpdated] -> ShowS
show :: CastIssueUpdated -> String
$cshow :: CastIssueUpdated -> String
showsPrec :: Int -> CastIssueUpdated -> ShowS
$cshowsPrec :: Int -> CastIssueUpdated -> ShowS
Show)
instance FromJSON CastIssueUpdated where
  parseJSON :: Value -> Parser CastIssueUpdated
parseJSON = String
-> (Object -> Parser CastIssueUpdated)
-> Value
-> Parser CastIssueUpdated
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CastIssueUpdated" ((Object -> Parser CastIssueUpdated)
 -> Value -> Parser CastIssueUpdated)
-> (Object -> Parser CastIssueUpdated)
-> Value
-> Parser CastIssueUpdated
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> CastIssueUpdated
CastIssueUpdated
    (Text -> CastIssueUpdated)
-> Parser Text -> Parser CastIssueUpdated
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"issueMessage"
instance Event CastIssueUpdated where
  eventName :: Proxy CastIssueUpdated -> String
eventName Proxy CastIssueUpdated
_ = String
"Cast.issueUpdated"

-- | Starts observing for sinks that can be used for tab mirroring, and if set,
--   sinks compatible with |presentationUrl| as well. When sinks are found, a
--   |sinksUpdated| event is fired.
--   Also starts observing for issue messages. When an issue is added or removed,
--   an |issueUpdated| event is fired.

-- | Parameters of the 'Cast.enable' command.
data PCastEnable = PCastEnable
  {
    PCastEnable -> Maybe Text
pCastEnablePresentationUrl :: Maybe T.Text
  }
  deriving (PCastEnable -> PCastEnable -> Bool
(PCastEnable -> PCastEnable -> Bool)
-> (PCastEnable -> PCastEnable -> Bool) -> Eq PCastEnable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCastEnable -> PCastEnable -> Bool
$c/= :: PCastEnable -> PCastEnable -> Bool
== :: PCastEnable -> PCastEnable -> Bool
$c== :: PCastEnable -> PCastEnable -> Bool
Eq, Int -> PCastEnable -> ShowS
[PCastEnable] -> ShowS
PCastEnable -> String
(Int -> PCastEnable -> ShowS)
-> (PCastEnable -> String)
-> ([PCastEnable] -> ShowS)
-> Show PCastEnable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCastEnable] -> ShowS
$cshowList :: [PCastEnable] -> ShowS
show :: PCastEnable -> String
$cshow :: PCastEnable -> String
showsPrec :: Int -> PCastEnable -> ShowS
$cshowsPrec :: Int -> PCastEnable -> ShowS
Show)
pCastEnable
  :: PCastEnable
pCastEnable :: PCastEnable
pCastEnable
  = Maybe Text -> PCastEnable
PCastEnable
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PCastEnable where
  toJSON :: PCastEnable -> Value
toJSON PCastEnable
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"presentationUrl" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PCastEnable -> Maybe Text
pCastEnablePresentationUrl PCastEnable
p)
    ]
instance Command PCastEnable where
  type CommandResponse PCastEnable = ()
  commandName :: Proxy PCastEnable -> String
commandName Proxy PCastEnable
_ = String
"Cast.enable"
  fromJSON :: Proxy PCastEnable -> Value -> Result (CommandResponse PCastEnable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCastEnable -> Result ())
-> Proxy PCastEnable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCastEnable -> ()) -> Proxy PCastEnable -> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCastEnable -> ()
forall a b. a -> b -> a
const ()

-- | Stops observing for sinks and issues.

-- | Parameters of the 'Cast.disable' command.
data PCastDisable = PCastDisable
  deriving (PCastDisable -> PCastDisable -> Bool
(PCastDisable -> PCastDisable -> Bool)
-> (PCastDisable -> PCastDisable -> Bool) -> Eq PCastDisable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCastDisable -> PCastDisable -> Bool
$c/= :: PCastDisable -> PCastDisable -> Bool
== :: PCastDisable -> PCastDisable -> Bool
$c== :: PCastDisable -> PCastDisable -> Bool
Eq, Int -> PCastDisable -> ShowS
[PCastDisable] -> ShowS
PCastDisable -> String
(Int -> PCastDisable -> ShowS)
-> (PCastDisable -> String)
-> ([PCastDisable] -> ShowS)
-> Show PCastDisable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCastDisable] -> ShowS
$cshowList :: [PCastDisable] -> ShowS
show :: PCastDisable -> String
$cshow :: PCastDisable -> String
showsPrec :: Int -> PCastDisable -> ShowS
$cshowsPrec :: Int -> PCastDisable -> ShowS
Show)
pCastDisable
  :: PCastDisable
pCastDisable :: PCastDisable
pCastDisable
  = PCastDisable
PCastDisable
instance ToJSON PCastDisable where
  toJSON :: PCastDisable -> Value
toJSON PCastDisable
_ = Value
A.Null
instance Command PCastDisable where
  type CommandResponse PCastDisable = ()
  commandName :: Proxy PCastDisable -> String
commandName Proxy PCastDisable
_ = String
"Cast.disable"
  fromJSON :: Proxy PCastDisable
-> Value -> Result (CommandResponse PCastDisable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCastDisable -> Result ())
-> Proxy PCastDisable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCastDisable -> ()) -> Proxy PCastDisable -> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCastDisable -> ()
forall a b. a -> b -> a
const ()

-- | Sets a sink to be used when the web page requests the browser to choose a
--   sink via Presentation API, Remote Playback API, or Cast SDK.

-- | Parameters of the 'Cast.setSinkToUse' command.
data PCastSetSinkToUse = PCastSetSinkToUse
  {
    PCastSetSinkToUse -> Text
pCastSetSinkToUseSinkName :: T.Text
  }
  deriving (PCastSetSinkToUse -> PCastSetSinkToUse -> Bool
(PCastSetSinkToUse -> PCastSetSinkToUse -> Bool)
-> (PCastSetSinkToUse -> PCastSetSinkToUse -> Bool)
-> Eq PCastSetSinkToUse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCastSetSinkToUse -> PCastSetSinkToUse -> Bool
$c/= :: PCastSetSinkToUse -> PCastSetSinkToUse -> Bool
== :: PCastSetSinkToUse -> PCastSetSinkToUse -> Bool
$c== :: PCastSetSinkToUse -> PCastSetSinkToUse -> Bool
Eq, Int -> PCastSetSinkToUse -> ShowS
[PCastSetSinkToUse] -> ShowS
PCastSetSinkToUse -> String
(Int -> PCastSetSinkToUse -> ShowS)
-> (PCastSetSinkToUse -> String)
-> ([PCastSetSinkToUse] -> ShowS)
-> Show PCastSetSinkToUse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCastSetSinkToUse] -> ShowS
$cshowList :: [PCastSetSinkToUse] -> ShowS
show :: PCastSetSinkToUse -> String
$cshow :: PCastSetSinkToUse -> String
showsPrec :: Int -> PCastSetSinkToUse -> ShowS
$cshowsPrec :: Int -> PCastSetSinkToUse -> ShowS
Show)
pCastSetSinkToUse
  :: T.Text
  -> PCastSetSinkToUse
pCastSetSinkToUse :: Text -> PCastSetSinkToUse
pCastSetSinkToUse
  Text
arg_pCastSetSinkToUseSinkName
  = Text -> PCastSetSinkToUse
PCastSetSinkToUse
    Text
arg_pCastSetSinkToUseSinkName
instance ToJSON PCastSetSinkToUse where
  toJSON :: PCastSetSinkToUse -> Value
toJSON PCastSetSinkToUse
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"sinkName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PCastSetSinkToUse -> Text
pCastSetSinkToUseSinkName PCastSetSinkToUse
p)
    ]
instance Command PCastSetSinkToUse where
  type CommandResponse PCastSetSinkToUse = ()
  commandName :: Proxy PCastSetSinkToUse -> String
commandName Proxy PCastSetSinkToUse
_ = String
"Cast.setSinkToUse"
  fromJSON :: Proxy PCastSetSinkToUse
-> Value -> Result (CommandResponse PCastSetSinkToUse)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCastSetSinkToUse -> Result ())
-> Proxy PCastSetSinkToUse
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCastSetSinkToUse -> ())
-> Proxy PCastSetSinkToUse
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCastSetSinkToUse -> ()
forall a b. a -> b -> a
const ()

-- | Starts mirroring the desktop to the sink.

-- | Parameters of the 'Cast.startDesktopMirroring' command.
data PCastStartDesktopMirroring = PCastStartDesktopMirroring
  {
    PCastStartDesktopMirroring -> Text
pCastStartDesktopMirroringSinkName :: T.Text
  }
  deriving (PCastStartDesktopMirroring -> PCastStartDesktopMirroring -> Bool
(PCastStartDesktopMirroring -> PCastStartDesktopMirroring -> Bool)
-> (PCastStartDesktopMirroring
    -> PCastStartDesktopMirroring -> Bool)
-> Eq PCastStartDesktopMirroring
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCastStartDesktopMirroring -> PCastStartDesktopMirroring -> Bool
$c/= :: PCastStartDesktopMirroring -> PCastStartDesktopMirroring -> Bool
== :: PCastStartDesktopMirroring -> PCastStartDesktopMirroring -> Bool
$c== :: PCastStartDesktopMirroring -> PCastStartDesktopMirroring -> Bool
Eq, Int -> PCastStartDesktopMirroring -> ShowS
[PCastStartDesktopMirroring] -> ShowS
PCastStartDesktopMirroring -> String
(Int -> PCastStartDesktopMirroring -> ShowS)
-> (PCastStartDesktopMirroring -> String)
-> ([PCastStartDesktopMirroring] -> ShowS)
-> Show PCastStartDesktopMirroring
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCastStartDesktopMirroring] -> ShowS
$cshowList :: [PCastStartDesktopMirroring] -> ShowS
show :: PCastStartDesktopMirroring -> String
$cshow :: PCastStartDesktopMirroring -> String
showsPrec :: Int -> PCastStartDesktopMirroring -> ShowS
$cshowsPrec :: Int -> PCastStartDesktopMirroring -> ShowS
Show)
pCastStartDesktopMirroring
  :: T.Text
  -> PCastStartDesktopMirroring
pCastStartDesktopMirroring :: Text -> PCastStartDesktopMirroring
pCastStartDesktopMirroring
  Text
arg_pCastStartDesktopMirroringSinkName
  = Text -> PCastStartDesktopMirroring
PCastStartDesktopMirroring
    Text
arg_pCastStartDesktopMirroringSinkName
instance ToJSON PCastStartDesktopMirroring where
  toJSON :: PCastStartDesktopMirroring -> Value
toJSON PCastStartDesktopMirroring
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"sinkName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PCastStartDesktopMirroring -> Text
pCastStartDesktopMirroringSinkName PCastStartDesktopMirroring
p)
    ]
instance Command PCastStartDesktopMirroring where
  type CommandResponse PCastStartDesktopMirroring = ()
  commandName :: Proxy PCastStartDesktopMirroring -> String
commandName Proxy PCastStartDesktopMirroring
_ = String
"Cast.startDesktopMirroring"
  fromJSON :: Proxy PCastStartDesktopMirroring
-> Value -> Result (CommandResponse PCastStartDesktopMirroring)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCastStartDesktopMirroring -> Result ())
-> Proxy PCastStartDesktopMirroring
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCastStartDesktopMirroring -> ())
-> Proxy PCastStartDesktopMirroring
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCastStartDesktopMirroring -> ()
forall a b. a -> b -> a
const ()

-- | Starts mirroring the tab to the sink.

-- | Parameters of the 'Cast.startTabMirroring' command.
data PCastStartTabMirroring = PCastStartTabMirroring
  {
    PCastStartTabMirroring -> Text
pCastStartTabMirroringSinkName :: T.Text
  }
  deriving (PCastStartTabMirroring -> PCastStartTabMirroring -> Bool
(PCastStartTabMirroring -> PCastStartTabMirroring -> Bool)
-> (PCastStartTabMirroring -> PCastStartTabMirroring -> Bool)
-> Eq PCastStartTabMirroring
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCastStartTabMirroring -> PCastStartTabMirroring -> Bool
$c/= :: PCastStartTabMirroring -> PCastStartTabMirroring -> Bool
== :: PCastStartTabMirroring -> PCastStartTabMirroring -> Bool
$c== :: PCastStartTabMirroring -> PCastStartTabMirroring -> Bool
Eq, Int -> PCastStartTabMirroring -> ShowS
[PCastStartTabMirroring] -> ShowS
PCastStartTabMirroring -> String
(Int -> PCastStartTabMirroring -> ShowS)
-> (PCastStartTabMirroring -> String)
-> ([PCastStartTabMirroring] -> ShowS)
-> Show PCastStartTabMirroring
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCastStartTabMirroring] -> ShowS
$cshowList :: [PCastStartTabMirroring] -> ShowS
show :: PCastStartTabMirroring -> String
$cshow :: PCastStartTabMirroring -> String
showsPrec :: Int -> PCastStartTabMirroring -> ShowS
$cshowsPrec :: Int -> PCastStartTabMirroring -> ShowS
Show)
pCastStartTabMirroring
  :: T.Text
  -> PCastStartTabMirroring
pCastStartTabMirroring :: Text -> PCastStartTabMirroring
pCastStartTabMirroring
  Text
arg_pCastStartTabMirroringSinkName
  = Text -> PCastStartTabMirroring
PCastStartTabMirroring
    Text
arg_pCastStartTabMirroringSinkName
instance ToJSON PCastStartTabMirroring where
  toJSON :: PCastStartTabMirroring -> Value
toJSON PCastStartTabMirroring
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"sinkName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PCastStartTabMirroring -> Text
pCastStartTabMirroringSinkName PCastStartTabMirroring
p)
    ]
instance Command PCastStartTabMirroring where
  type CommandResponse PCastStartTabMirroring = ()
  commandName :: Proxy PCastStartTabMirroring -> String
commandName Proxy PCastStartTabMirroring
_ = String
"Cast.startTabMirroring"
  fromJSON :: Proxy PCastStartTabMirroring
-> Value -> Result (CommandResponse PCastStartTabMirroring)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCastStartTabMirroring -> Result ())
-> Proxy PCastStartTabMirroring
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCastStartTabMirroring -> ())
-> Proxy PCastStartTabMirroring
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCastStartTabMirroring -> ()
forall a b. a -> b -> a
const ()

-- | Stops the active Cast session on the sink.

-- | Parameters of the 'Cast.stopCasting' command.
data PCastStopCasting = PCastStopCasting
  {
    PCastStopCasting -> Text
pCastStopCastingSinkName :: T.Text
  }
  deriving (PCastStopCasting -> PCastStopCasting -> Bool
(PCastStopCasting -> PCastStopCasting -> Bool)
-> (PCastStopCasting -> PCastStopCasting -> Bool)
-> Eq PCastStopCasting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCastStopCasting -> PCastStopCasting -> Bool
$c/= :: PCastStopCasting -> PCastStopCasting -> Bool
== :: PCastStopCasting -> PCastStopCasting -> Bool
$c== :: PCastStopCasting -> PCastStopCasting -> Bool
Eq, Int -> PCastStopCasting -> ShowS
[PCastStopCasting] -> ShowS
PCastStopCasting -> String
(Int -> PCastStopCasting -> ShowS)
-> (PCastStopCasting -> String)
-> ([PCastStopCasting] -> ShowS)
-> Show PCastStopCasting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCastStopCasting] -> ShowS
$cshowList :: [PCastStopCasting] -> ShowS
show :: PCastStopCasting -> String
$cshow :: PCastStopCasting -> String
showsPrec :: Int -> PCastStopCasting -> ShowS
$cshowsPrec :: Int -> PCastStopCasting -> ShowS
Show)
pCastStopCasting
  :: T.Text
  -> PCastStopCasting
pCastStopCasting :: Text -> PCastStopCasting
pCastStopCasting
  Text
arg_pCastStopCastingSinkName
  = Text -> PCastStopCasting
PCastStopCasting
    Text
arg_pCastStopCastingSinkName
instance ToJSON PCastStopCasting where
  toJSON :: PCastStopCasting -> Value
toJSON PCastStopCasting
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"sinkName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PCastStopCasting -> Text
pCastStopCastingSinkName PCastStopCasting
p)
    ]
instance Command PCastStopCasting where
  type CommandResponse PCastStopCasting = ()
  commandName :: Proxy PCastStopCasting -> String
commandName Proxy PCastStopCasting
_ = String
"Cast.stopCasting"
  fromJSON :: Proxy PCastStopCasting
-> Value -> Result (CommandResponse PCastStopCasting)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCastStopCasting -> Result ())
-> Proxy PCastStopCasting
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCastStopCasting -> ())
-> Proxy PCastStopCasting
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCastStopCasting -> ()
forall a b. a -> b -> a
const ()