{- HLINT ignore "Use newtype instead of data" -}
{-# LANGUAGE UndecidableInstances #-}

module Spotify.Types.Misc where

import Spotify.Types.Internal.CustomJSON
import Spotify.Types.Internal.EnumJSON

import Data.Aeson (FromJSON, ToJSON)
import Data.List.Extra (enumerate)
import Data.Map (Map)
import Data.Proxy (Proxy (Proxy))
import Data.Set qualified as Set
import Data.String (IsString)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import GHC.Records (HasField)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Servant.API (ToHttpApiData)

data Copyright = Copyright
    { Copyright -> Text
text :: Text
    , Copyright -> CopyrightType
type_ :: CopyrightType
    }
    deriving (Copyright -> Copyright -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Copyright -> Copyright -> Bool
$c/= :: Copyright -> Copyright -> Bool
== :: Copyright -> Copyright -> Bool
$c== :: Copyright -> Copyright -> Bool
Eq, Eq Copyright
Copyright -> Copyright -> Bool
Copyright -> Copyright -> Ordering
Copyright -> Copyright -> Copyright
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 :: Copyright -> Copyright -> Copyright
$cmin :: Copyright -> Copyright -> Copyright
max :: Copyright -> Copyright -> Copyright
$cmax :: Copyright -> Copyright -> Copyright
>= :: Copyright -> Copyright -> Bool
$c>= :: Copyright -> Copyright -> Bool
> :: Copyright -> Copyright -> Bool
$c> :: Copyright -> Copyright -> Bool
<= :: Copyright -> Copyright -> Bool
$c<= :: Copyright -> Copyright -> Bool
< :: Copyright -> Copyright -> Bool
$c< :: Copyright -> Copyright -> Bool
compare :: Copyright -> Copyright -> Ordering
$ccompare :: Copyright -> Copyright -> Ordering
Ord, Int -> Copyright -> ShowS
[Copyright] -> ShowS
Copyright -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Copyright] -> ShowS
$cshowList :: [Copyright] -> ShowS
show :: Copyright -> String
$cshow :: Copyright -> String
showsPrec :: Int -> Copyright -> ShowS
$cshowsPrec :: Int -> Copyright -> ShowS
Show, forall x. Rep Copyright x -> Copyright
forall x. Copyright -> Rep Copyright x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Copyright x -> Copyright
$cfrom :: forall x. Copyright -> Rep Copyright x
Generic)
    deriving (Value -> Parser [Copyright]
Value -> Parser Copyright
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Copyright]
$cparseJSONList :: Value -> Parser [Copyright]
parseJSON :: Value -> Parser Copyright
$cparseJSON :: Value -> Parser Copyright
FromJSON) via CustomJSON Copyright

data CopyrightType
    = C
    | P
    deriving (CopyrightType -> CopyrightType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyrightType -> CopyrightType -> Bool
$c/= :: CopyrightType -> CopyrightType -> Bool
== :: CopyrightType -> CopyrightType -> Bool
$c== :: CopyrightType -> CopyrightType -> Bool
Eq, Eq CopyrightType
CopyrightType -> CopyrightType -> Bool
CopyrightType -> CopyrightType -> Ordering
CopyrightType -> CopyrightType -> CopyrightType
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 :: CopyrightType -> CopyrightType -> CopyrightType
$cmin :: CopyrightType -> CopyrightType -> CopyrightType
max :: CopyrightType -> CopyrightType -> CopyrightType
$cmax :: CopyrightType -> CopyrightType -> CopyrightType
>= :: CopyrightType -> CopyrightType -> Bool
$c>= :: CopyrightType -> CopyrightType -> Bool
> :: CopyrightType -> CopyrightType -> Bool
$c> :: CopyrightType -> CopyrightType -> Bool
<= :: CopyrightType -> CopyrightType -> Bool
$c<= :: CopyrightType -> CopyrightType -> Bool
< :: CopyrightType -> CopyrightType -> Bool
$c< :: CopyrightType -> CopyrightType -> Bool
compare :: CopyrightType -> CopyrightType -> Ordering
$ccompare :: CopyrightType -> CopyrightType -> Ordering
Ord, Int -> CopyrightType -> ShowS
[CopyrightType] -> ShowS
CopyrightType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyrightType] -> ShowS
$cshowList :: [CopyrightType] -> ShowS
show :: CopyrightType -> String
$cshow :: CopyrightType -> String
showsPrec :: Int -> CopyrightType -> ShowS
$cshowsPrec :: Int -> CopyrightType -> ShowS
Show, forall x. Rep CopyrightType x -> CopyrightType
forall x. CopyrightType -> Rep CopyrightType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopyrightType x -> CopyrightType
$cfrom :: forall x. CopyrightType -> Rep CopyrightType x
Generic)
    deriving (Value -> Parser [CopyrightType]
Value -> Parser CopyrightType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CopyrightType]
$cparseJSONList :: Value -> Parser [CopyrightType]
parseJSON :: Value -> Parser CopyrightType
$cparseJSON :: Value -> Parser CopyrightType
FromJSON)

data Error = Error
    { Error -> HTTPError
status :: HTTPError
    , Error -> Text
message :: Text
    }
    deriving (Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Eq Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
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 :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmax :: Error -> Error -> Error
>= :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c< :: Error -> Error -> Bool
compare :: Error -> Error -> Ordering
$ccompare :: Error -> Error -> Ordering
Ord, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Error x -> Error
$cfrom :: forall x. Error -> Rep Error x
Generic)
    deriving (Value -> Parser [Error]
Value -> Parser Error
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Error]
$cparseJSONList :: Value -> Parser [Error]
parseJSON :: Value -> Parser Error
$cparseJSON :: Value -> Parser Error
FromJSON) via CustomJSON Error

data Followers = Followers
    { Followers -> Maybe Text
href :: Maybe Text
    , Followers -> Int
total :: Int
    }
    deriving (Followers -> Followers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Followers -> Followers -> Bool
$c/= :: Followers -> Followers -> Bool
== :: Followers -> Followers -> Bool
$c== :: Followers -> Followers -> Bool
Eq, Eq Followers
Followers -> Followers -> Bool
Followers -> Followers -> Ordering
Followers -> Followers -> Followers
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 :: Followers -> Followers -> Followers
$cmin :: Followers -> Followers -> Followers
max :: Followers -> Followers -> Followers
$cmax :: Followers -> Followers -> Followers
>= :: Followers -> Followers -> Bool
$c>= :: Followers -> Followers -> Bool
> :: Followers -> Followers -> Bool
$c> :: Followers -> Followers -> Bool
<= :: Followers -> Followers -> Bool
$c<= :: Followers -> Followers -> Bool
< :: Followers -> Followers -> Bool
$c< :: Followers -> Followers -> Bool
compare :: Followers -> Followers -> Ordering
$ccompare :: Followers -> Followers -> Ordering
Ord, Int -> Followers -> ShowS
[Followers] -> ShowS
Followers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Followers] -> ShowS
$cshowList :: [Followers] -> ShowS
show :: Followers -> String
$cshow :: Followers -> String
showsPrec :: Int -> Followers -> ShowS
$cshowsPrec :: Int -> Followers -> ShowS
Show, forall x. Rep Followers x -> Followers
forall x. Followers -> Rep Followers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Followers x -> Followers
$cfrom :: forall x. Followers -> Rep Followers x
Generic)
    deriving (Value -> Parser [Followers]
Value -> Parser Followers
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Followers]
$cparseJSONList :: Value -> Parser [Followers]
parseJSON :: Value -> Parser Followers
$cparseJSON :: Value -> Parser Followers
FromJSON) via CustomJSON Followers

data Image = Image
    { Image -> Maybe Int
height :: Maybe Int
    , Image -> Text
url :: Text
    , Image -> Maybe Int
width :: Maybe Int
    }
    deriving (Image -> Image -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, Eq Image
Image -> Image -> Bool
Image -> Image -> Ordering
Image -> Image -> Image
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 :: Image -> Image -> Image
$cmin :: Image -> Image -> Image
max :: Image -> Image -> Image
$cmax :: Image -> Image -> Image
>= :: Image -> Image -> Bool
$c>= :: Image -> Image -> Bool
> :: Image -> Image -> Bool
$c> :: Image -> Image -> Bool
<= :: Image -> Image -> Bool
$c<= :: Image -> Image -> Bool
< :: Image -> Image -> Bool
$c< :: Image -> Image -> Bool
compare :: Image -> Image -> Ordering
$ccompare :: Image -> Image -> Ordering
Ord, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show, forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Image x -> Image
$cfrom :: forall x. Image -> Rep Image x
Generic)
    deriving (Value -> Parser [Image]
Value -> Parser Image
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Image]
$cparseJSONList :: Value -> Parser [Image]
parseJSON :: Value -> Parser Image
$cparseJSON :: Value -> Parser Image
FromJSON) via CustomJSON Image

data Paging a = Paging
    { forall a. Paging a -> Href
href :: Href
    , forall a. Paging a -> [a]
items :: [a]
    , forall a. Paging a -> Int
limit :: Int
    , forall a. Paging a -> Maybe Text
next :: Maybe Text
    , forall a. Paging a -> Int
offset :: Int
    , forall a. Paging a -> Maybe Text
previous :: Maybe Text
    , forall a. Paging a -> Int
total :: Int
    }
    deriving (Paging a -> Paging a -> Bool
forall a. Eq a => Paging a -> Paging a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Paging a -> Paging a -> Bool
$c/= :: forall a. Eq a => Paging a -> Paging a -> Bool
== :: Paging a -> Paging a -> Bool
$c== :: forall a. Eq a => Paging a -> Paging a -> Bool
Eq, Paging a -> Paging a -> Bool
Paging a -> Paging a -> Ordering
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
forall {a}. Ord a => Eq (Paging a)
forall a. Ord a => Paging a -> Paging a -> Bool
forall a. Ord a => Paging a -> Paging a -> Ordering
forall a. Ord a => Paging a -> Paging a -> Paging a
min :: Paging a -> Paging a -> Paging a
$cmin :: forall a. Ord a => Paging a -> Paging a -> Paging a
max :: Paging a -> Paging a -> Paging a
$cmax :: forall a. Ord a => Paging a -> Paging a -> Paging a
>= :: Paging a -> Paging a -> Bool
$c>= :: forall a. Ord a => Paging a -> Paging a -> Bool
> :: Paging a -> Paging a -> Bool
$c> :: forall a. Ord a => Paging a -> Paging a -> Bool
<= :: Paging a -> Paging a -> Bool
$c<= :: forall a. Ord a => Paging a -> Paging a -> Bool
< :: Paging a -> Paging a -> Bool
$c< :: forall a. Ord a => Paging a -> Paging a -> Bool
compare :: Paging a -> Paging a -> Ordering
$ccompare :: forall a. Ord a => Paging a -> Paging a -> Ordering
Ord, Int -> Paging a -> ShowS
forall a. Show a => Int -> Paging a -> ShowS
forall a. Show a => [Paging a] -> ShowS
forall a. Show a => Paging a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Paging a] -> ShowS
$cshowList :: forall a. Show a => [Paging a] -> ShowS
show :: Paging a -> String
$cshow :: forall a. Show a => Paging a -> String
showsPrec :: Int -> Paging a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Paging a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Paging a) x -> Paging a
forall a x. Paging a -> Rep (Paging a) x
$cto :: forall a x. Rep (Paging a) x -> Paging a
$cfrom :: forall a x. Paging a -> Rep (Paging a) x
Generic)
    deriving (Value -> Parser [Paging a]
Value -> Parser (Paging a)
forall a. (FromJSON a, Typeable a) => Value -> Parser [Paging a]
forall a. (FromJSON a, Typeable a) => Value -> Parser (Paging a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Paging a]
$cparseJSONList :: forall a. (FromJSON a, Typeable a) => Value -> Parser [Paging a]
parseJSON :: Value -> Parser (Paging a)
$cparseJSON :: forall a. (FromJSON a, Typeable a) => Value -> Parser (Paging a)
FromJSON) via CustomJSON (Paging a)

data Tracks = Tracks
    { Tracks -> Maybe Text
href :: Maybe Text
    , Tracks -> Int
total :: Int
    }
    deriving (Tracks -> Tracks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tracks -> Tracks -> Bool
$c/= :: Tracks -> Tracks -> Bool
== :: Tracks -> Tracks -> Bool
$c== :: Tracks -> Tracks -> Bool
Eq, Eq Tracks
Tracks -> Tracks -> Bool
Tracks -> Tracks -> Ordering
Tracks -> Tracks -> Tracks
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 :: Tracks -> Tracks -> Tracks
$cmin :: Tracks -> Tracks -> Tracks
max :: Tracks -> Tracks -> Tracks
$cmax :: Tracks -> Tracks -> Tracks
>= :: Tracks -> Tracks -> Bool
$c>= :: Tracks -> Tracks -> Bool
> :: Tracks -> Tracks -> Bool
$c> :: Tracks -> Tracks -> Bool
<= :: Tracks -> Tracks -> Bool
$c<= :: Tracks -> Tracks -> Bool
< :: Tracks -> Tracks -> Bool
$c< :: Tracks -> Tracks -> Bool
compare :: Tracks -> Tracks -> Ordering
$ccompare :: Tracks -> Tracks -> Ordering
Ord, Int -> Tracks -> ShowS
[Tracks] -> ShowS
Tracks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tracks] -> ShowS
$cshowList :: [Tracks] -> ShowS
show :: Tracks -> String
$cshow :: Tracks -> String
showsPrec :: Int -> Tracks -> ShowS
$cshowsPrec :: Int -> Tracks -> ShowS
Show, forall x. Rep Tracks x -> Tracks
forall x. Tracks -> Rep Tracks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tracks x -> Tracks
$cfrom :: forall x. Tracks -> Rep Tracks x
Generic)
    deriving (Value -> Parser [Tracks]
Value -> Parser Tracks
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Tracks]
$cparseJSONList :: Value -> Parser [Tracks]
parseJSON :: Value -> Parser Tracks
$cparseJSON :: Value -> Parser Tracks
FromJSON) via CustomJSON Tracks

data DatePrecision
    = DatePrecisionYear
    | DatePrecisionMonth
    | DatePrecisionDay
    deriving (DatePrecision -> DatePrecision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DatePrecision -> DatePrecision -> Bool
$c/= :: DatePrecision -> DatePrecision -> Bool
== :: DatePrecision -> DatePrecision -> Bool
$c== :: DatePrecision -> DatePrecision -> Bool
Eq, Eq DatePrecision
DatePrecision -> DatePrecision -> Bool
DatePrecision -> DatePrecision -> Ordering
DatePrecision -> DatePrecision -> DatePrecision
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 :: DatePrecision -> DatePrecision -> DatePrecision
$cmin :: DatePrecision -> DatePrecision -> DatePrecision
max :: DatePrecision -> DatePrecision -> DatePrecision
$cmax :: DatePrecision -> DatePrecision -> DatePrecision
>= :: DatePrecision -> DatePrecision -> Bool
$c>= :: DatePrecision -> DatePrecision -> Bool
> :: DatePrecision -> DatePrecision -> Bool
$c> :: DatePrecision -> DatePrecision -> Bool
<= :: DatePrecision -> DatePrecision -> Bool
$c<= :: DatePrecision -> DatePrecision -> Bool
< :: DatePrecision -> DatePrecision -> Bool
$c< :: DatePrecision -> DatePrecision -> Bool
compare :: DatePrecision -> DatePrecision -> Ordering
$ccompare :: DatePrecision -> DatePrecision -> Ordering
Ord, Int -> DatePrecision -> ShowS
[DatePrecision] -> ShowS
DatePrecision -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DatePrecision] -> ShowS
$cshowList :: [DatePrecision] -> ShowS
show :: DatePrecision -> String
$cshow :: DatePrecision -> String
showsPrec :: Int -> DatePrecision -> ShowS
$cshowsPrec :: Int -> DatePrecision -> ShowS
Show, forall x. Rep DatePrecision x -> DatePrecision
forall x. DatePrecision -> Rep DatePrecision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DatePrecision x -> DatePrecision
$cfrom :: forall x. DatePrecision -> Rep DatePrecision x
Generic)
    deriving (Value -> Parser [DatePrecision]
Value -> Parser DatePrecision
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [DatePrecision]
$cparseJSONList :: Value -> Parser [DatePrecision]
parseJSON :: Value -> Parser DatePrecision
$cparseJSON :: Value -> Parser DatePrecision
FromJSON) via CustomJSON DatePrecision

data Key
    = KeyC
    | KeyCSharp
    | KeyD
    | KeyDSharp
    | KeyE
    | KeyF
    | KeyFSharp
    | KeyG
    | KeyGSharp
    | KeyA
    | KeyASharp
    | KeyB
    deriving (Key -> Key -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
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 :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
Ord, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
Generic, Int -> Key
Key -> Int
Key -> [Key]
Key -> Key
Key -> Key -> [Key]
Key -> Key -> Key -> [Key]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Key -> Key -> Key -> [Key]
$cenumFromThenTo :: Key -> Key -> Key -> [Key]
enumFromTo :: Key -> Key -> [Key]
$cenumFromTo :: Key -> Key -> [Key]
enumFromThen :: Key -> Key -> [Key]
$cenumFromThen :: Key -> Key -> [Key]
enumFrom :: Key -> [Key]
$cenumFrom :: Key -> [Key]
fromEnum :: Key -> Int
$cfromEnum :: Key -> Int
toEnum :: Int -> Key
$ctoEnum :: Int -> Key
pred :: Key -> Key
$cpred :: Key -> Key
succ :: Key -> Key
$csucc :: Key -> Key
Enum)
    deriving (Value -> Parser [Key]
Value -> Parser Key
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Key]
$cparseJSONList :: Value -> Parser [Key]
parseJSON :: Value -> Parser Key
$cparseJSON :: Value -> Parser Key
FromJSON) via EnumJSON Key

data TrackLink = TrackLink
    { TrackLink -> ExternalURLs
externalUrls :: ExternalURLs
    , TrackLink -> Href
href :: Href
    , TrackLink -> TrackID
id :: TrackID
    , TrackLink -> Maybe Text
url :: Maybe Text
    }
    deriving (TrackLink -> TrackLink -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrackLink -> TrackLink -> Bool
$c/= :: TrackLink -> TrackLink -> Bool
== :: TrackLink -> TrackLink -> Bool
$c== :: TrackLink -> TrackLink -> Bool
Eq, Eq TrackLink
TrackLink -> TrackLink -> Bool
TrackLink -> TrackLink -> Ordering
TrackLink -> TrackLink -> TrackLink
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 :: TrackLink -> TrackLink -> TrackLink
$cmin :: TrackLink -> TrackLink -> TrackLink
max :: TrackLink -> TrackLink -> TrackLink
$cmax :: TrackLink -> TrackLink -> TrackLink
>= :: TrackLink -> TrackLink -> Bool
$c>= :: TrackLink -> TrackLink -> Bool
> :: TrackLink -> TrackLink -> Bool
$c> :: TrackLink -> TrackLink -> Bool
<= :: TrackLink -> TrackLink -> Bool
$c<= :: TrackLink -> TrackLink -> Bool
< :: TrackLink -> TrackLink -> Bool
$c< :: TrackLink -> TrackLink -> Bool
compare :: TrackLink -> TrackLink -> Ordering
$ccompare :: TrackLink -> TrackLink -> Ordering
Ord, Int -> TrackLink -> ShowS
[TrackLink] -> ShowS
TrackLink -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrackLink] -> ShowS
$cshowList :: [TrackLink] -> ShowS
show :: TrackLink -> String
$cshow :: TrackLink -> String
showsPrec :: Int -> TrackLink -> ShowS
$cshowsPrec :: Int -> TrackLink -> ShowS
Show, forall x. Rep TrackLink x -> TrackLink
forall x. TrackLink -> Rep TrackLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TrackLink x -> TrackLink
$cfrom :: forall x. TrackLink -> Rep TrackLink x
Generic)
    deriving (Value -> Parser [TrackLink]
Value -> Parser TrackLink
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TrackLink]
$cparseJSONList :: Value -> Parser [TrackLink]
parseJSON :: Value -> Parser TrackLink
$cparseJSON :: Value -> Parser TrackLink
FromJSON) via CustomJSON TrackLink

data AlbumGroup
    = GroupAlbum
    | GroupSingle
    | GroupCompilation
    | AppearsOn
    deriving (AlbumGroup -> AlbumGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlbumGroup -> AlbumGroup -> Bool
$c/= :: AlbumGroup -> AlbumGroup -> Bool
== :: AlbumGroup -> AlbumGroup -> Bool
$c== :: AlbumGroup -> AlbumGroup -> Bool
Eq, Eq AlbumGroup
AlbumGroup -> AlbumGroup -> Bool
AlbumGroup -> AlbumGroup -> Ordering
AlbumGroup -> AlbumGroup -> AlbumGroup
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 :: AlbumGroup -> AlbumGroup -> AlbumGroup
$cmin :: AlbumGroup -> AlbumGroup -> AlbumGroup
max :: AlbumGroup -> AlbumGroup -> AlbumGroup
$cmax :: AlbumGroup -> AlbumGroup -> AlbumGroup
>= :: AlbumGroup -> AlbumGroup -> Bool
$c>= :: AlbumGroup -> AlbumGroup -> Bool
> :: AlbumGroup -> AlbumGroup -> Bool
$c> :: AlbumGroup -> AlbumGroup -> Bool
<= :: AlbumGroup -> AlbumGroup -> Bool
$c<= :: AlbumGroup -> AlbumGroup -> Bool
< :: AlbumGroup -> AlbumGroup -> Bool
$c< :: AlbumGroup -> AlbumGroup -> Bool
compare :: AlbumGroup -> AlbumGroup -> Ordering
$ccompare :: AlbumGroup -> AlbumGroup -> Ordering
Ord, Int -> AlbumGroup -> ShowS
[AlbumGroup] -> ShowS
AlbumGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlbumGroup] -> ShowS
$cshowList :: [AlbumGroup] -> ShowS
show :: AlbumGroup -> String
$cshow :: AlbumGroup -> String
showsPrec :: Int -> AlbumGroup -> ShowS
$cshowsPrec :: Int -> AlbumGroup -> ShowS
Show, forall x. Rep AlbumGroup x -> AlbumGroup
forall x. AlbumGroup -> Rep AlbumGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AlbumGroup x -> AlbumGroup
$cfrom :: forall x. AlbumGroup -> Rep AlbumGroup x
Generic)
    deriving (Value -> Parser [AlbumGroup]
Value -> Parser AlbumGroup
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AlbumGroup]
$cparseJSONList :: Value -> Parser [AlbumGroup]
parseJSON :: Value -> Parser AlbumGroup
$cparseJSON :: Value -> Parser AlbumGroup
FromJSON) via CustomJSON AlbumGroup

data AlbumType
    = AlbumTypeAlbum
    | AlbumTypeSingle
    | AlbumTypeCompilation
    deriving (AlbumType -> AlbumType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlbumType -> AlbumType -> Bool
$c/= :: AlbumType -> AlbumType -> Bool
== :: AlbumType -> AlbumType -> Bool
$c== :: AlbumType -> AlbumType -> Bool
Eq, Eq AlbumType
AlbumType -> AlbumType -> Bool
AlbumType -> AlbumType -> Ordering
AlbumType -> AlbumType -> AlbumType
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 :: AlbumType -> AlbumType -> AlbumType
$cmin :: AlbumType -> AlbumType -> AlbumType
max :: AlbumType -> AlbumType -> AlbumType
$cmax :: AlbumType -> AlbumType -> AlbumType
>= :: AlbumType -> AlbumType -> Bool
$c>= :: AlbumType -> AlbumType -> Bool
> :: AlbumType -> AlbumType -> Bool
$c> :: AlbumType -> AlbumType -> Bool
<= :: AlbumType -> AlbumType -> Bool
$c<= :: AlbumType -> AlbumType -> Bool
< :: AlbumType -> AlbumType -> Bool
$c< :: AlbumType -> AlbumType -> Bool
compare :: AlbumType -> AlbumType -> Ordering
$ccompare :: AlbumType -> AlbumType -> Ordering
Ord, Int -> AlbumType -> ShowS
[AlbumType] -> ShowS
AlbumType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlbumType] -> ShowS
$cshowList :: [AlbumType] -> ShowS
show :: AlbumType -> String
$cshow :: AlbumType -> String
showsPrec :: Int -> AlbumType -> ShowS
$cshowsPrec :: Int -> AlbumType -> ShowS
Show, forall x. Rep AlbumType x -> AlbumType
forall x. AlbumType -> Rep AlbumType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AlbumType x -> AlbumType
$cfrom :: forall x. AlbumType -> Rep AlbumType x
Generic)
    deriving (Value -> Parser [AlbumType]
Value -> Parser AlbumType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AlbumType]
$cparseJSONList :: Value -> Parser [AlbumType]
parseJSON :: Value -> Parser AlbumType
$cparseJSON :: Value -> Parser AlbumType
FromJSON) via CustomJSON AlbumType

data ExplicitContent = ExplicitContent
    { ExplicitContent -> Bool
filterEnabled :: Bool
    , ExplicitContent -> Bool
filterLocked :: Bool
    }
    deriving (ExplicitContent -> ExplicitContent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExplicitContent -> ExplicitContent -> Bool
$c/= :: ExplicitContent -> ExplicitContent -> Bool
== :: ExplicitContent -> ExplicitContent -> Bool
$c== :: ExplicitContent -> ExplicitContent -> Bool
Eq, Eq ExplicitContent
ExplicitContent -> ExplicitContent -> Bool
ExplicitContent -> ExplicitContent -> Ordering
ExplicitContent -> ExplicitContent -> ExplicitContent
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 :: ExplicitContent -> ExplicitContent -> ExplicitContent
$cmin :: ExplicitContent -> ExplicitContent -> ExplicitContent
max :: ExplicitContent -> ExplicitContent -> ExplicitContent
$cmax :: ExplicitContent -> ExplicitContent -> ExplicitContent
>= :: ExplicitContent -> ExplicitContent -> Bool
$c>= :: ExplicitContent -> ExplicitContent -> Bool
> :: ExplicitContent -> ExplicitContent -> Bool
$c> :: ExplicitContent -> ExplicitContent -> Bool
<= :: ExplicitContent -> ExplicitContent -> Bool
$c<= :: ExplicitContent -> ExplicitContent -> Bool
< :: ExplicitContent -> ExplicitContent -> Bool
$c< :: ExplicitContent -> ExplicitContent -> Bool
compare :: ExplicitContent -> ExplicitContent -> Ordering
$ccompare :: ExplicitContent -> ExplicitContent -> Ordering
Ord, Int -> ExplicitContent -> ShowS
[ExplicitContent] -> ShowS
ExplicitContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExplicitContent] -> ShowS
$cshowList :: [ExplicitContent] -> ShowS
show :: ExplicitContent -> String
$cshow :: ExplicitContent -> String
showsPrec :: Int -> ExplicitContent -> ShowS
$cshowsPrec :: Int -> ExplicitContent -> ShowS
Show, forall x. Rep ExplicitContent x -> ExplicitContent
forall x. ExplicitContent -> Rep ExplicitContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExplicitContent x -> ExplicitContent
$cfrom :: forall x. ExplicitContent -> Rep ExplicitContent x
Generic)
    deriving (Value -> Parser [ExplicitContent]
Value -> Parser ExplicitContent
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExplicitContent]
$cparseJSONList :: Value -> Parser [ExplicitContent]
parseJSON :: Value -> Parser ExplicitContent
$cparseJSON :: Value -> Parser ExplicitContent
FromJSON) via CustomJSON ExplicitContent

data Product
    = Premium
    | Free
    deriving (Product -> Product -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Product -> Product -> Bool
$c/= :: Product -> Product -> Bool
== :: Product -> Product -> Bool
$c== :: Product -> Product -> Bool
Eq, Eq Product
Product -> Product -> Bool
Product -> Product -> Ordering
Product -> Product -> Product
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 :: Product -> Product -> Product
$cmin :: Product -> Product -> Product
max :: Product -> Product -> Product
$cmax :: Product -> Product -> Product
>= :: Product -> Product -> Bool
$c>= :: Product -> Product -> Bool
> :: Product -> Product -> Bool
$c> :: Product -> Product -> Bool
<= :: Product -> Product -> Bool
$c<= :: Product -> Product -> Bool
< :: Product -> Product -> Bool
$c< :: Product -> Product -> Bool
compare :: Product -> Product -> Ordering
$ccompare :: Product -> Product -> Ordering
Ord, Int -> Product -> ShowS
[Product] -> ShowS
Product -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Product] -> ShowS
$cshowList :: [Product] -> ShowS
show :: Product -> String
$cshow :: Product -> String
showsPrec :: Int -> Product -> ShowS
$cshowsPrec :: Int -> Product -> ShowS
Show, forall x. Rep Product x -> Product
forall x. Product -> Rep Product x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Product x -> Product
$cfrom :: forall x. Product -> Rep Product x
Generic)
    deriving (Value -> Parser [Product]
Value -> Parser Product
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Product]
$cparseJSONList :: Value -> Parser [Product]
parseJSON :: Value -> Parser Product
$cparseJSON :: Value -> Parser Product
FromJSON) via CustomJSON Product

data Offset = Offset
    { Offset -> Int
position :: Int
    , Offset -> Maybe URI
uri :: Maybe URI
    }
    deriving (Offset -> Offset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offset -> Offset -> Bool
$c/= :: Offset -> Offset -> Bool
== :: Offset -> Offset -> Bool
$c== :: Offset -> Offset -> Bool
Eq, Eq Offset
Offset -> Offset -> Bool
Offset -> Offset -> Ordering
Offset -> Offset -> Offset
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 :: Offset -> Offset -> Offset
$cmin :: Offset -> Offset -> Offset
max :: Offset -> Offset -> Offset
$cmax :: Offset -> Offset -> Offset
>= :: Offset -> Offset -> Bool
$c>= :: Offset -> Offset -> Bool
> :: Offset -> Offset -> Bool
$c> :: Offset -> Offset -> Bool
<= :: Offset -> Offset -> Bool
$c<= :: Offset -> Offset -> Bool
< :: Offset -> Offset -> Bool
$c< :: Offset -> Offset -> Bool
compare :: Offset -> Offset -> Ordering
$ccompare :: Offset -> Offset -> Ordering
Ord, Int -> Offset -> ShowS
[Offset] -> ShowS
Offset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Offset] -> ShowS
$cshowList :: [Offset] -> ShowS
show :: Offset -> String
$cshow :: Offset -> String
showsPrec :: Int -> Offset -> ShowS
$cshowsPrec :: Int -> Offset -> ShowS
Show, forall x. Rep Offset x -> Offset
forall x. Offset -> Rep Offset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Offset x -> Offset
$cfrom :: forall x. Offset -> Rep Offset x
Generic)
    deriving ([Offset] -> Encoding
[Offset] -> Value
Offset -> Encoding
Offset -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Offset] -> Encoding
$ctoEncodingList :: [Offset] -> Encoding
toJSONList :: [Offset] -> Value
$ctoJSONList :: [Offset] -> Value
toEncoding :: Offset -> Encoding
$ctoEncoding :: Offset -> Encoding
toJSON :: Offset -> Value
$ctoJSON :: Offset -> Value
ToJSON)

newtype Market = Market {Market -> Text
unwrap :: Text}
    deriving newtype (Market -> Market -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Market -> Market -> Bool
$c/= :: Market -> Market -> Bool
== :: Market -> Market -> Bool
$c== :: Market -> Market -> Bool
Eq, Eq Market
Market -> Market -> Bool
Market -> Market -> Ordering
Market -> Market -> Market
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 :: Market -> Market -> Market
$cmin :: Market -> Market -> Market
max :: Market -> Market -> Market
$cmax :: Market -> Market -> Market
>= :: Market -> Market -> Bool
$c>= :: Market -> Market -> Bool
> :: Market -> Market -> Bool
$c> :: Market -> Market -> Bool
<= :: Market -> Market -> Bool
$c<= :: Market -> Market -> Bool
< :: Market -> Market -> Bool
$c< :: Market -> Market -> Bool
compare :: Market -> Market -> Ordering
$ccompare :: Market -> Market -> Ordering
Ord, Int -> Market -> ShowS
[Market] -> ShowS
Market -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Market] -> ShowS
$cshowList :: [Market] -> ShowS
show :: Market -> String
$cshow :: Market -> String
showsPrec :: Int -> Market -> ShowS
$cshowsPrec :: Int -> Market -> ShowS
Show, Market -> Builder
Market -> ByteString
Market -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: Market -> Builder
$ctoEncodedQueryParam :: Market -> Builder
toQueryParam :: Market -> Text
$ctoQueryParam :: Market -> Text
toHeader :: Market -> ByteString
$ctoHeader :: Market -> ByteString
toEncodedUrlPiece :: Market -> Builder
$ctoEncodedUrlPiece :: Market -> Builder
toUrlPiece :: Market -> Text
$ctoUrlPiece :: Market -> Text
ToHttpApiData, String -> Market
forall a. (String -> a) -> IsString a
fromString :: String -> Market
$cfromString :: String -> Market
IsString)

newtype Genre = Genre {Genre -> Text
unwrap :: Text}
    deriving newtype (Genre -> Genre -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Genre -> Genre -> Bool
$c/= :: Genre -> Genre -> Bool
== :: Genre -> Genre -> Bool
$c== :: Genre -> Genre -> Bool
Eq, Eq Genre
Genre -> Genre -> Bool
Genre -> Genre -> Ordering
Genre -> Genre -> Genre
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 :: Genre -> Genre -> Genre
$cmin :: Genre -> Genre -> Genre
max :: Genre -> Genre -> Genre
$cmax :: Genre -> Genre -> Genre
>= :: Genre -> Genre -> Bool
$c>= :: Genre -> Genre -> Bool
> :: Genre -> Genre -> Bool
$c> :: Genre -> Genre -> Bool
<= :: Genre -> Genre -> Bool
$c<= :: Genre -> Genre -> Bool
< :: Genre -> Genre -> Bool
$c< :: Genre -> Genre -> Bool
compare :: Genre -> Genre -> Ordering
$ccompare :: Genre -> Genre -> Ordering
Ord, Int -> Genre -> ShowS
[Genre] -> ShowS
Genre -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Genre] -> ShowS
$cshowList :: [Genre] -> ShowS
show :: Genre -> String
$cshow :: Genre -> String
showsPrec :: Int -> Genre -> ShowS
$cshowsPrec :: Int -> Genre -> ShowS
Show, Value -> Parser [Genre]
Value -> Parser Genre
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Genre]
$cparseJSONList :: Value -> Parser [Genre]
parseJSON :: Value -> Parser Genre
$cparseJSON :: Value -> Parser Genre
FromJSON, String -> Genre
forall a. (String -> a) -> IsString a
fromString :: String -> Genre
$cfromString :: String -> Genre
IsString)

newtype Href = Href {Href -> Text
unwrap :: Text}
    deriving newtype (Href -> Href -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Href -> Href -> Bool
$c/= :: Href -> Href -> Bool
== :: Href -> Href -> Bool
$c== :: Href -> Href -> Bool
Eq, Eq Href
Href -> Href -> Bool
Href -> Href -> Ordering
Href -> Href -> Href
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 :: Href -> Href -> Href
$cmin :: Href -> Href -> Href
max :: Href -> Href -> Href
$cmax :: Href -> Href -> Href
>= :: Href -> Href -> Bool
$c>= :: Href -> Href -> Bool
> :: Href -> Href -> Bool
$c> :: Href -> Href -> Bool
<= :: Href -> Href -> Bool
$c<= :: Href -> Href -> Bool
< :: Href -> Href -> Bool
$c< :: Href -> Href -> Bool
compare :: Href -> Href -> Ordering
$ccompare :: Href -> Href -> Ordering
Ord, Int -> Href -> ShowS
[Href] -> ShowS
Href -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Href] -> ShowS
$cshowList :: [Href] -> ShowS
show :: Href -> String
$cshow :: Href -> String
showsPrec :: Int -> Href -> ShowS
$cshowsPrec :: Int -> Href -> ShowS
Show, Value -> Parser [Href]
Value -> Parser Href
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Href]
$cparseJSONList :: Value -> Parser [Href]
parseJSON :: Value -> Parser Href
$cparseJSON :: Value -> Parser Href
FromJSON, String -> Href
forall a. (String -> a) -> IsString a
fromString :: String -> Href
$cfromString :: String -> Href
IsString)

class ToURI a where
    toURI :: a -> URI
newtype URIPrefix (s :: Symbol) a = URIPrefix a
instance (KnownSymbol s, HasField "unwrap" a Text) => ToURI (URIPrefix s a) where
    toURI :: URIPrefix s a -> URI
toURI (URIPrefix a
x) = Text -> URI
URI forall a b. (a -> b) -> a -> b
$ Text
"spotify:" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @s)) forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> a
x.unwrap
newtype DeviceID = DeviceID {DeviceID -> Text
unwrap :: Text}
    deriving newtype (DeviceID -> DeviceID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceID -> DeviceID -> Bool
$c/= :: DeviceID -> DeviceID -> Bool
== :: DeviceID -> DeviceID -> Bool
$c== :: DeviceID -> DeviceID -> Bool
Eq, Eq DeviceID
DeviceID -> DeviceID -> Bool
DeviceID -> DeviceID -> Ordering
DeviceID -> DeviceID -> DeviceID
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 :: DeviceID -> DeviceID -> DeviceID
$cmin :: DeviceID -> DeviceID -> DeviceID
max :: DeviceID -> DeviceID -> DeviceID
$cmax :: DeviceID -> DeviceID -> DeviceID
>= :: DeviceID -> DeviceID -> Bool
$c>= :: DeviceID -> DeviceID -> Bool
> :: DeviceID -> DeviceID -> Bool
$c> :: DeviceID -> DeviceID -> Bool
<= :: DeviceID -> DeviceID -> Bool
$c<= :: DeviceID -> DeviceID -> Bool
< :: DeviceID -> DeviceID -> Bool
$c< :: DeviceID -> DeviceID -> Bool
compare :: DeviceID -> DeviceID -> Ordering
$ccompare :: DeviceID -> DeviceID -> Ordering
Ord, Int -> DeviceID -> ShowS
[DeviceID] -> ShowS
DeviceID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeviceID] -> ShowS
$cshowList :: [DeviceID] -> ShowS
show :: DeviceID -> String
$cshow :: DeviceID -> String
showsPrec :: Int -> DeviceID -> ShowS
$cshowsPrec :: Int -> DeviceID -> ShowS
Show, Value -> Parser [DeviceID]
Value -> Parser DeviceID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [DeviceID]
$cparseJSONList :: Value -> Parser [DeviceID]
parseJSON :: Value -> Parser DeviceID
$cparseJSON :: Value -> Parser DeviceID
FromJSON, [DeviceID] -> Encoding
[DeviceID] -> Value
DeviceID -> Encoding
DeviceID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [DeviceID] -> Encoding
$ctoEncodingList :: [DeviceID] -> Encoding
toJSONList :: [DeviceID] -> Value
$ctoJSONList :: [DeviceID] -> Value
toEncoding :: DeviceID -> Encoding
$ctoEncoding :: DeviceID -> Encoding
toJSON :: DeviceID -> Value
$ctoJSON :: DeviceID -> Value
ToJSON, DeviceID -> Builder
DeviceID -> ByteString
DeviceID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: DeviceID -> Builder
$ctoEncodedQueryParam :: DeviceID -> Builder
toQueryParam :: DeviceID -> Text
$ctoQueryParam :: DeviceID -> Text
toHeader :: DeviceID -> ByteString
$ctoHeader :: DeviceID -> ByteString
toEncodedUrlPiece :: DeviceID -> Builder
$ctoEncodedUrlPiece :: DeviceID -> Builder
toUrlPiece :: DeviceID -> Text
$ctoUrlPiece :: DeviceID -> Text
ToHttpApiData, String -> DeviceID
forall a. (String -> a) -> IsString a
fromString :: String -> DeviceID
$cfromString :: String -> DeviceID
IsString)
newtype AlbumID = AlbumID {AlbumID -> Text
unwrap :: Text}
    deriving newtype (AlbumID -> AlbumID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlbumID -> AlbumID -> Bool
$c/= :: AlbumID -> AlbumID -> Bool
== :: AlbumID -> AlbumID -> Bool
$c== :: AlbumID -> AlbumID -> Bool
Eq, Eq AlbumID
AlbumID -> AlbumID -> Bool
AlbumID -> AlbumID -> Ordering
AlbumID -> AlbumID -> AlbumID
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 :: AlbumID -> AlbumID -> AlbumID
$cmin :: AlbumID -> AlbumID -> AlbumID
max :: AlbumID -> AlbumID -> AlbumID
$cmax :: AlbumID -> AlbumID -> AlbumID
>= :: AlbumID -> AlbumID -> Bool
$c>= :: AlbumID -> AlbumID -> Bool
> :: AlbumID -> AlbumID -> Bool
$c> :: AlbumID -> AlbumID -> Bool
<= :: AlbumID -> AlbumID -> Bool
$c<= :: AlbumID -> AlbumID -> Bool
< :: AlbumID -> AlbumID -> Bool
$c< :: AlbumID -> AlbumID -> Bool
compare :: AlbumID -> AlbumID -> Ordering
$ccompare :: AlbumID -> AlbumID -> Ordering
Ord, Int -> AlbumID -> ShowS
[AlbumID] -> ShowS
AlbumID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlbumID] -> ShowS
$cshowList :: [AlbumID] -> ShowS
show :: AlbumID -> String
$cshow :: AlbumID -> String
showsPrec :: Int -> AlbumID -> ShowS
$cshowsPrec :: Int -> AlbumID -> ShowS
Show, Value -> Parser [AlbumID]
Value -> Parser AlbumID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AlbumID]
$cparseJSONList :: Value -> Parser [AlbumID]
parseJSON :: Value -> Parser AlbumID
$cparseJSON :: Value -> Parser AlbumID
FromJSON, [AlbumID] -> Encoding
[AlbumID] -> Value
AlbumID -> Encoding
AlbumID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AlbumID] -> Encoding
$ctoEncodingList :: [AlbumID] -> Encoding
toJSONList :: [AlbumID] -> Value
$ctoJSONList :: [AlbumID] -> Value
toEncoding :: AlbumID -> Encoding
$ctoEncoding :: AlbumID -> Encoding
toJSON :: AlbumID -> Value
$ctoJSON :: AlbumID -> Value
ToJSON, AlbumID -> Builder
AlbumID -> ByteString
AlbumID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: AlbumID -> Builder
$ctoEncodedQueryParam :: AlbumID -> Builder
toQueryParam :: AlbumID -> Text
$ctoQueryParam :: AlbumID -> Text
toHeader :: AlbumID -> ByteString
$ctoHeader :: AlbumID -> ByteString
toEncodedUrlPiece :: AlbumID -> Builder
$ctoEncodedUrlPiece :: AlbumID -> Builder
toUrlPiece :: AlbumID -> Text
$ctoUrlPiece :: AlbumID -> Text
ToHttpApiData, String -> AlbumID
forall a. (String -> a) -> IsString a
fromString :: String -> AlbumID
$cfromString :: String -> AlbumID
IsString)
    deriving (AlbumID -> URI
forall a. (a -> URI) -> ToURI a
toURI :: AlbumID -> URI
$ctoURI :: AlbumID -> URI
ToURI) via URIPrefix "album" AlbumID
newtype ArtistID = ArtistID {ArtistID -> Text
unwrap :: Text}
    deriving newtype (ArtistID -> ArtistID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArtistID -> ArtistID -> Bool
$c/= :: ArtistID -> ArtistID -> Bool
== :: ArtistID -> ArtistID -> Bool
$c== :: ArtistID -> ArtistID -> Bool
Eq, Eq ArtistID
ArtistID -> ArtistID -> Bool
ArtistID -> ArtistID -> Ordering
ArtistID -> ArtistID -> ArtistID
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 :: ArtistID -> ArtistID -> ArtistID
$cmin :: ArtistID -> ArtistID -> ArtistID
max :: ArtistID -> ArtistID -> ArtistID
$cmax :: ArtistID -> ArtistID -> ArtistID
>= :: ArtistID -> ArtistID -> Bool
$c>= :: ArtistID -> ArtistID -> Bool
> :: ArtistID -> ArtistID -> Bool
$c> :: ArtistID -> ArtistID -> Bool
<= :: ArtistID -> ArtistID -> Bool
$c<= :: ArtistID -> ArtistID -> Bool
< :: ArtistID -> ArtistID -> Bool
$c< :: ArtistID -> ArtistID -> Bool
compare :: ArtistID -> ArtistID -> Ordering
$ccompare :: ArtistID -> ArtistID -> Ordering
Ord, Int -> ArtistID -> ShowS
[ArtistID] -> ShowS
ArtistID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArtistID] -> ShowS
$cshowList :: [ArtistID] -> ShowS
show :: ArtistID -> String
$cshow :: ArtistID -> String
showsPrec :: Int -> ArtistID -> ShowS
$cshowsPrec :: Int -> ArtistID -> ShowS
Show, Value -> Parser [ArtistID]
Value -> Parser ArtistID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ArtistID]
$cparseJSONList :: Value -> Parser [ArtistID]
parseJSON :: Value -> Parser ArtistID
$cparseJSON :: Value -> Parser ArtistID
FromJSON, [ArtistID] -> Encoding
[ArtistID] -> Value
ArtistID -> Encoding
ArtistID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ArtistID] -> Encoding
$ctoEncodingList :: [ArtistID] -> Encoding
toJSONList :: [ArtistID] -> Value
$ctoJSONList :: [ArtistID] -> Value
toEncoding :: ArtistID -> Encoding
$ctoEncoding :: ArtistID -> Encoding
toJSON :: ArtistID -> Value
$ctoJSON :: ArtistID -> Value
ToJSON, ArtistID -> Builder
ArtistID -> ByteString
ArtistID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: ArtistID -> Builder
$ctoEncodedQueryParam :: ArtistID -> Builder
toQueryParam :: ArtistID -> Text
$ctoQueryParam :: ArtistID -> Text
toHeader :: ArtistID -> ByteString
$ctoHeader :: ArtistID -> ByteString
toEncodedUrlPiece :: ArtistID -> Builder
$ctoEncodedUrlPiece :: ArtistID -> Builder
toUrlPiece :: ArtistID -> Text
$ctoUrlPiece :: ArtistID -> Text
ToHttpApiData, String -> ArtistID
forall a. (String -> a) -> IsString a
fromString :: String -> ArtistID
$cfromString :: String -> ArtistID
IsString)
    deriving (ArtistID -> URI
forall a. (a -> URI) -> ToURI a
toURI :: ArtistID -> URI
$ctoURI :: ArtistID -> URI
ToURI) via URIPrefix "artist" ArtistID
newtype EpisodeID = EpisodeID {EpisodeID -> Text
unwrap :: Text}
    deriving newtype (EpisodeID -> EpisodeID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpisodeID -> EpisodeID -> Bool
$c/= :: EpisodeID -> EpisodeID -> Bool
== :: EpisodeID -> EpisodeID -> Bool
$c== :: EpisodeID -> EpisodeID -> Bool
Eq, Eq EpisodeID
EpisodeID -> EpisodeID -> Bool
EpisodeID -> EpisodeID -> Ordering
EpisodeID -> EpisodeID -> EpisodeID
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 :: EpisodeID -> EpisodeID -> EpisodeID
$cmin :: EpisodeID -> EpisodeID -> EpisodeID
max :: EpisodeID -> EpisodeID -> EpisodeID
$cmax :: EpisodeID -> EpisodeID -> EpisodeID
>= :: EpisodeID -> EpisodeID -> Bool
$c>= :: EpisodeID -> EpisodeID -> Bool
> :: EpisodeID -> EpisodeID -> Bool
$c> :: EpisodeID -> EpisodeID -> Bool
<= :: EpisodeID -> EpisodeID -> Bool
$c<= :: EpisodeID -> EpisodeID -> Bool
< :: EpisodeID -> EpisodeID -> Bool
$c< :: EpisodeID -> EpisodeID -> Bool
compare :: EpisodeID -> EpisodeID -> Ordering
$ccompare :: EpisodeID -> EpisodeID -> Ordering
Ord, Int -> EpisodeID -> ShowS
[EpisodeID] -> ShowS
EpisodeID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpisodeID] -> ShowS
$cshowList :: [EpisodeID] -> ShowS
show :: EpisodeID -> String
$cshow :: EpisodeID -> String
showsPrec :: Int -> EpisodeID -> ShowS
$cshowsPrec :: Int -> EpisodeID -> ShowS
Show, Value -> Parser [EpisodeID]
Value -> Parser EpisodeID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EpisodeID]
$cparseJSONList :: Value -> Parser [EpisodeID]
parseJSON :: Value -> Parser EpisodeID
$cparseJSON :: Value -> Parser EpisodeID
FromJSON, [EpisodeID] -> Encoding
[EpisodeID] -> Value
EpisodeID -> Encoding
EpisodeID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EpisodeID] -> Encoding
$ctoEncodingList :: [EpisodeID] -> Encoding
toJSONList :: [EpisodeID] -> Value
$ctoJSONList :: [EpisodeID] -> Value
toEncoding :: EpisodeID -> Encoding
$ctoEncoding :: EpisodeID -> Encoding
toJSON :: EpisodeID -> Value
$ctoJSON :: EpisodeID -> Value
ToJSON, EpisodeID -> Builder
EpisodeID -> ByteString
EpisodeID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: EpisodeID -> Builder
$ctoEncodedQueryParam :: EpisodeID -> Builder
toQueryParam :: EpisodeID -> Text
$ctoQueryParam :: EpisodeID -> Text
toHeader :: EpisodeID -> ByteString
$ctoHeader :: EpisodeID -> ByteString
toEncodedUrlPiece :: EpisodeID -> Builder
$ctoEncodedUrlPiece :: EpisodeID -> Builder
toUrlPiece :: EpisodeID -> Text
$ctoUrlPiece :: EpisodeID -> Text
ToHttpApiData, String -> EpisodeID
forall a. (String -> a) -> IsString a
fromString :: String -> EpisodeID
$cfromString :: String -> EpisodeID
IsString)
    deriving (EpisodeID -> URI
forall a. (a -> URI) -> ToURI a
toURI :: EpisodeID -> URI
$ctoURI :: EpisodeID -> URI
ToURI) via URIPrefix "episode" EpisodeID
newtype TrackID = TrackID {TrackID -> Text
unwrap :: Text}
    deriving newtype (TrackID -> TrackID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrackID -> TrackID -> Bool
$c/= :: TrackID -> TrackID -> Bool
== :: TrackID -> TrackID -> Bool
$c== :: TrackID -> TrackID -> Bool
Eq, Eq TrackID
TrackID -> TrackID -> Bool
TrackID -> TrackID -> Ordering
TrackID -> TrackID -> TrackID
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 :: TrackID -> TrackID -> TrackID
$cmin :: TrackID -> TrackID -> TrackID
max :: TrackID -> TrackID -> TrackID
$cmax :: TrackID -> TrackID -> TrackID
>= :: TrackID -> TrackID -> Bool
$c>= :: TrackID -> TrackID -> Bool
> :: TrackID -> TrackID -> Bool
$c> :: TrackID -> TrackID -> Bool
<= :: TrackID -> TrackID -> Bool
$c<= :: TrackID -> TrackID -> Bool
< :: TrackID -> TrackID -> Bool
$c< :: TrackID -> TrackID -> Bool
compare :: TrackID -> TrackID -> Ordering
$ccompare :: TrackID -> TrackID -> Ordering
Ord, Int -> TrackID -> ShowS
[TrackID] -> ShowS
TrackID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrackID] -> ShowS
$cshowList :: [TrackID] -> ShowS
show :: TrackID -> String
$cshow :: TrackID -> String
showsPrec :: Int -> TrackID -> ShowS
$cshowsPrec :: Int -> TrackID -> ShowS
Show, Value -> Parser [TrackID]
Value -> Parser TrackID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TrackID]
$cparseJSONList :: Value -> Parser [TrackID]
parseJSON :: Value -> Parser TrackID
$cparseJSON :: Value -> Parser TrackID
FromJSON, [TrackID] -> Encoding
[TrackID] -> Value
TrackID -> Encoding
TrackID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TrackID] -> Encoding
$ctoEncodingList :: [TrackID] -> Encoding
toJSONList :: [TrackID] -> Value
$ctoJSONList :: [TrackID] -> Value
toEncoding :: TrackID -> Encoding
$ctoEncoding :: TrackID -> Encoding
toJSON :: TrackID -> Value
$ctoJSON :: TrackID -> Value
ToJSON, TrackID -> Builder
TrackID -> ByteString
TrackID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: TrackID -> Builder
$ctoEncodedQueryParam :: TrackID -> Builder
toQueryParam :: TrackID -> Text
$ctoQueryParam :: TrackID -> Text
toHeader :: TrackID -> ByteString
$ctoHeader :: TrackID -> ByteString
toEncodedUrlPiece :: TrackID -> Builder
$ctoEncodedUrlPiece :: TrackID -> Builder
toUrlPiece :: TrackID -> Text
$ctoUrlPiece :: TrackID -> Text
ToHttpApiData, String -> TrackID
forall a. (String -> a) -> IsString a
fromString :: String -> TrackID
$cfromString :: String -> TrackID
IsString)
    deriving (TrackID -> URI
forall a. (a -> URI) -> ToURI a
toURI :: TrackID -> URI
$ctoURI :: TrackID -> URI
ToURI) via URIPrefix "track" TrackID
newtype UserID = UserID {UserID -> Text
unwrap :: Text}
    deriving newtype (UserID -> UserID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserID -> UserID -> Bool
$c/= :: UserID -> UserID -> Bool
== :: UserID -> UserID -> Bool
$c== :: UserID -> UserID -> Bool
Eq, Eq UserID
UserID -> UserID -> Bool
UserID -> UserID -> Ordering
UserID -> UserID -> UserID
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 :: UserID -> UserID -> UserID
$cmin :: UserID -> UserID -> UserID
max :: UserID -> UserID -> UserID
$cmax :: UserID -> UserID -> UserID
>= :: UserID -> UserID -> Bool
$c>= :: UserID -> UserID -> Bool
> :: UserID -> UserID -> Bool
$c> :: UserID -> UserID -> Bool
<= :: UserID -> UserID -> Bool
$c<= :: UserID -> UserID -> Bool
< :: UserID -> UserID -> Bool
$c< :: UserID -> UserID -> Bool
compare :: UserID -> UserID -> Ordering
$ccompare :: UserID -> UserID -> Ordering
Ord, Int -> UserID -> ShowS
[UserID] -> ShowS
UserID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserID] -> ShowS
$cshowList :: [UserID] -> ShowS
show :: UserID -> String
$cshow :: UserID -> String
showsPrec :: Int -> UserID -> ShowS
$cshowsPrec :: Int -> UserID -> ShowS
Show, Value -> Parser [UserID]
Value -> Parser UserID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UserID]
$cparseJSONList :: Value -> Parser [UserID]
parseJSON :: Value -> Parser UserID
$cparseJSON :: Value -> Parser UserID
FromJSON, [UserID] -> Encoding
[UserID] -> Value
UserID -> Encoding
UserID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserID] -> Encoding
$ctoEncodingList :: [UserID] -> Encoding
toJSONList :: [UserID] -> Value
$ctoJSONList :: [UserID] -> Value
toEncoding :: UserID -> Encoding
$ctoEncoding :: UserID -> Encoding
toJSON :: UserID -> Value
$ctoJSON :: UserID -> Value
ToJSON, UserID -> Builder
UserID -> ByteString
UserID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: UserID -> Builder
$ctoEncodedQueryParam :: UserID -> Builder
toQueryParam :: UserID -> Text
$ctoQueryParam :: UserID -> Text
toHeader :: UserID -> ByteString
$ctoHeader :: UserID -> ByteString
toEncodedUrlPiece :: UserID -> Builder
$ctoEncodedUrlPiece :: UserID -> Builder
toUrlPiece :: UserID -> Text
$ctoUrlPiece :: UserID -> Text
ToHttpApiData, String -> UserID
forall a. (String -> a) -> IsString a
fromString :: String -> UserID
$cfromString :: String -> UserID
IsString)
    deriving (UserID -> URI
forall a. (a -> URI) -> ToURI a
toURI :: UserID -> URI
$ctoURI :: UserID -> URI
ToURI) via URIPrefix "user" UserID
newtype PlaylistID = PlaylistID {PlaylistID -> Text
unwrap :: Text}
    deriving newtype (PlaylistID -> PlaylistID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlaylistID -> PlaylistID -> Bool
$c/= :: PlaylistID -> PlaylistID -> Bool
== :: PlaylistID -> PlaylistID -> Bool
$c== :: PlaylistID -> PlaylistID -> Bool
Eq, Eq PlaylistID
PlaylistID -> PlaylistID -> Bool
PlaylistID -> PlaylistID -> Ordering
PlaylistID -> PlaylistID -> PlaylistID
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 :: PlaylistID -> PlaylistID -> PlaylistID
$cmin :: PlaylistID -> PlaylistID -> PlaylistID
max :: PlaylistID -> PlaylistID -> PlaylistID
$cmax :: PlaylistID -> PlaylistID -> PlaylistID
>= :: PlaylistID -> PlaylistID -> Bool
$c>= :: PlaylistID -> PlaylistID -> Bool
> :: PlaylistID -> PlaylistID -> Bool
$c> :: PlaylistID -> PlaylistID -> Bool
<= :: PlaylistID -> PlaylistID -> Bool
$c<= :: PlaylistID -> PlaylistID -> Bool
< :: PlaylistID -> PlaylistID -> Bool
$c< :: PlaylistID -> PlaylistID -> Bool
compare :: PlaylistID -> PlaylistID -> Ordering
$ccompare :: PlaylistID -> PlaylistID -> Ordering
Ord, Int -> PlaylistID -> ShowS
[PlaylistID] -> ShowS
PlaylistID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlaylistID] -> ShowS
$cshowList :: [PlaylistID] -> ShowS
show :: PlaylistID -> String
$cshow :: PlaylistID -> String
showsPrec :: Int -> PlaylistID -> ShowS
$cshowsPrec :: Int -> PlaylistID -> ShowS
Show, Value -> Parser [PlaylistID]
Value -> Parser PlaylistID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PlaylistID]
$cparseJSONList :: Value -> Parser [PlaylistID]
parseJSON :: Value -> Parser PlaylistID
$cparseJSON :: Value -> Parser PlaylistID
FromJSON, [PlaylistID] -> Encoding
[PlaylistID] -> Value
PlaylistID -> Encoding
PlaylistID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PlaylistID] -> Encoding
$ctoEncodingList :: [PlaylistID] -> Encoding
toJSONList :: [PlaylistID] -> Value
$ctoJSONList :: [PlaylistID] -> Value
toEncoding :: PlaylistID -> Encoding
$ctoEncoding :: PlaylistID -> Encoding
toJSON :: PlaylistID -> Value
$ctoJSON :: PlaylistID -> Value
ToJSON, PlaylistID -> Builder
PlaylistID -> ByteString
PlaylistID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: PlaylistID -> Builder
$ctoEncodedQueryParam :: PlaylistID -> Builder
toQueryParam :: PlaylistID -> Text
$ctoQueryParam :: PlaylistID -> Text
toHeader :: PlaylistID -> ByteString
$ctoHeader :: PlaylistID -> ByteString
toEncodedUrlPiece :: PlaylistID -> Builder
$ctoEncodedUrlPiece :: PlaylistID -> Builder
toUrlPiece :: PlaylistID -> Text
$ctoUrlPiece :: PlaylistID -> Text
ToHttpApiData, String -> PlaylistID
forall a. (String -> a) -> IsString a
fromString :: String -> PlaylistID
$cfromString :: String -> PlaylistID
IsString)
    deriving (PlaylistID -> URI
forall a. (a -> URI) -> ToURI a
toURI :: PlaylistID -> URI
$ctoURI :: PlaylistID -> URI
ToURI) via URIPrefix "playlist" PlaylistID
newtype CategoryID = CategoryID {CategoryID -> Text
unwrap :: Text}
    deriving newtype (CategoryID -> CategoryID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CategoryID -> CategoryID -> Bool
$c/= :: CategoryID -> CategoryID -> Bool
== :: CategoryID -> CategoryID -> Bool
$c== :: CategoryID -> CategoryID -> Bool
Eq, Eq CategoryID
CategoryID -> CategoryID -> Bool
CategoryID -> CategoryID -> Ordering
CategoryID -> CategoryID -> CategoryID
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 :: CategoryID -> CategoryID -> CategoryID
$cmin :: CategoryID -> CategoryID -> CategoryID
max :: CategoryID -> CategoryID -> CategoryID
$cmax :: CategoryID -> CategoryID -> CategoryID
>= :: CategoryID -> CategoryID -> Bool
$c>= :: CategoryID -> CategoryID -> Bool
> :: CategoryID -> CategoryID -> Bool
$c> :: CategoryID -> CategoryID -> Bool
<= :: CategoryID -> CategoryID -> Bool
$c<= :: CategoryID -> CategoryID -> Bool
< :: CategoryID -> CategoryID -> Bool
$c< :: CategoryID -> CategoryID -> Bool
compare :: CategoryID -> CategoryID -> Ordering
$ccompare :: CategoryID -> CategoryID -> Ordering
Ord, Int -> CategoryID -> ShowS
[CategoryID] -> ShowS
CategoryID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CategoryID] -> ShowS
$cshowList :: [CategoryID] -> ShowS
show :: CategoryID -> String
$cshow :: CategoryID -> String
showsPrec :: Int -> CategoryID -> ShowS
$cshowsPrec :: Int -> CategoryID -> ShowS
Show, Value -> Parser [CategoryID]
Value -> Parser CategoryID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CategoryID]
$cparseJSONList :: Value -> Parser [CategoryID]
parseJSON :: Value -> Parser CategoryID
$cparseJSON :: Value -> Parser CategoryID
FromJSON, [CategoryID] -> Encoding
[CategoryID] -> Value
CategoryID -> Encoding
CategoryID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CategoryID] -> Encoding
$ctoEncodingList :: [CategoryID] -> Encoding
toJSONList :: [CategoryID] -> Value
$ctoJSONList :: [CategoryID] -> Value
toEncoding :: CategoryID -> Encoding
$ctoEncoding :: CategoryID -> Encoding
toJSON :: CategoryID -> Value
$ctoJSON :: CategoryID -> Value
ToJSON, CategoryID -> Builder
CategoryID -> ByteString
CategoryID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: CategoryID -> Builder
$ctoEncodedQueryParam :: CategoryID -> Builder
toQueryParam :: CategoryID -> Text
$ctoQueryParam :: CategoryID -> Text
toHeader :: CategoryID -> ByteString
$ctoHeader :: CategoryID -> ByteString
toEncodedUrlPiece :: CategoryID -> Builder
$ctoEncodedUrlPiece :: CategoryID -> Builder
toUrlPiece :: CategoryID -> Text
$ctoUrlPiece :: CategoryID -> Text
ToHttpApiData, String -> CategoryID
forall a. (String -> a) -> IsString a
fromString :: String -> CategoryID
$cfromString :: String -> CategoryID
IsString)
newtype SnapshotID = SnapshotID {SnapshotID -> Text
unwrap :: Text}
    deriving newtype (SnapshotID -> SnapshotID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotID -> SnapshotID -> Bool
$c/= :: SnapshotID -> SnapshotID -> Bool
== :: SnapshotID -> SnapshotID -> Bool
$c== :: SnapshotID -> SnapshotID -> Bool
Eq, Eq SnapshotID
SnapshotID -> SnapshotID -> Bool
SnapshotID -> SnapshotID -> Ordering
SnapshotID -> SnapshotID -> SnapshotID
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 :: SnapshotID -> SnapshotID -> SnapshotID
$cmin :: SnapshotID -> SnapshotID -> SnapshotID
max :: SnapshotID -> SnapshotID -> SnapshotID
$cmax :: SnapshotID -> SnapshotID -> SnapshotID
>= :: SnapshotID -> SnapshotID -> Bool
$c>= :: SnapshotID -> SnapshotID -> Bool
> :: SnapshotID -> SnapshotID -> Bool
$c> :: SnapshotID -> SnapshotID -> Bool
<= :: SnapshotID -> SnapshotID -> Bool
$c<= :: SnapshotID -> SnapshotID -> Bool
< :: SnapshotID -> SnapshotID -> Bool
$c< :: SnapshotID -> SnapshotID -> Bool
compare :: SnapshotID -> SnapshotID -> Ordering
$ccompare :: SnapshotID -> SnapshotID -> Ordering
Ord, Int -> SnapshotID -> ShowS
[SnapshotID] -> ShowS
SnapshotID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotID] -> ShowS
$cshowList :: [SnapshotID] -> ShowS
show :: SnapshotID -> String
$cshow :: SnapshotID -> String
showsPrec :: Int -> SnapshotID -> ShowS
$cshowsPrec :: Int -> SnapshotID -> ShowS
Show, Value -> Parser [SnapshotID]
Value -> Parser SnapshotID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SnapshotID]
$cparseJSONList :: Value -> Parser [SnapshotID]
parseJSON :: Value -> Parser SnapshotID
$cparseJSON :: Value -> Parser SnapshotID
FromJSON, [SnapshotID] -> Encoding
[SnapshotID] -> Value
SnapshotID -> Encoding
SnapshotID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SnapshotID] -> Encoding
$ctoEncodingList :: [SnapshotID] -> Encoding
toJSONList :: [SnapshotID] -> Value
$ctoJSONList :: [SnapshotID] -> Value
toEncoding :: SnapshotID -> Encoding
$ctoEncoding :: SnapshotID -> Encoding
toJSON :: SnapshotID -> Value
$ctoJSON :: SnapshotID -> Value
ToJSON, SnapshotID -> Builder
SnapshotID -> ByteString
SnapshotID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: SnapshotID -> Builder
$ctoEncodedQueryParam :: SnapshotID -> Builder
toQueryParam :: SnapshotID -> Text
$ctoQueryParam :: SnapshotID -> Text
toHeader :: SnapshotID -> ByteString
$ctoHeader :: SnapshotID -> ByteString
toEncodedUrlPiece :: SnapshotID -> Builder
$ctoEncodedUrlPiece :: SnapshotID -> Builder
toUrlPiece :: SnapshotID -> Text
$ctoUrlPiece :: SnapshotID -> Text
ToHttpApiData, String -> SnapshotID
forall a. (String -> a) -> IsString a
fromString :: String -> SnapshotID
$cfromString :: String -> SnapshotID
IsString)

newtype URL = URL {URL -> Text
unwrap :: Text}
    deriving newtype (URL -> URL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c== :: URL -> URL -> Bool
Eq, Eq URL
URL -> URL -> Bool
URL -> URL -> Ordering
URL -> URL -> URL
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 :: URL -> URL -> URL
$cmin :: URL -> URL -> URL
max :: URL -> URL -> URL
$cmax :: URL -> URL -> URL
>= :: URL -> URL -> Bool
$c>= :: URL -> URL -> Bool
> :: URL -> URL -> Bool
$c> :: URL -> URL -> Bool
<= :: URL -> URL -> Bool
$c<= :: URL -> URL -> Bool
< :: URL -> URL -> Bool
$c< :: URL -> URL -> Bool
compare :: URL -> URL -> Ordering
$ccompare :: URL -> URL -> Ordering
Ord, Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URL] -> ShowS
$cshowList :: [URL] -> ShowS
show :: URL -> String
$cshow :: URL -> String
showsPrec :: Int -> URL -> ShowS
$cshowsPrec :: Int -> URL -> ShowS
Show, Value -> Parser [URL]
Value -> Parser URL
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [URL]
$cparseJSONList :: Value -> Parser [URL]
parseJSON :: Value -> Parser URL
$cparseJSON :: Value -> Parser URL
FromJSON, String -> URL
forall a. (String -> a) -> IsString a
fromString :: String -> URL
$cfromString :: String -> URL
IsString, URL -> Builder
URL -> ByteString
URL -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: URL -> Builder
$ctoEncodedQueryParam :: URL -> Builder
toQueryParam :: URL -> Text
$ctoQueryParam :: URL -> Text
toHeader :: URL -> ByteString
$ctoHeader :: URL -> ByteString
toEncodedUrlPiece :: URL -> Builder
$ctoEncodedUrlPiece :: URL -> Builder
toUrlPiece :: URL -> Text
$ctoUrlPiece :: URL -> Text
ToHttpApiData)

newtype URI = URI {URI -> Text
unwrap :: Text}
    deriving newtype (URI -> URI -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c== :: URI -> URI -> Bool
Eq, Eq URI
URI -> URI -> Bool
URI -> URI -> Ordering
URI -> URI -> URI
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 :: URI -> URI -> URI
$cmin :: URI -> URI -> URI
max :: URI -> URI -> URI
$cmax :: URI -> URI -> URI
>= :: URI -> URI -> Bool
$c>= :: URI -> URI -> Bool
> :: URI -> URI -> Bool
$c> :: URI -> URI -> Bool
<= :: URI -> URI -> Bool
$c<= :: URI -> URI -> Bool
< :: URI -> URI -> Bool
$c< :: URI -> URI -> Bool
compare :: URI -> URI -> Ordering
$ccompare :: URI -> URI -> Ordering
Ord, Int -> URI -> ShowS
[URI] -> ShowS
URI -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URI] -> ShowS
$cshowList :: [URI] -> ShowS
show :: URI -> String
$cshow :: URI -> String
showsPrec :: Int -> URI -> ShowS
$cshowsPrec :: Int -> URI -> ShowS
Show, Value -> Parser [URI]
Value -> Parser URI
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [URI]
$cparseJSONList :: Value -> Parser [URI]
parseJSON :: Value -> Parser URI
$cparseJSON :: Value -> Parser URI
FromJSON, [URI] -> Encoding
[URI] -> Value
URI -> Encoding
URI -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [URI] -> Encoding
$ctoEncodingList :: [URI] -> Encoding
toJSONList :: [URI] -> Value
$ctoJSONList :: [URI] -> Value
toEncoding :: URI -> Encoding
$ctoEncoding :: URI -> Encoding
toJSON :: URI -> Value
$ctoJSON :: URI -> Value
ToJSON, String -> URI
forall a. (String -> a) -> IsString a
fromString :: String -> URI
$cfromString :: String -> URI
IsString)

newtype Country = Country {Country -> Text
unwrap :: Text}
    deriving newtype (Country -> Country -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Country -> Country -> Bool
$c/= :: Country -> Country -> Bool
== :: Country -> Country -> Bool
$c== :: Country -> Country -> Bool
Eq, Eq Country
Country -> Country -> Bool
Country -> Country -> Ordering
Country -> Country -> Country
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 :: Country -> Country -> Country
$cmin :: Country -> Country -> Country
max :: Country -> Country -> Country
$cmax :: Country -> Country -> Country
>= :: Country -> Country -> Bool
$c>= :: Country -> Country -> Bool
> :: Country -> Country -> Bool
$c> :: Country -> Country -> Bool
<= :: Country -> Country -> Bool
$c<= :: Country -> Country -> Bool
< :: Country -> Country -> Bool
$c< :: Country -> Country -> Bool
compare :: Country -> Country -> Ordering
$ccompare :: Country -> Country -> Ordering
Ord, Int -> Country -> ShowS
[Country] -> ShowS
Country -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Country] -> ShowS
$cshowList :: [Country] -> ShowS
show :: Country -> String
$cshow :: Country -> String
showsPrec :: Int -> Country -> ShowS
$cshowsPrec :: Int -> Country -> ShowS
Show, Value -> Parser [Country]
Value -> Parser Country
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Country]
$cparseJSONList :: Value -> Parser [Country]
parseJSON :: Value -> Parser Country
$cparseJSON :: Value -> Parser Country
FromJSON, [Country] -> Encoding
[Country] -> Value
Country -> Encoding
Country -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Country] -> Encoding
$ctoEncodingList :: [Country] -> Encoding
toJSONList :: [Country] -> Value
$ctoJSONList :: [Country] -> Value
toEncoding :: Country -> Encoding
$ctoEncoding :: Country -> Encoding
toJSON :: Country -> Value
$ctoJSON :: Country -> Value
ToJSON, Country -> Builder
Country -> ByteString
Country -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: Country -> Builder
$ctoEncodedQueryParam :: Country -> Builder
toQueryParam :: Country -> Text
$ctoQueryParam :: Country -> Text
toHeader :: Country -> ByteString
$ctoHeader :: Country -> ByteString
toEncodedUrlPiece :: Country -> Builder
$ctoEncodedUrlPiece :: Country -> Builder
toUrlPiece :: Country -> Text
$ctoUrlPiece :: Country -> Text
ToHttpApiData, String -> Country
forall a. (String -> a) -> IsString a
fromString :: String -> Country
$cfromString :: String -> Country
IsString)

newtype Locale = Locale {Locale -> Text
unwrap :: Text}
    deriving newtype (Locale -> Locale -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Locale -> Locale -> Bool
$c/= :: Locale -> Locale -> Bool
== :: Locale -> Locale -> Bool
$c== :: Locale -> Locale -> Bool
Eq, Eq Locale
Locale -> Locale -> Bool
Locale -> Locale -> Ordering
Locale -> Locale -> Locale
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 :: Locale -> Locale -> Locale
$cmin :: Locale -> Locale -> Locale
max :: Locale -> Locale -> Locale
$cmax :: Locale -> Locale -> Locale
>= :: Locale -> Locale -> Bool
$c>= :: Locale -> Locale -> Bool
> :: Locale -> Locale -> Bool
$c> :: Locale -> Locale -> Bool
<= :: Locale -> Locale -> Bool
$c<= :: Locale -> Locale -> Bool
< :: Locale -> Locale -> Bool
$c< :: Locale -> Locale -> Bool
compare :: Locale -> Locale -> Ordering
$ccompare :: Locale -> Locale -> Ordering
Ord, Int -> Locale -> ShowS
[Locale] -> ShowS
Locale -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Locale] -> ShowS
$cshowList :: [Locale] -> ShowS
show :: Locale -> String
$cshow :: Locale -> String
showsPrec :: Int -> Locale -> ShowS
$cshowsPrec :: Int -> Locale -> ShowS
Show, Value -> Parser [Locale]
Value -> Parser Locale
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Locale]
$cparseJSONList :: Value -> Parser [Locale]
parseJSON :: Value -> Parser Locale
$cparseJSON :: Value -> Parser Locale
FromJSON, [Locale] -> Encoding
[Locale] -> Value
Locale -> Encoding
Locale -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Locale] -> Encoding
$ctoEncodingList :: [Locale] -> Encoding
toJSONList :: [Locale] -> Value
$ctoJSONList :: [Locale] -> Value
toEncoding :: Locale -> Encoding
$ctoEncoding :: Locale -> Encoding
toJSON :: Locale -> Value
$ctoJSON :: Locale -> Value
ToJSON, Locale -> Builder
Locale -> ByteString
Locale -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
toEncodedQueryParam :: Locale -> Builder
$ctoEncodedQueryParam :: Locale -> Builder
toQueryParam :: Locale -> Text
$ctoQueryParam :: Locale -> Text
toHeader :: Locale -> ByteString
$ctoHeader :: Locale -> ByteString
toEncodedUrlPiece :: Locale -> Builder
$ctoEncodedUrlPiece :: Locale -> Builder
toUrlPiece :: Locale -> Text
$ctoUrlPiece :: Locale -> Text
ToHttpApiData, String -> Locale
forall a. (String -> a) -> IsString a
fromString :: String -> Locale
$cfromString :: String -> Locale
IsString)

newtype HTTPError = HTTPError {HTTPError -> Int
unwrap :: Int}
    deriving (Int -> HTTPError -> ShowS
[HTTPError] -> ShowS
HTTPError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTTPError] -> ShowS
$cshowList :: [HTTPError] -> ShowS
show :: HTTPError -> String
$cshow :: HTTPError -> String
showsPrec :: Int -> HTTPError -> ShowS
$cshowsPrec :: Int -> HTTPError -> ShowS
Show)
    deriving newtype (HTTPError -> HTTPError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HTTPError -> HTTPError -> Bool
$c/= :: HTTPError -> HTTPError -> Bool
== :: HTTPError -> HTTPError -> Bool
$c== :: HTTPError -> HTTPError -> Bool
Eq, Eq HTTPError
HTTPError -> HTTPError -> Bool
HTTPError -> HTTPError -> Ordering
HTTPError -> HTTPError -> HTTPError
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 :: HTTPError -> HTTPError -> HTTPError
$cmin :: HTTPError -> HTTPError -> HTTPError
max :: HTTPError -> HTTPError -> HTTPError
$cmax :: HTTPError -> HTTPError -> HTTPError
>= :: HTTPError -> HTTPError -> Bool
$c>= :: HTTPError -> HTTPError -> Bool
> :: HTTPError -> HTTPError -> Bool
$c> :: HTTPError -> HTTPError -> Bool
<= :: HTTPError -> HTTPError -> Bool
$c<= :: HTTPError -> HTTPError -> Bool
< :: HTTPError -> HTTPError -> Bool
$c< :: HTTPError -> HTTPError -> Bool
compare :: HTTPError -> HTTPError -> Ordering
$ccompare :: HTTPError -> HTTPError -> Ordering
Ord, Value -> Parser [HTTPError]
Value -> Parser HTTPError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [HTTPError]
$cparseJSONList :: Value -> Parser [HTTPError]
parseJSON :: Value -> Parser HTTPError
$cparseJSON :: Value -> Parser HTTPError
FromJSON)

newtype Restrictions = Restrictions {Restrictions -> Map Text Text
unwrap :: Map Text Text}
    deriving (Int -> Restrictions -> ShowS
[Restrictions] -> ShowS
Restrictions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Restrictions] -> ShowS
$cshowList :: [Restrictions] -> ShowS
show :: Restrictions -> String
$cshow :: Restrictions -> String
showsPrec :: Int -> Restrictions -> ShowS
$cshowsPrec :: Int -> Restrictions -> ShowS
Show)
    deriving newtype (Restrictions -> Restrictions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Restrictions -> Restrictions -> Bool
$c/= :: Restrictions -> Restrictions -> Bool
== :: Restrictions -> Restrictions -> Bool
$c== :: Restrictions -> Restrictions -> Bool
Eq, Eq Restrictions
Restrictions -> Restrictions -> Bool
Restrictions -> Restrictions -> Ordering
Restrictions -> Restrictions -> Restrictions
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 :: Restrictions -> Restrictions -> Restrictions
$cmin :: Restrictions -> Restrictions -> Restrictions
max :: Restrictions -> Restrictions -> Restrictions
$cmax :: Restrictions -> Restrictions -> Restrictions
>= :: Restrictions -> Restrictions -> Bool
$c>= :: Restrictions -> Restrictions -> Bool
> :: Restrictions -> Restrictions -> Bool
$c> :: Restrictions -> Restrictions -> Bool
<= :: Restrictions -> Restrictions -> Bool
$c<= :: Restrictions -> Restrictions -> Bool
< :: Restrictions -> Restrictions -> Bool
$c< :: Restrictions -> Restrictions -> Bool
compare :: Restrictions -> Restrictions -> Ordering
$ccompare :: Restrictions -> Restrictions -> Ordering
Ord, Value -> Parser [Restrictions]
Value -> Parser Restrictions
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Restrictions]
$cparseJSONList :: Value -> Parser [Restrictions]
parseJSON :: Value -> Parser Restrictions
$cparseJSON :: Value -> Parser Restrictions
FromJSON)

newtype ExternalIDs = ExternalIDs {ExternalIDs -> Map Text Text
unwrap :: Map Text Text}
    deriving (Int -> ExternalIDs -> ShowS
[ExternalIDs] -> ShowS
ExternalIDs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalIDs] -> ShowS
$cshowList :: [ExternalIDs] -> ShowS
show :: ExternalIDs -> String
$cshow :: ExternalIDs -> String
showsPrec :: Int -> ExternalIDs -> ShowS
$cshowsPrec :: Int -> ExternalIDs -> ShowS
Show)
    deriving newtype (ExternalIDs -> ExternalIDs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalIDs -> ExternalIDs -> Bool
$c/= :: ExternalIDs -> ExternalIDs -> Bool
== :: ExternalIDs -> ExternalIDs -> Bool
$c== :: ExternalIDs -> ExternalIDs -> Bool
Eq, Eq ExternalIDs
ExternalIDs -> ExternalIDs -> Bool
ExternalIDs -> ExternalIDs -> Ordering
ExternalIDs -> ExternalIDs -> ExternalIDs
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 :: ExternalIDs -> ExternalIDs -> ExternalIDs
$cmin :: ExternalIDs -> ExternalIDs -> ExternalIDs
max :: ExternalIDs -> ExternalIDs -> ExternalIDs
$cmax :: ExternalIDs -> ExternalIDs -> ExternalIDs
>= :: ExternalIDs -> ExternalIDs -> Bool
$c>= :: ExternalIDs -> ExternalIDs -> Bool
> :: ExternalIDs -> ExternalIDs -> Bool
$c> :: ExternalIDs -> ExternalIDs -> Bool
<= :: ExternalIDs -> ExternalIDs -> Bool
$c<= :: ExternalIDs -> ExternalIDs -> Bool
< :: ExternalIDs -> ExternalIDs -> Bool
$c< :: ExternalIDs -> ExternalIDs -> Bool
compare :: ExternalIDs -> ExternalIDs -> Ordering
$ccompare :: ExternalIDs -> ExternalIDs -> Ordering
Ord, Value -> Parser [ExternalIDs]
Value -> Parser ExternalIDs
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExternalIDs]
$cparseJSONList :: Value -> Parser [ExternalIDs]
parseJSON :: Value -> Parser ExternalIDs
$cparseJSON :: Value -> Parser ExternalIDs
FromJSON)

newtype ExternalURLs = ExternalURLs {ExternalURLs -> Map Text Text
unwrap :: Map Text Text}
    deriving (Int -> ExternalURLs -> ShowS
[ExternalURLs] -> ShowS
ExternalURLs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalURLs] -> ShowS
$cshowList :: [ExternalURLs] -> ShowS
show :: ExternalURLs -> String
$cshow :: ExternalURLs -> String
showsPrec :: Int -> ExternalURLs -> ShowS
$cshowsPrec :: Int -> ExternalURLs -> ShowS
Show)
    deriving newtype (ExternalURLs -> ExternalURLs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalURLs -> ExternalURLs -> Bool
$c/= :: ExternalURLs -> ExternalURLs -> Bool
== :: ExternalURLs -> ExternalURLs -> Bool
$c== :: ExternalURLs -> ExternalURLs -> Bool
Eq, Eq ExternalURLs
ExternalURLs -> ExternalURLs -> Bool
ExternalURLs -> ExternalURLs -> Ordering
ExternalURLs -> ExternalURLs -> ExternalURLs
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 :: ExternalURLs -> ExternalURLs -> ExternalURLs
$cmin :: ExternalURLs -> ExternalURLs -> ExternalURLs
max :: ExternalURLs -> ExternalURLs -> ExternalURLs
$cmax :: ExternalURLs -> ExternalURLs -> ExternalURLs
>= :: ExternalURLs -> ExternalURLs -> Bool
$c>= :: ExternalURLs -> ExternalURLs -> Bool
> :: ExternalURLs -> ExternalURLs -> Bool
$c> :: ExternalURLs -> ExternalURLs -> Bool
<= :: ExternalURLs -> ExternalURLs -> Bool
$c<= :: ExternalURLs -> ExternalURLs -> Bool
< :: ExternalURLs -> ExternalURLs -> Bool
$c< :: ExternalURLs -> ExternalURLs -> Bool
compare :: ExternalURLs -> ExternalURLs -> Ordering
$ccompare :: ExternalURLs -> ExternalURLs -> Ordering
Ord, Value -> Parser [ExternalURLs]
Value -> Parser ExternalURLs
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExternalURLs]
$cparseJSONList :: Value -> Parser [ExternalURLs]
parseJSON :: Value -> Parser ExternalURLs
$cparseJSON :: Value -> Parser ExternalURLs
FromJSON)

data Scope
    = UgcImageUpload
    | UserModifyPlaybackState
    | UserReadPlaybackState
    | UserReadCurrentlyPlaying
    | UserFollowModify
    | UserFollowRead
    | UserReadRecentlyPlayed
    | UserReadPlaybackPosition
    | UserTopRead
    | PlaylistReadCollaborative
    | PlaylistModifyPublic
    | PlaylistReadPrivate
    | PlaylistModifyPrivate
    | AppRemoteControl
    | Streaming
    | UserReadEmail
    | UserReadPrivate
    | UserLibraryModify
    | UserLibraryRead
    deriving (Scope -> Scope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq, Eq Scope
Scope -> Scope -> Bool
Scope -> Scope -> Ordering
Scope -> Scope -> Scope
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 :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmax :: Scope -> Scope -> Scope
>= :: Scope -> Scope -> Bool
$c>= :: Scope -> Scope -> Bool
> :: Scope -> Scope -> Bool
$c> :: Scope -> Scope -> Bool
<= :: Scope -> Scope -> Bool
$c<= :: Scope -> Scope -> Bool
< :: Scope -> Scope -> Bool
$c< :: Scope -> Scope -> Bool
compare :: Scope -> Scope -> Ordering
$ccompare :: Scope -> Scope -> Ordering
Ord, Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, Int -> Scope
Scope -> Int
Scope -> [Scope]
Scope -> Scope
Scope -> Scope -> [Scope]
Scope -> Scope -> Scope -> [Scope]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Scope -> Scope -> Scope -> [Scope]
$cenumFromThenTo :: Scope -> Scope -> Scope -> [Scope]
enumFromTo :: Scope -> Scope -> [Scope]
$cenumFromTo :: Scope -> Scope -> [Scope]
enumFromThen :: Scope -> Scope -> [Scope]
$cenumFromThen :: Scope -> Scope -> [Scope]
enumFrom :: Scope -> [Scope]
$cenumFrom :: Scope -> [Scope]
fromEnum :: Scope -> Int
$cfromEnum :: Scope -> Int
toEnum :: Int -> Scope
$ctoEnum :: Int -> Scope
pred :: Scope -> Scope
$cpred :: Scope -> Scope
succ :: Scope -> Scope
$csucc :: Scope -> Scope
Enum, Scope
forall a. a -> a -> Bounded a
maxBound :: Scope
$cmaxBound :: Scope
minBound :: Scope
$cminBound :: Scope
Bounded)
allScopes :: Set.Set Scope
allScopes :: Set Scope
allScopes = forall a. Ord a => [a] -> Set a
Set.fromList forall a. (Enum a, Bounded a) => [a]
enumerate
showScope :: Scope -> Text
showScope :: Scope -> Text
showScope = \case
    Scope
UgcImageUpload -> Text
"ugc-image-upload"
    Scope
UserModifyPlaybackState -> Text
"user-modify-playback-state"
    Scope
UserReadPlaybackState -> Text
"user-read-playback-state"
    Scope
UserReadCurrentlyPlaying -> Text
"user-read-currently-playing"
    Scope
UserFollowModify -> Text
"user-follow-modify"
    Scope
UserFollowRead -> Text
"user-follow-read"
    Scope
UserReadRecentlyPlayed -> Text
"user-read-recently-played"
    Scope
UserReadPlaybackPosition -> Text
"user-read-playback-position"
    Scope
UserTopRead -> Text
"user-top-read"
    Scope
PlaylistReadCollaborative -> Text
"playlist-read-collaborative"
    Scope
PlaylistModifyPublic -> Text
"playlist-modify-public"
    Scope
PlaylistReadPrivate -> Text
"playlist-read-private"
    Scope
PlaylistModifyPrivate -> Text
"playlist-modify-private"
    Scope
AppRemoteControl -> Text
"app-remote-control"
    Scope
Streaming -> Text
"streaming"
    Scope
UserReadEmail -> Text
"user-read-email"
    Scope
UserReadPrivate -> Text
"user-read-private"
    Scope
UserLibraryModify -> Text
"user-library-modify"
    Scope
UserLibraryRead -> Text
"user-library-read"