module Spotify.Types.Player where

import Spotify.Types.Internal.CustomJSON
import Spotify.Types.Misc
import Spotify.Types.Tracks

import Data.Aeson (FromJSON)
import Data.Text (Text)
import GHC.Generics (Generic)

data PlaybackState = PlaybackState
    { PlaybackState -> Device
device :: Device
    , PlaybackState -> Repeat
repeatState :: Repeat
    , PlaybackState -> Bool
shuffleState :: Bool
    , PlaybackState -> Context
context :: Context
    , PlaybackState -> Int
timestamp :: Int
    , PlaybackState -> Int
progressMs :: Int
    , PlaybackState -> Bool
isPlaying :: Bool
    , PlaybackState -> Track
item :: Track
    , PlaybackState -> Text
currentlyPlayingType :: Text
    , PlaybackState -> Actions
actions :: Actions
    }
    deriving (PlaybackState -> PlaybackState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlaybackState -> PlaybackState -> Bool
$c/= :: PlaybackState -> PlaybackState -> Bool
== :: PlaybackState -> PlaybackState -> Bool
$c== :: PlaybackState -> PlaybackState -> Bool
Eq, Eq PlaybackState
PlaybackState -> PlaybackState -> Bool
PlaybackState -> PlaybackState -> Ordering
PlaybackState -> PlaybackState -> PlaybackState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PlaybackState -> PlaybackState -> PlaybackState
$cmin :: PlaybackState -> PlaybackState -> PlaybackState
max :: PlaybackState -> PlaybackState -> PlaybackState
$cmax :: PlaybackState -> PlaybackState -> PlaybackState
>= :: PlaybackState -> PlaybackState -> Bool
$c>= :: PlaybackState -> PlaybackState -> Bool
> :: PlaybackState -> PlaybackState -> Bool
$c> :: PlaybackState -> PlaybackState -> Bool
<= :: PlaybackState -> PlaybackState -> Bool
$c<= :: PlaybackState -> PlaybackState -> Bool
< :: PlaybackState -> PlaybackState -> Bool
$c< :: PlaybackState -> PlaybackState -> Bool
compare :: PlaybackState -> PlaybackState -> Ordering
$ccompare :: PlaybackState -> PlaybackState -> Ordering
Ord, Int -> PlaybackState -> ShowS
[PlaybackState] -> ShowS
PlaybackState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlaybackState] -> ShowS
$cshowList :: [PlaybackState] -> ShowS
show :: PlaybackState -> String
$cshow :: PlaybackState -> String
showsPrec :: Int -> PlaybackState -> ShowS
$cshowsPrec :: Int -> PlaybackState -> ShowS
Show, forall x. Rep PlaybackState x -> PlaybackState
forall x. PlaybackState -> Rep PlaybackState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlaybackState x -> PlaybackState
$cfrom :: forall x. PlaybackState -> Rep PlaybackState x
Generic)
    deriving (Value -> Parser [PlaybackState]
Value -> Parser PlaybackState
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PlaybackState]
$cparseJSONList :: Value -> Parser [PlaybackState]
parseJSON :: Value -> Parser PlaybackState
$cparseJSON :: Value -> Parser PlaybackState
FromJSON) via CustomJSON PlaybackState
data Repeat
    = RepeatOff
    | RepeatContext
    | RepeatTrack
    deriving (Repeat -> Repeat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repeat -> Repeat -> Bool
$c/= :: Repeat -> Repeat -> Bool
== :: Repeat -> Repeat -> Bool
$c== :: Repeat -> Repeat -> Bool
Eq, Eq Repeat
Repeat -> Repeat -> Bool
Repeat -> Repeat -> Ordering
Repeat -> Repeat -> Repeat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Repeat -> Repeat -> Repeat
$cmin :: Repeat -> Repeat -> Repeat
max :: Repeat -> Repeat -> Repeat
$cmax :: Repeat -> Repeat -> Repeat
>= :: Repeat -> Repeat -> Bool
$c>= :: Repeat -> Repeat -> Bool
> :: Repeat -> Repeat -> Bool
$c> :: Repeat -> Repeat -> Bool
<= :: Repeat -> Repeat -> Bool
$c<= :: Repeat -> Repeat -> Bool
< :: Repeat -> Repeat -> Bool
$c< :: Repeat -> Repeat -> Bool
compare :: Repeat -> Repeat -> Ordering
$ccompare :: Repeat -> Repeat -> Ordering
Ord, Int -> Repeat -> ShowS
[Repeat] -> ShowS
Repeat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repeat] -> ShowS
$cshowList :: [Repeat] -> ShowS
show :: Repeat -> String
$cshow :: Repeat -> String
showsPrec :: Int -> Repeat -> ShowS
$cshowsPrec :: Int -> Repeat -> ShowS
Show, forall x. Rep Repeat x -> Repeat
forall x. Repeat -> Rep Repeat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Repeat x -> Repeat
$cfrom :: forall x. Repeat -> Rep Repeat x
Generic)
    deriving (Value -> Parser [Repeat]
Value -> Parser Repeat
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Repeat]
$cparseJSONList :: Value -> Parser [Repeat]
parseJSON :: Value -> Parser Repeat
$cparseJSON :: Value -> Parser Repeat
FromJSON) via CustomJSON Repeat

data CurrentlyPlayingTrack = CurrentlyPlayingTrack
    { CurrentlyPlayingTrack -> Context
context :: Context
    , CurrentlyPlayingTrack -> Int
timestamp :: Int
    , CurrentlyPlayingTrack -> Int
progressMs :: Int
    , CurrentlyPlayingTrack -> Bool
isPlaying :: Bool
    , CurrentlyPlayingTrack -> Track
item :: Track
    , CurrentlyPlayingTrack -> Text
currentlyPlayingType :: Text
    , CurrentlyPlayingTrack -> Actions
actions :: Actions
    }
    deriving (CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
$c/= :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
== :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
$c== :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
Eq, Eq CurrentlyPlayingTrack
CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Ordering
CurrentlyPlayingTrack
-> CurrentlyPlayingTrack -> CurrentlyPlayingTrack
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CurrentlyPlayingTrack
-> CurrentlyPlayingTrack -> CurrentlyPlayingTrack
$cmin :: CurrentlyPlayingTrack
-> CurrentlyPlayingTrack -> CurrentlyPlayingTrack
max :: CurrentlyPlayingTrack
-> CurrentlyPlayingTrack -> CurrentlyPlayingTrack
$cmax :: CurrentlyPlayingTrack
-> CurrentlyPlayingTrack -> CurrentlyPlayingTrack
>= :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
$c>= :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
> :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
$c> :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
<= :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
$c<= :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
< :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
$c< :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Bool
compare :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Ordering
$ccompare :: CurrentlyPlayingTrack -> CurrentlyPlayingTrack -> Ordering
Ord, Int -> CurrentlyPlayingTrack -> ShowS
[CurrentlyPlayingTrack] -> ShowS
CurrentlyPlayingTrack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrentlyPlayingTrack] -> ShowS
$cshowList :: [CurrentlyPlayingTrack] -> ShowS
show :: CurrentlyPlayingTrack -> String
$cshow :: CurrentlyPlayingTrack -> String
showsPrec :: Int -> CurrentlyPlayingTrack -> ShowS
$cshowsPrec :: Int -> CurrentlyPlayingTrack -> ShowS
Show, forall x. Rep CurrentlyPlayingTrack x -> CurrentlyPlayingTrack
forall x. CurrentlyPlayingTrack -> Rep CurrentlyPlayingTrack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CurrentlyPlayingTrack x -> CurrentlyPlayingTrack
$cfrom :: forall x. CurrentlyPlayingTrack -> Rep CurrentlyPlayingTrack x
Generic)
    deriving (Value -> Parser [CurrentlyPlayingTrack]
Value -> Parser CurrentlyPlayingTrack
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CurrentlyPlayingTrack]
$cparseJSONList :: Value -> Parser [CurrentlyPlayingTrack]
parseJSON :: Value -> Parser CurrentlyPlayingTrack
$cparseJSON :: Value -> Parser CurrentlyPlayingTrack
FromJSON) via CustomJSON CurrentlyPlayingTrack

data Device = Device
    { Device -> DeviceID
id :: DeviceID
    , Device -> Bool
isActive :: Bool
    , Device -> Bool
isPrivateSession :: Bool
    , Device -> Bool
isRestricted :: Bool
    , Device -> Text
name :: Text
    , Device -> Text
type_ :: Text
    , Device -> Int
volumePercent :: Int
    }
    deriving (Device -> Device -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c== :: Device -> Device -> Bool
Eq, Eq Device
Device -> Device -> Bool
Device -> Device -> Ordering
Device -> Device -> Device
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Device -> Device -> Device
$cmin :: Device -> Device -> Device
max :: Device -> Device -> Device
$cmax :: Device -> Device -> Device
>= :: Device -> Device -> Bool
$c>= :: Device -> Device -> Bool
> :: Device -> Device -> Bool
$c> :: Device -> Device -> Bool
<= :: Device -> Device -> Bool
$c<= :: Device -> Device -> Bool
< :: Device -> Device -> Bool
$c< :: Device -> Device -> Bool
compare :: Device -> Device -> Ordering
$ccompare :: Device -> Device -> Ordering
Ord, Int -> Device -> ShowS
[Device] -> ShowS
Device -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Device] -> ShowS
$cshowList :: [Device] -> ShowS
show :: Device -> String
$cshow :: Device -> String
showsPrec :: Int -> Device -> ShowS
$cshowsPrec :: Int -> Device -> ShowS
Show, forall x. Rep Device x -> Device
forall x. Device -> Rep Device x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Device x -> Device
$cfrom :: forall x. Device -> Rep Device x
Generic)
    deriving (Value -> Parser [Device]
Value -> Parser Device
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Device]
$cparseJSONList :: Value -> Parser [Device]
parseJSON :: Value -> Parser Device
$cparseJSON :: Value -> Parser Device
FromJSON) via CustomJSON Device

data Context = Context
    { Context -> Text
type_ :: Text
    , Context -> Href
href :: Href
    , Context -> ExternalURLs
externalUrls :: ExternalURLs
    , Context -> URI
uri :: URI
    }
    deriving (Context -> Context -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq, Eq Context
Context -> Context -> Bool
Context -> Context -> Ordering
Context -> Context -> Context
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Context -> Context -> Context
$cmin :: Context -> Context -> Context
max :: Context -> Context -> Context
$cmax :: Context -> Context -> Context
>= :: Context -> Context -> Bool
$c>= :: Context -> Context -> Bool
> :: Context -> Context -> Bool
$c> :: Context -> Context -> Bool
<= :: Context -> Context -> Bool
$c<= :: Context -> Context -> Bool
< :: Context -> Context -> Bool
$c< :: Context -> Context -> Bool
compare :: Context -> Context -> Ordering
$ccompare :: Context -> Context -> Ordering
Ord, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show, forall x. Rep Context x -> Context
forall x. Context -> Rep Context x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Context x -> Context
$cfrom :: forall x. Context -> Rep Context x
Generic)
    deriving (Value -> Parser [Context]
Value -> Parser Context
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Context]
$cparseJSONList :: Value -> Parser [Context]
parseJSON :: Value -> Parser Context
$cparseJSON :: Value -> Parser Context
FromJSON) via CustomJSON Context

data Actions = Actions
    { Actions -> Maybe Bool
interruptingPlayback :: Maybe Bool
    , Actions -> Maybe Bool
pausing :: Maybe Bool
    , Actions -> Maybe Bool
resuming :: Maybe Bool
    , Actions -> Maybe Bool
seeking :: Maybe Bool
    , Actions -> Maybe Bool
skippingNext :: Maybe Bool
    , Actions -> Maybe Bool
skippingPrev :: Maybe Bool
    , Actions -> Maybe Bool
togglingRepeatContext :: Maybe Bool
    , Actions -> Maybe Bool
togglingShuffle :: Maybe Bool
    , Actions -> Maybe Bool
togglingRepeatTrack :: Maybe Bool
    , Actions -> Maybe Bool
transferringPlayback :: Maybe Bool
    }
    deriving (Actions -> Actions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Actions -> Actions -> Bool
$c/= :: Actions -> Actions -> Bool
== :: Actions -> Actions -> Bool
$c== :: Actions -> Actions -> Bool
Eq, Eq Actions
Actions -> Actions -> Bool
Actions -> Actions -> Ordering
Actions -> Actions -> Actions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Actions -> Actions -> Actions
$cmin :: Actions -> Actions -> Actions
max :: Actions -> Actions -> Actions
$cmax :: Actions -> Actions -> Actions
>= :: Actions -> Actions -> Bool
$c>= :: Actions -> Actions -> Bool
> :: Actions -> Actions -> Bool
$c> :: Actions -> Actions -> Bool
<= :: Actions -> Actions -> Bool
$c<= :: Actions -> Actions -> Bool
< :: Actions -> Actions -> Bool
$c< :: Actions -> Actions -> Bool
compare :: Actions -> Actions -> Ordering
$ccompare :: Actions -> Actions -> Ordering
Ord, Int -> Actions -> ShowS
[Actions] -> ShowS
Actions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Actions] -> ShowS
$cshowList :: [Actions] -> ShowS
show :: Actions -> String
$cshow :: Actions -> String
showsPrec :: Int -> Actions -> ShowS
$cshowsPrec :: Int -> Actions -> ShowS
Show, forall x. Rep Actions x -> Actions
forall x. Actions -> Rep Actions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Actions x -> Actions
$cfrom :: forall x. Actions -> Rep Actions x
Generic)
    deriving (Value -> Parser [Actions]
Value -> Parser Actions
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Actions]
$cparseJSONList :: Value -> Parser [Actions]
parseJSON :: Value -> Parser Actions
$cparseJSON :: Value -> Parser Actions
FromJSON) via CustomJSON Actions