{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Web.TwitchAPI.Helix.Users where

import Prelude

import Data.Functor  ( (<&>) )

import qualified Data.ByteString.Char8 as BS
import qualified Data.Time             as Time
import qualified Data.Time.RFC3339     as Time ( parseTimeRFC3339 )
import qualified Network.HTTP.Client   as HTTP

import Data.Aeson        ( FromJSON(..), (.:), withObject )
import Data.Aeson.KeyMap ( toAscList )

import qualified Web.TwitchAPI.Helix.Request as Req

-- BUG: Not yet implemented:
--   - Update User
--   - Block/Unblock User
--   - Update User Extensions

class DisplayName a where
    displayName :: a -> String

class ExtensionId a where
    extensionId :: a -> String

class IsActive a where
    active :: a -> Bool

class Named a where
    name :: a -> String

class UserId a where
    userId :: a -> Integer

class Versioned a where
    version :: a -> String

data User = User { User -> Maybe String
lookupId :: Maybe String
                 , User -> Maybe String
username :: Maybe String
                 } deriving ( Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> User -> ShowS
showsPrec :: Int -> User -> ShowS
$cshow :: User -> String
show :: User -> String
$cshowList :: [User] -> ShowS
showList :: [User] -> ShowS
Show )

instance Req.HelixRequest User where
    toRequest :: User -> Request
toRequest User
user =
        let [(ByteString, Maybe ByteString)]
lookupId' :: [(BS.ByteString, Maybe BS.ByteString)] = [(ByteString, Maybe ByteString)]
-> (String -> [(ByteString, Maybe ByteString)])
-> Maybe String
-> [(ByteString, Maybe ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
i -> [(ByteString
"id", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (String -> ByteString) -> String -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> ByteString) -> ShowS -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show (String -> Maybe ByteString) -> String -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String
i)]) (User -> Maybe String
lookupId User
user)
            [(ByteString, Maybe ByteString)]
username' :: [(BS.ByteString, Maybe BS.ByteString)] = [(ByteString, Maybe ByteString)]
-> (String -> [(ByteString, Maybe ByteString)])
-> Maybe String
-> [(ByteString, Maybe ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
u -> [(ByteString
"login", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (String -> ByteString) -> String -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> Maybe ByteString) -> String -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String
u)]) (User -> Maybe String
username User
user)
            setQuery :: Request -> Request
setQuery = [(ByteString, Maybe ByteString)] -> Request -> Request
HTTP.setQueryString ([(ByteString, Maybe ByteString)] -> Request -> Request)
-> [(ByteString, Maybe ByteString)] -> Request -> Request
forall a b. (a -> b) -> a -> b
$ [(ByteString, Maybe ByteString)]
lookupId' [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. [a] -> [a] -> [a]
++ [(ByteString, Maybe ByteString)]
username'
        in Request -> Request
setQuery (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ String -> Request
HTTP.parseRequest_ String
"GET https://api.twitch.tv/helix/users"
    scope :: User -> Maybe String
scope User{} = String -> Maybe String
forall a. a -> Maybe a
Just String
"user:read:email"

data BroadcasterType = Partner | Affiliate | None deriving ( BroadcasterType -> BroadcasterType -> Bool
(BroadcasterType -> BroadcasterType -> Bool)
-> (BroadcasterType -> BroadcasterType -> Bool)
-> Eq BroadcasterType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BroadcasterType -> BroadcasterType -> Bool
== :: BroadcasterType -> BroadcasterType -> Bool
$c/= :: BroadcasterType -> BroadcasterType -> Bool
/= :: BroadcasterType -> BroadcasterType -> Bool
Eq, Int -> BroadcasterType -> ShowS
[BroadcasterType] -> ShowS
BroadcasterType -> String
(Int -> BroadcasterType -> ShowS)
-> (BroadcasterType -> String)
-> ([BroadcasterType] -> ShowS)
-> Show BroadcasterType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BroadcasterType -> ShowS
showsPrec :: Int -> BroadcasterType -> ShowS
$cshow :: BroadcasterType -> String
show :: BroadcasterType -> String
$cshowList :: [BroadcasterType] -> ShowS
showList :: [BroadcasterType] -> ShowS
Show )

instance Read BroadcasterType where
    readsPrec :: Int -> ReadS BroadcasterType
readsPrec Int
_ String
"partner"   = [(BroadcasterType
Partner, String
"")]
    readsPrec Int
_ String
"affiliate" = [(BroadcasterType
Affiliate, String
"")]
    readsPrec Int
_ String
_           = [(BroadcasterType
None, String
"")]

data UserType = Staff | Admin | GlobalMod | NormalUser deriving ( UserType -> UserType -> Bool
(UserType -> UserType -> Bool)
-> (UserType -> UserType -> Bool) -> Eq UserType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserType -> UserType -> Bool
== :: UserType -> UserType -> Bool
$c/= :: UserType -> UserType -> Bool
/= :: UserType -> UserType -> Bool
Eq, Int -> UserType -> ShowS
[UserType] -> ShowS
UserType -> String
(Int -> UserType -> ShowS)
-> (UserType -> String) -> ([UserType] -> ShowS) -> Show UserType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserType -> ShowS
showsPrec :: Int -> UserType -> ShowS
$cshow :: UserType -> String
show :: UserType -> String
$cshowList :: [UserType] -> ShowS
showList :: [UserType] -> ShowS
Show )

instance Read UserType where
    readsPrec :: Int -> ReadS UserType
readsPrec Int
_ String
"staff"      = [(UserType
Staff, String
"")]
    readsPrec Int
_ String
"admin"      = [(UserType
Admin, String
"")]
    readsPrec Int
_ String
"global_mod" = [(UserType
GlobalMod, String
"")]
    readsPrec Int
_ String
_            = [(UserType
NormalUser, String
"")]

data UserEntry = UserEntry { UserEntry -> BroadcasterType
broadcasterType :: BroadcasterType
                           , UserEntry -> String
description     :: String
                           , UserEntry -> String
userDisplayName :: String
                           , UserEntry -> Integer
userEntryId     :: Integer
                           , UserEntry -> String
login           :: String
                           , UserEntry -> String
offlineImageURL :: String
                           , UserEntry -> String
profileImageURL :: String
                           , UserEntry -> UserType
userType        :: UserType
                           , UserEntry -> Maybe String
email           :: Maybe String
                           , UserEntry -> Maybe UTCTime
createdAt       :: Maybe Time.UTCTime
                           } deriving ( Int -> UserEntry -> ShowS
[UserEntry] -> ShowS
UserEntry -> String
(Int -> UserEntry -> ShowS)
-> (UserEntry -> String)
-> ([UserEntry] -> ShowS)
-> Show UserEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserEntry -> ShowS
showsPrec :: Int -> UserEntry -> ShowS
$cshow :: UserEntry -> String
show :: UserEntry -> String
$cshowList :: [UserEntry] -> ShowS
showList :: [UserEntry] -> ShowS
Show, UserEntry -> UserEntry -> Bool
(UserEntry -> UserEntry -> Bool)
-> (UserEntry -> UserEntry -> Bool) -> Eq UserEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserEntry -> UserEntry -> Bool
== :: UserEntry -> UserEntry -> Bool
$c/= :: UserEntry -> UserEntry -> Bool
/= :: UserEntry -> UserEntry -> Bool
Eq )

instance FromJSON UserEntry where
    parseJSON :: Value -> Parser UserEntry
parseJSON = String -> (Object -> Parser UserEntry) -> Value -> Parser UserEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserEntry" ((Object -> Parser UserEntry) -> Value -> Parser UserEntry)
-> (Object -> Parser UserEntry) -> Value -> Parser UserEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        String
userId' :: String <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        String
created :: String <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
        String
userType' :: String <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        String
broadcasterType' :: String <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"broadcaster_type"
        let userEntryId :: Integer
userEntryId = String -> Integer
forall a. Read a => String -> a
read String
userId' :: Integer
            createdAt :: Maybe UTCTime
createdAt = ZonedTime -> UTCTime
Time.zonedTimeToUTC (ZonedTime -> UTCTime) -> Maybe ZonedTime -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe ZonedTime
forall t. TextualMonoid t => t -> Maybe ZonedTime
Time.parseTimeRFC3339 String
created
            userType :: UserType
userType = String -> UserType
forall a. Read a => String -> a
read String
userType' :: UserType
            broadcasterType :: BroadcasterType
broadcasterType = String -> BroadcasterType
forall a. Read a => String -> a
read String
broadcasterType' :: BroadcasterType

        String
description <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
        String
userDisplayName <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"display_name"
        String
login <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"login"
        String
offlineImageURL <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"offline_image_url"
        String
profileImageURL <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"profile_image_url"
        Maybe String
email <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
        UserEntry -> Parser UserEntry
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return UserEntry{Integer
String
Maybe String
Maybe UTCTime
UserType
BroadcasterType
broadcasterType :: BroadcasterType
description :: String
userDisplayName :: String
userEntryId :: Integer
login :: String
offlineImageURL :: String
profileImageURL :: String
userType :: UserType
email :: Maybe String
createdAt :: Maybe UTCTime
userEntryId :: Integer
createdAt :: Maybe UTCTime
userType :: UserType
broadcasterType :: BroadcasterType
description :: String
userDisplayName :: String
login :: String
offlineImageURL :: String
profileImageURL :: String
email :: Maybe String
..}

instance DisplayName UserEntry where
    displayName :: UserEntry -> String
displayName = UserEntry -> String
userDisplayName

instance UserId UserEntry where
    userId :: UserEntry -> Integer
userId = UserEntry -> Integer
userEntryId

data Users = Users { Users -> [Integer]
lookupIds :: [Integer]
                   , Users -> [String]
usernames :: [String]
                   } deriving ( Int -> Users -> ShowS
[Users] -> ShowS
Users -> String
(Int -> Users -> ShowS)
-> (Users -> String) -> ([Users] -> ShowS) -> Show Users
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Users -> ShowS
showsPrec :: Int -> Users -> ShowS
$cshow :: Users -> String
show :: Users -> String
$cshowList :: [Users] -> ShowS
showList :: [Users] -> ShowS
Show, Users -> Users -> Bool
(Users -> Users -> Bool) -> (Users -> Users -> Bool) -> Eq Users
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Users -> Users -> Bool
== :: Users -> Users -> Bool
$c/= :: Users -> Users -> Bool
/= :: Users -> Users -> Bool
Eq )

instance Req.HelixRequest Users where
    toRequest :: Users -> Request
toRequest Users
users =
        let [(ByteString, Maybe ByteString)]
lookupId' :: [(BS.ByteString, Maybe BS.ByteString)] = (\Integer
i -> (ByteString
"id", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Integer -> ByteString) -> Integer -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> ByteString)
-> (Integer -> String) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Maybe ByteString) -> Integer -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Integer
i)) (Integer -> (ByteString, Maybe ByteString))
-> [Integer] -> [(ByteString, Maybe ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Users -> [Integer]
lookupIds Users
users
            [(ByteString, Maybe ByteString)]
username' :: [(BS.ByteString, Maybe BS.ByteString)] = (\String
u -> (ByteString
"login", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (String -> ByteString) -> String -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> Maybe ByteString) -> String -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String
u)) (String -> (ByteString, Maybe ByteString))
-> [String] -> [(ByteString, Maybe ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Users -> [String]
usernames Users
users
            setQuery :: Request -> Request
setQuery = [(ByteString, Maybe ByteString)] -> Request -> Request
HTTP.setQueryString ([(ByteString, Maybe ByteString)] -> Request -> Request)
-> [(ByteString, Maybe ByteString)] -> Request -> Request
forall a b. (a -> b) -> a -> b
$ [(ByteString, Maybe ByteString)]
lookupId' [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. [a] -> [a] -> [a]
++ [(ByteString, Maybe ByteString)]
username'
        in Request -> Request
setQuery (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ String -> Request
HTTP.parseRequest_ String
"GET https://api.twitch.tv/helix/users"
    scope :: Users -> Maybe String
scope Users{} = Maybe String
forall a. Maybe a
Nothing

newtype UsersResponse = UsersResponse { UsersResponse -> [UserEntry]
users :: [UserEntry] } deriving ( UsersResponse -> UsersResponse -> Bool
(UsersResponse -> UsersResponse -> Bool)
-> (UsersResponse -> UsersResponse -> Bool) -> Eq UsersResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UsersResponse -> UsersResponse -> Bool
== :: UsersResponse -> UsersResponse -> Bool
$c/= :: UsersResponse -> UsersResponse -> Bool
/= :: UsersResponse -> UsersResponse -> Bool
Eq, Int -> UsersResponse -> ShowS
[UsersResponse] -> ShowS
UsersResponse -> String
(Int -> UsersResponse -> ShowS)
-> (UsersResponse -> String)
-> ([UsersResponse] -> ShowS)
-> Show UsersResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UsersResponse -> ShowS
showsPrec :: Int -> UsersResponse -> ShowS
$cshow :: UsersResponse -> String
show :: UsersResponse -> String
$cshowList :: [UsersResponse] -> ShowS
showList :: [UsersResponse] -> ShowS
Show )

instance FromJSON UsersResponse where
    parseJSON :: Value -> Parser UsersResponse
parseJSON = String
-> (Object -> Parser UsersResponse)
-> Value
-> Parser UsersResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UsersResponse" ((Object -> Parser UsersResponse) -> Value -> Parser UsersResponse)
-> (Object -> Parser UsersResponse)
-> Value
-> Parser UsersResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [UserEntry]
users <- Object
o Object -> Key -> Parser [UserEntry]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
        UsersResponse -> Parser UsersResponse
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return UsersResponse{[UserEntry]
users :: [UserEntry]
users :: [UserEntry]
..}

data Follows = Follows { Follows -> Maybe String
after :: Maybe String
                       , Follows -> Maybe Integer
max :: Maybe Integer
                       , Follows -> Maybe Integer
from :: Maybe Integer
                       , Follows -> Maybe Integer
to :: Maybe Integer
                       } deriving ( Int -> Follows -> ShowS
[Follows] -> ShowS
Follows -> String
(Int -> Follows -> ShowS)
-> (Follows -> String) -> ([Follows] -> ShowS) -> Show Follows
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Follows -> ShowS
showsPrec :: Int -> Follows -> ShowS
$cshow :: Follows -> String
show :: Follows -> String
$cshowList :: [Follows] -> ShowS
showList :: [Follows] -> ShowS
Show, Follows -> Follows -> Bool
(Follows -> Follows -> Bool)
-> (Follows -> Follows -> Bool) -> Eq Follows
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Follows -> Follows -> Bool
== :: Follows -> Follows -> Bool
$c/= :: Follows -> Follows -> Bool
/= :: Follows -> Follows -> Bool
Eq )

instance Req.HelixRequest Follows where
    toRequest :: Follows -> Request
toRequest Follows
user =
        let [(ByteString, Maybe ByteString)]
after' :: [(BS.ByteString, Maybe BS.ByteString)] = [(ByteString, Maybe ByteString)]
-> (String -> [(ByteString, Maybe ByteString)])
-> Maybe String
-> [(ByteString, Maybe ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
a -> [(ByteString
"after", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (String -> ByteString) -> String -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> Maybe ByteString) -> String -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String
a)]) (Follows -> Maybe String
after Follows
user)
            [(ByteString, Maybe ByteString)]
max' :: [(BS.ByteString, Maybe BS.ByteString)] = [(ByteString, Maybe ByteString)]
-> (Integer -> [(ByteString, Maybe ByteString)])
-> Maybe Integer
-> [(ByteString, Maybe ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
u -> [(ByteString
"first", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Integer -> ByteString) -> Integer -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> ByteString)
-> (Integer -> String) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Maybe ByteString) -> Integer -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Integer
u)]) (Follows -> Maybe Integer
from Follows
user)
            [(ByteString, Maybe ByteString)]
fromId' :: [(BS.ByteString, Maybe BS.ByteString)] = [(ByteString, Maybe ByteString)]
-> (Integer -> [(ByteString, Maybe ByteString)])
-> Maybe Integer
-> [(ByteString, Maybe ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
u -> [(ByteString
"after", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Integer -> ByteString) -> Integer -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> ByteString)
-> (Integer -> String) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Maybe ByteString) -> Integer -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Integer
u)]) (Follows -> Maybe Integer
from Follows
user)
            [(ByteString, Maybe ByteString)]
toId' :: [(BS.ByteString, Maybe BS.ByteString)] = [(ByteString, Maybe ByteString)]
-> (Integer -> [(ByteString, Maybe ByteString)])
-> Maybe Integer
-> [(ByteString, Maybe ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
u -> [(ByteString
"after", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Integer -> ByteString) -> Integer -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> ByteString)
-> (Integer -> String) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Maybe ByteString) -> Integer -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Integer
u)]) (Follows -> Maybe Integer
to Follows
user)
            setQuery :: Request -> Request
setQuery = [(ByteString, Maybe ByteString)] -> Request -> Request
HTTP.setQueryString ([(ByteString, Maybe ByteString)] -> Request -> Request)
-> [(ByteString, Maybe ByteString)] -> Request -> Request
forall a b. (a -> b) -> a -> b
$ [[(ByteString, Maybe ByteString)]]
-> [(ByteString, Maybe ByteString)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(ByteString, Maybe ByteString)]
after', [(ByteString, Maybe ByteString)]
max', [(ByteString, Maybe ByteString)]
fromId', [(ByteString, Maybe ByteString)]
toId']
        in Request -> Request
setQuery (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ String -> Request
HTTP.parseRequest_ String
"GET https://api.twitch.tv/helix/users/follows"
    scope :: Follows -> Maybe String
scope Follows{} = Maybe String
forall a. Maybe a
Nothing

data FollowEntry = FollowEntry { FollowEntry -> Integer
fromId :: Integer
                               , FollowEntry -> String
fromLogin :: String
                               , FollowEntry -> String
fromName :: String
                               , FollowEntry -> Integer
toId :: Integer
                               , FollowEntry -> String
toName :: String
                               , FollowEntry -> Maybe UTCTime
followedAt :: Maybe Time.UTCTime
                               } deriving ( Int -> FollowEntry -> ShowS
[FollowEntry] -> ShowS
FollowEntry -> String
(Int -> FollowEntry -> ShowS)
-> (FollowEntry -> String)
-> ([FollowEntry] -> ShowS)
-> Show FollowEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FollowEntry -> ShowS
showsPrec :: Int -> FollowEntry -> ShowS
$cshow :: FollowEntry -> String
show :: FollowEntry -> String
$cshowList :: [FollowEntry] -> ShowS
showList :: [FollowEntry] -> ShowS
Show, FollowEntry -> FollowEntry -> Bool
(FollowEntry -> FollowEntry -> Bool)
-> (FollowEntry -> FollowEntry -> Bool) -> Eq FollowEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FollowEntry -> FollowEntry -> Bool
== :: FollowEntry -> FollowEntry -> Bool
$c/= :: FollowEntry -> FollowEntry -> Bool
/= :: FollowEntry -> FollowEntry -> Bool
Eq )

instance FromJSON FollowEntry where
    parseJSON :: Value -> Parser FollowEntry
parseJSON = String
-> (Object -> Parser FollowEntry) -> Value -> Parser FollowEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FollowEntry" ((Object -> Parser FollowEntry) -> Value -> Parser FollowEntry)
-> (Object -> Parser FollowEntry) -> Value -> Parser FollowEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        String
fromId' :: String <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"from_id"
        String
toId' :: String <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"to_id"
        String
followedAt' :: String <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"followed_at"
        let fromId :: Integer
fromId = String -> Integer
forall a. Read a => String -> a
read String
fromId' :: Integer
            toId :: Integer
toId = String -> Integer
forall a. Read a => String -> a
read String
toId' :: Integer
            followedAt :: Maybe UTCTime
followedAt = ZonedTime -> UTCTime
Time.zonedTimeToUTC (ZonedTime -> UTCTime) -> Maybe ZonedTime -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe ZonedTime
forall t. TextualMonoid t => t -> Maybe ZonedTime
Time.parseTimeRFC3339 String
followedAt'
        String
fromLogin <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"from_login"
        String
fromName <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"from_name"
        String
toName <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"to_name"
        FollowEntry -> Parser FollowEntry
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return FollowEntry{Integer
String
Maybe UTCTime
fromId :: Integer
fromLogin :: String
fromName :: String
toId :: Integer
toName :: String
followedAt :: Maybe UTCTime
fromId :: Integer
toId :: Integer
followedAt :: Maybe UTCTime
fromLogin :: String
fromName :: String
toName :: String
..}

data FollowsResponse = FollowsResponse { FollowsResponse -> Integer
total :: Integer
                                       , FollowsResponse -> [FollowEntry]
follows :: [FollowEntry]
                                       , FollowsResponse -> String
paginationCursor :: String
                                       } deriving ( Int -> FollowsResponse -> ShowS
[FollowsResponse] -> ShowS
FollowsResponse -> String
(Int -> FollowsResponse -> ShowS)
-> (FollowsResponse -> String)
-> ([FollowsResponse] -> ShowS)
-> Show FollowsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FollowsResponse -> ShowS
showsPrec :: Int -> FollowsResponse -> ShowS
$cshow :: FollowsResponse -> String
show :: FollowsResponse -> String
$cshowList :: [FollowsResponse] -> ShowS
showList :: [FollowsResponse] -> ShowS
Show, FollowsResponse -> FollowsResponse -> Bool
(FollowsResponse -> FollowsResponse -> Bool)
-> (FollowsResponse -> FollowsResponse -> Bool)
-> Eq FollowsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FollowsResponse -> FollowsResponse -> Bool
== :: FollowsResponse -> FollowsResponse -> Bool
$c/= :: FollowsResponse -> FollowsResponse -> Bool
/= :: FollowsResponse -> FollowsResponse -> Bool
Eq )

instance FromJSON FollowsResponse where
    parseJSON :: Value -> Parser FollowsResponse
parseJSON = String
-> (Object -> Parser FollowsResponse)
-> Value
-> Parser FollowsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FollowsResponse" ((Object -> Parser FollowsResponse)
 -> Value -> Parser FollowsResponse)
-> (Object -> Parser FollowsResponse)
-> Value
-> Parser FollowsResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Integer
total <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
        String
paginationCursor <- (Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pagination") Parser Object -> (Object -> Parser String) -> Parser String
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cursor")
        [FollowEntry]
follows <- Object
o Object -> Key -> Parser [FollowEntry]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
        FollowsResponse -> Parser FollowsResponse
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return FollowsResponse{Integer
String
[FollowEntry]
total :: Integer
follows :: [FollowEntry]
paginationCursor :: String
total :: Integer
paginationCursor :: String
follows :: [FollowEntry]
..}

newtype BlockList = BlockList { BlockList -> Integer
broadcasterId :: Integer } deriving ( Int -> BlockList -> ShowS
[BlockList] -> ShowS
BlockList -> String
(Int -> BlockList -> ShowS)
-> (BlockList -> String)
-> ([BlockList] -> ShowS)
-> Show BlockList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockList -> ShowS
showsPrec :: Int -> BlockList -> ShowS
$cshow :: BlockList -> String
show :: BlockList -> String
$cshowList :: [BlockList] -> ShowS
showList :: [BlockList] -> ShowS
Show, BlockList -> BlockList -> Bool
(BlockList -> BlockList -> Bool)
-> (BlockList -> BlockList -> Bool) -> Eq BlockList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockList -> BlockList -> Bool
== :: BlockList -> BlockList -> Bool
$c/= :: BlockList -> BlockList -> Bool
/= :: BlockList -> BlockList -> Bool
Eq )

instance Req.HelixRequest BlockList where
    toRequest :: BlockList -> Request
toRequest BlockList
user =
        [(ByteString, Maybe ByteString)] -> Request -> Request
HTTP.setQueryString [(ByteString
"login", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (BlockList -> ByteString) -> BlockList -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> ByteString)
-> (BlockList -> String) -> BlockList -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String)
-> (BlockList -> Integer) -> BlockList -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockList -> Integer
broadcasterId (BlockList -> Maybe ByteString) -> BlockList -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ BlockList
user)] (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
            String -> Request
HTTP.parseRequest_ String
"https://api.twitch.tv/helix/users/blocks"
    scope :: BlockList -> Maybe String
scope BlockList{} = String -> Maybe String
forall a. a -> Maybe a
Just String
"user:read:blocked_users"

data BlockListEntry = BlockListEntry { BlockListEntry -> Integer
blockedUserId :: Integer
                                     , BlockListEntry -> String
userLogin :: String
                                     , BlockListEntry -> String
blockedDisplayName :: String
                                     } deriving ( Int -> BlockListEntry -> ShowS
[BlockListEntry] -> ShowS
BlockListEntry -> String
(Int -> BlockListEntry -> ShowS)
-> (BlockListEntry -> String)
-> ([BlockListEntry] -> ShowS)
-> Show BlockListEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockListEntry -> ShowS
showsPrec :: Int -> BlockListEntry -> ShowS
$cshow :: BlockListEntry -> String
show :: BlockListEntry -> String
$cshowList :: [BlockListEntry] -> ShowS
showList :: [BlockListEntry] -> ShowS
Show, BlockListEntry -> BlockListEntry -> Bool
(BlockListEntry -> BlockListEntry -> Bool)
-> (BlockListEntry -> BlockListEntry -> Bool) -> Eq BlockListEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockListEntry -> BlockListEntry -> Bool
== :: BlockListEntry -> BlockListEntry -> Bool
$c/= :: BlockListEntry -> BlockListEntry -> Bool
/= :: BlockListEntry -> BlockListEntry -> Bool
Eq )

instance FromJSON BlockListEntry where
    parseJSON :: Value -> Parser BlockListEntry
parseJSON = String
-> (Object -> Parser BlockListEntry)
-> Value
-> Parser BlockListEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BlockListEntry" ((Object -> Parser BlockListEntry)
 -> Value -> Parser BlockListEntry)
-> (Object -> Parser BlockListEntry)
-> Value
-> Parser BlockListEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        String
userId' :: String <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
        let blockedUserId :: Integer
blockedUserId = String -> Integer
forall a. Read a => String -> a
read String
userId' :: Integer
        String
userLogin <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_login"
        String
blockedDisplayName <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"display_name"
        BlockListEntry -> Parser BlockListEntry
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockListEntry{Integer
String
blockedUserId :: Integer
userLogin :: String
blockedDisplayName :: String
blockedUserId :: Integer
userLogin :: String
blockedDisplayName :: String
..}

instance DisplayName BlockListEntry where
    displayName :: BlockListEntry -> String
displayName = BlockListEntry -> String
blockedDisplayName

instance UserId BlockListEntry where
    userId :: BlockListEntry -> Integer
userId = BlockListEntry -> Integer
blockedUserId

newtype BlockListResponse = BlockListResponse { BlockListResponse -> [BlockListEntry]
blocks :: [BlockListEntry] } deriving ( Int -> BlockListResponse -> ShowS
[BlockListResponse] -> ShowS
BlockListResponse -> String
(Int -> BlockListResponse -> ShowS)
-> (BlockListResponse -> String)
-> ([BlockListResponse] -> ShowS)
-> Show BlockListResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockListResponse -> ShowS
showsPrec :: Int -> BlockListResponse -> ShowS
$cshow :: BlockListResponse -> String
show :: BlockListResponse -> String
$cshowList :: [BlockListResponse] -> ShowS
showList :: [BlockListResponse] -> ShowS
Show, BlockListResponse -> BlockListResponse -> Bool
(BlockListResponse -> BlockListResponse -> Bool)
-> (BlockListResponse -> BlockListResponse -> Bool)
-> Eq BlockListResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockListResponse -> BlockListResponse -> Bool
== :: BlockListResponse -> BlockListResponse -> Bool
$c/= :: BlockListResponse -> BlockListResponse -> Bool
/= :: BlockListResponse -> BlockListResponse -> Bool
Eq )

instance FromJSON BlockListResponse where
    parseJSON :: Value -> Parser BlockListResponse
parseJSON = String
-> (Object -> Parser BlockListResponse)
-> Value
-> Parser BlockListResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BlockListResponse" ((Object -> Parser BlockListResponse)
 -> Value -> Parser BlockListResponse)
-> (Object -> Parser BlockListResponse)
-> Value
-> Parser BlockListResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [BlockListEntry]
blocks <- Object
o Object -> Key -> Parser [BlockListEntry]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
        BlockListResponse -> Parser BlockListResponse
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockListResponse{[BlockListEntry]
blocks :: [BlockListEntry]
blocks :: [BlockListEntry]
..}

data Extensions = Extensions

instance Req.HelixRequest Extensions where
    toRequest :: Extensions -> Request
toRequest Extensions
_ = String -> Request
HTTP.parseRequest_ String
"GET https://api.twitch.tv/helix/users/extensions/list"
    scope :: Extensions -> Maybe String
scope Extensions
Extensions = String -> Maybe String
forall a. a -> Maybe a
Just String
"user:read:broadcast"

data ExtensionType = Component | Mobile | Panel | Overlay deriving ( Int -> ExtensionType -> ShowS
[ExtensionType] -> ShowS
ExtensionType -> String
(Int -> ExtensionType -> ShowS)
-> (ExtensionType -> String)
-> ([ExtensionType] -> ShowS)
-> Show ExtensionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtensionType -> ShowS
showsPrec :: Int -> ExtensionType -> ShowS
$cshow :: ExtensionType -> String
show :: ExtensionType -> String
$cshowList :: [ExtensionType] -> ShowS
showList :: [ExtensionType] -> ShowS
Show, ExtensionType -> ExtensionType -> Bool
(ExtensionType -> ExtensionType -> Bool)
-> (ExtensionType -> ExtensionType -> Bool) -> Eq ExtensionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtensionType -> ExtensionType -> Bool
== :: ExtensionType -> ExtensionType -> Bool
$c/= :: ExtensionType -> ExtensionType -> Bool
/= :: ExtensionType -> ExtensionType -> Bool
Eq )

instance Read ExtensionType where
    readsPrec :: Int -> ReadS ExtensionType
readsPrec Int
_ String
"component" = [(ExtensionType
Component, String
"")]
    readsPrec Int
_ String
"mobile"    = [(ExtensionType
Mobile, String
"")]
    readsPrec Int
_ String
"panel"     = [(ExtensionType
Panel, String
"")]
    readsPrec Int
_ String
"overlay"   = [(ExtensionType
Overlay, String
"")]
    readsPrec Int
_ String
_           = [(ExtensionType, String)]
forall a. Monoid a => a
mempty

data ExtensionsEntry = ExtensionsEntry { ExtensionsEntry -> Bool
canActivate :: Bool
                                       , ExtensionsEntry -> String
extensionEntryId :: String
                                       , ExtensionsEntry -> String
extensionName :: String
                                       , ExtensionsEntry -> [ExtensionType]
extensionTypes :: [ExtensionType]
                                       , ExtensionsEntry -> String
extensionVersion :: String
                                       } deriving ( Int -> ExtensionsEntry -> ShowS
[ExtensionsEntry] -> ShowS
ExtensionsEntry -> String
(Int -> ExtensionsEntry -> ShowS)
-> (ExtensionsEntry -> String)
-> ([ExtensionsEntry] -> ShowS)
-> Show ExtensionsEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtensionsEntry -> ShowS
showsPrec :: Int -> ExtensionsEntry -> ShowS
$cshow :: ExtensionsEntry -> String
show :: ExtensionsEntry -> String
$cshowList :: [ExtensionsEntry] -> ShowS
showList :: [ExtensionsEntry] -> ShowS
Show, ExtensionsEntry -> ExtensionsEntry -> Bool
(ExtensionsEntry -> ExtensionsEntry -> Bool)
-> (ExtensionsEntry -> ExtensionsEntry -> Bool)
-> Eq ExtensionsEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtensionsEntry -> ExtensionsEntry -> Bool
== :: ExtensionsEntry -> ExtensionsEntry -> Bool
$c/= :: ExtensionsEntry -> ExtensionsEntry -> Bool
/= :: ExtensionsEntry -> ExtensionsEntry -> Bool
Eq )

instance ExtensionId ExtensionsEntry where
    extensionId :: ExtensionsEntry -> String
extensionId = ExtensionsEntry -> String
extensionEntryId

instance Versioned ExtensionsEntry where
    version :: ExtensionsEntry -> String
version = ExtensionsEntry -> String
extensionVersion

instance FromJSON ExtensionsEntry where
    parseJSON :: Value -> Parser ExtensionsEntry
parseJSON = String
-> (Object -> Parser ExtensionsEntry)
-> Value
-> Parser ExtensionsEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExtensionsEntry" ((Object -> Parser ExtensionsEntry)
 -> Value -> Parser ExtensionsEntry)
-> (Object -> Parser ExtensionsEntry)
-> Value
-> Parser ExtensionsEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [String]
extensionTypes' :: [String] <- Object
o Object -> Key -> Parser [String]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        let [ExtensionType]
extensionTypes :: [ExtensionType] = String -> ExtensionType
forall a. Read a => String -> a
read (String -> ExtensionType) -> [String] -> [ExtensionType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
extensionTypes'
        Bool
canActivate <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"can_activate"
        String
extensionEntryId <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        String
extensionName <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
        String
extensionVersion <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
        ExtensionsEntry -> Parser ExtensionsEntry
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ExtensionsEntry{Bool
String
[ExtensionType]
canActivate :: Bool
extensionEntryId :: String
extensionName :: String
extensionTypes :: [ExtensionType]
extensionVersion :: String
extensionTypes :: [ExtensionType]
canActivate :: Bool
extensionEntryId :: String
extensionName :: String
extensionVersion :: String
..}

newtype ExtensionsResponse = ExtensionsResponse { ExtensionsResponse -> [ExtensionsEntry]
extensions :: [ExtensionsEntry] } deriving ( Int -> ExtensionsResponse -> ShowS
[ExtensionsResponse] -> ShowS
ExtensionsResponse -> String
(Int -> ExtensionsResponse -> ShowS)
-> (ExtensionsResponse -> String)
-> ([ExtensionsResponse] -> ShowS)
-> Show ExtensionsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtensionsResponse -> ShowS
showsPrec :: Int -> ExtensionsResponse -> ShowS
$cshow :: ExtensionsResponse -> String
show :: ExtensionsResponse -> String
$cshowList :: [ExtensionsResponse] -> ShowS
showList :: [ExtensionsResponse] -> ShowS
Show, ExtensionsResponse -> ExtensionsResponse -> Bool
(ExtensionsResponse -> ExtensionsResponse -> Bool)
-> (ExtensionsResponse -> ExtensionsResponse -> Bool)
-> Eq ExtensionsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtensionsResponse -> ExtensionsResponse -> Bool
== :: ExtensionsResponse -> ExtensionsResponse -> Bool
$c/= :: ExtensionsResponse -> ExtensionsResponse -> Bool
/= :: ExtensionsResponse -> ExtensionsResponse -> Bool
Eq )

instance FromJSON ExtensionsResponse where
    parseJSON :: Value -> Parser ExtensionsResponse
parseJSON = String
-> (Object -> Parser ExtensionsResponse)
-> Value
-> Parser ExtensionsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExtensionsResponse" ((Object -> Parser ExtensionsResponse)
 -> Value -> Parser ExtensionsResponse)
-> (Object -> Parser ExtensionsResponse)
-> Value
-> Parser ExtensionsResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [ExtensionsEntry]
extensions <- Object
o Object -> Key -> Parser [ExtensionsEntry]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
        ExtensionsResponse -> Parser ExtensionsResponse
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ExtensionsResponse{[ExtensionsEntry]
extensions :: [ExtensionsEntry]
extensions :: [ExtensionsEntry]
..}

data ActiveExtensions = ActiveExtensions
                      | ActiveExtensionsFor Integer deriving ( Int -> ActiveExtensions -> ShowS
[ActiveExtensions] -> ShowS
ActiveExtensions -> String
(Int -> ActiveExtensions -> ShowS)
-> (ActiveExtensions -> String)
-> ([ActiveExtensions] -> ShowS)
-> Show ActiveExtensions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActiveExtensions -> ShowS
showsPrec :: Int -> ActiveExtensions -> ShowS
$cshow :: ActiveExtensions -> String
show :: ActiveExtensions -> String
$cshowList :: [ActiveExtensions] -> ShowS
showList :: [ActiveExtensions] -> ShowS
Show, ActiveExtensions -> ActiveExtensions -> Bool
(ActiveExtensions -> ActiveExtensions -> Bool)
-> (ActiveExtensions -> ActiveExtensions -> Bool)
-> Eq ActiveExtensions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveExtensions -> ActiveExtensions -> Bool
== :: ActiveExtensions -> ActiveExtensions -> Bool
$c/= :: ActiveExtensions -> ActiveExtensions -> Bool
/= :: ActiveExtensions -> ActiveExtensions -> Bool
Eq )

instance Req.HelixRequest ActiveExtensions where
    toRequest :: ActiveExtensions -> Request
toRequest (ActiveExtensionsFor Integer
i) =
        let setQuery :: Request -> Request
setQuery = [(ByteString, Maybe ByteString)] -> Request -> Request
HTTP.setQueryString [(ByteString
"user_id", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Integer -> ByteString) -> Integer -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> ByteString)
-> (Integer -> String) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Maybe ByteString) -> Integer -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Integer
i)]
        in Request -> Request
setQuery (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ String -> Request
HTTP.parseRequest_ String
"GET https://api.twitch.tv/helix/users/extensions"
    toRequest ActiveExtensions
ActiveExtensions = String -> Request
HTTP.parseRequest_ String
"GET https://api.twitch.tv/helix/users/extensions"
    scope :: ActiveExtensions -> Maybe String
scope ActiveExtensions
ActiveExtensions = Maybe String
forall a. Maybe a
Nothing
    scope (ActiveExtensionsFor Integer
_) = Maybe String
forall a. Maybe a
Nothing

data ActiveComponentExtensionEntry' = ActiveComponentExtensionEntry' { ActiveComponentExtensionEntry' -> Bool
activeComponentActive' :: Bool
                                                                     , ActiveComponentExtensionEntry' -> String
activeComponentExtensionId' :: String
                                                                     , ActiveComponentExtensionEntry' -> String
activeComponentVersion' :: String
                                                                     , ActiveComponentExtensionEntry' -> String
activeComponentName' :: String
                                                                     , ActiveComponentExtensionEntry' -> Integer
activeComponentX :: Integer
                                                                     , ActiveComponentExtensionEntry' -> Integer
activeComponentY :: Integer
                                                                     }
                                    | InactiveComponentExtension deriving ( Int -> ActiveComponentExtensionEntry' -> ShowS
[ActiveComponentExtensionEntry'] -> ShowS
ActiveComponentExtensionEntry' -> String
(Int -> ActiveComponentExtensionEntry' -> ShowS)
-> (ActiveComponentExtensionEntry' -> String)
-> ([ActiveComponentExtensionEntry'] -> ShowS)
-> Show ActiveComponentExtensionEntry'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActiveComponentExtensionEntry' -> ShowS
showsPrec :: Int -> ActiveComponentExtensionEntry' -> ShowS
$cshow :: ActiveComponentExtensionEntry' -> String
show :: ActiveComponentExtensionEntry' -> String
$cshowList :: [ActiveComponentExtensionEntry'] -> ShowS
showList :: [ActiveComponentExtensionEntry'] -> ShowS
Show, ActiveComponentExtensionEntry'
-> ActiveComponentExtensionEntry' -> Bool
(ActiveComponentExtensionEntry'
 -> ActiveComponentExtensionEntry' -> Bool)
-> (ActiveComponentExtensionEntry'
    -> ActiveComponentExtensionEntry' -> Bool)
-> Eq ActiveComponentExtensionEntry'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveComponentExtensionEntry'
-> ActiveComponentExtensionEntry' -> Bool
== :: ActiveComponentExtensionEntry'
-> ActiveComponentExtensionEntry' -> Bool
$c/= :: ActiveComponentExtensionEntry'
-> ActiveComponentExtensionEntry' -> Bool
/= :: ActiveComponentExtensionEntry'
-> ActiveComponentExtensionEntry' -> Bool
Eq )

instance FromJSON ActiveComponentExtensionEntry' where
    parseJSON :: Value -> Parser ActiveComponentExtensionEntry'
parseJSON = String
-> (Object -> Parser ActiveComponentExtensionEntry')
-> Value
-> Parser ActiveComponentExtensionEntry'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActiveExtensionEntry" ((Object -> Parser ActiveComponentExtensionEntry')
 -> Value -> Parser ActiveComponentExtensionEntry')
-> (Object -> Parser ActiveComponentExtensionEntry')
-> Value
-> Parser ActiveComponentExtensionEntry'
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Bool
activeComponentActive' <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active"
        if Bool
activeComponentActive' then do
            String
activeComponentExtensionId' <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            String
activeComponentVersion' <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
            String
activeComponentName' <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            Integer
activeComponentX <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x"
            Integer
activeComponentY <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"y"
            ActiveComponentExtensionEntry'
-> Parser ActiveComponentExtensionEntry'
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveComponentExtensionEntry'{Bool
Integer
String
activeComponentActive' :: Bool
activeComponentExtensionId' :: String
activeComponentVersion' :: String
activeComponentName' :: String
activeComponentX :: Integer
activeComponentY :: Integer
activeComponentActive' :: Bool
activeComponentExtensionId' :: String
activeComponentVersion' :: String
activeComponentName' :: String
activeComponentX :: Integer
activeComponentY :: Integer
..}
        else ActiveComponentExtensionEntry'
-> Parser ActiveComponentExtensionEntry'
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveComponentExtensionEntry'
InactiveComponentExtension

data ActiveComponentExtensionEntry = ActiveComponentExtensionEntry { ActiveComponentExtensionEntry -> Bool
activeComponentExtensionActive :: Bool
                                                                   , ActiveComponentExtensionEntry -> String
activeComponentExtensionId :: String
                                                                   , ActiveComponentExtensionEntry -> String
activeComponentExtensionVersion :: String
                                                                   , ActiveComponentExtensionEntry -> String
activeComponentExtensionName :: String
                                                                   , ActiveComponentExtensionEntry -> Integer
x :: Integer
                                                                   , ActiveComponentExtensionEntry -> Integer
y :: Integer
                                                                   } deriving ( Int -> ActiveComponentExtensionEntry -> ShowS
[ActiveComponentExtensionEntry] -> ShowS
ActiveComponentExtensionEntry -> String
(Int -> ActiveComponentExtensionEntry -> ShowS)
-> (ActiveComponentExtensionEntry -> String)
-> ([ActiveComponentExtensionEntry] -> ShowS)
-> Show ActiveComponentExtensionEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActiveComponentExtensionEntry -> ShowS
showsPrec :: Int -> ActiveComponentExtensionEntry -> ShowS
$cshow :: ActiveComponentExtensionEntry -> String
show :: ActiveComponentExtensionEntry -> String
$cshowList :: [ActiveComponentExtensionEntry] -> ShowS
showList :: [ActiveComponentExtensionEntry] -> ShowS
Show, ActiveComponentExtensionEntry
-> ActiveComponentExtensionEntry -> Bool
(ActiveComponentExtensionEntry
 -> ActiveComponentExtensionEntry -> Bool)
-> (ActiveComponentExtensionEntry
    -> ActiveComponentExtensionEntry -> Bool)
-> Eq ActiveComponentExtensionEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveComponentExtensionEntry
-> ActiveComponentExtensionEntry -> Bool
== :: ActiveComponentExtensionEntry
-> ActiveComponentExtensionEntry -> Bool
$c/= :: ActiveComponentExtensionEntry
-> ActiveComponentExtensionEntry -> Bool
/= :: ActiveComponentExtensionEntry
-> ActiveComponentExtensionEntry -> Bool
Eq )

instance ExtensionId ActiveComponentExtensionEntry where
    extensionId :: ActiveComponentExtensionEntry -> String
extensionId = ActiveComponentExtensionEntry -> String
activeComponentExtensionId

instance IsActive ActiveComponentExtensionEntry where
    active :: ActiveComponentExtensionEntry -> Bool
active = ActiveComponentExtensionEntry -> Bool
activeComponentExtensionActive

instance Named ActiveComponentExtensionEntry where
    name :: ActiveComponentExtensionEntry -> String
name = ActiveComponentExtensionEntry -> String
activeComponentExtensionName

instance Versioned ActiveComponentExtensionEntry where
    version :: ActiveComponentExtensionEntry -> String
version = ActiveComponentExtensionEntry -> String
activeComponentExtensionVersion

filterActiveComponentExtensions :: [ActiveComponentExtensionEntry'] -> [ActiveComponentExtensionEntry]
filterActiveComponentExtensions :: [ActiveComponentExtensionEntry'] -> [ActiveComponentExtensionEntry]
filterActiveComponentExtensions = [ActiveComponentExtensionEntry] -> [ActiveComponentExtensionEntry]
forall a. [a] -> [a]
reverse ([ActiveComponentExtensionEntry]
 -> [ActiveComponentExtensionEntry])
-> ([ActiveComponentExtensionEntry']
    -> [ActiveComponentExtensionEntry])
-> [ActiveComponentExtensionEntry']
-> [ActiveComponentExtensionEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ActiveComponentExtensionEntry]
 -> ActiveComponentExtensionEntry'
 -> [ActiveComponentExtensionEntry])
-> [ActiveComponentExtensionEntry]
-> [ActiveComponentExtensionEntry']
-> [ActiveComponentExtensionEntry]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [ActiveComponentExtensionEntry]
-> ActiveComponentExtensionEntry'
-> [ActiveComponentExtensionEntry]
filterActiveComponentExtensions' []

filterActiveComponentExtensions' :: [ActiveComponentExtensionEntry] -> ActiveComponentExtensionEntry' -> [ActiveComponentExtensionEntry]
filterActiveComponentExtensions' :: [ActiveComponentExtensionEntry]
-> ActiveComponentExtensionEntry'
-> [ActiveComponentExtensionEntry]
filterActiveComponentExtensions' [ActiveComponentExtensionEntry]
as ActiveComponentExtensionEntry'
InactiveComponentExtension = [ActiveComponentExtensionEntry]
as
filterActiveComponentExtensions' [ActiveComponentExtensionEntry]
as (ActiveComponentExtensionEntry' Bool
_ String
i String
v String
n Integer
x Integer
y) = Bool
-> String
-> String
-> String
-> Integer
-> Integer
-> ActiveComponentExtensionEntry
ActiveComponentExtensionEntry Bool
True String
i String
v String
n Integer
x Integer
y ActiveComponentExtensionEntry
-> [ActiveComponentExtensionEntry]
-> [ActiveComponentExtensionEntry]
forall a. a -> [a] -> [a]
: [ActiveComponentExtensionEntry]
as

data ActiveExtensionEntry' = ActiveExtensionEntry' { ActiveExtensionEntry' -> Bool
activeExtensionActive' :: Bool
                                                   , ActiveExtensionEntry' -> String
activeExtensionExtensionId' :: String
                                                   , ActiveExtensionEntry' -> String
activeExtensionVersion' :: String
                                                   , ActiveExtensionEntry' -> String
activeExtensionName' :: String
                                                   }
                          | InactiveExtension deriving ( Int -> ActiveExtensionEntry' -> ShowS
[ActiveExtensionEntry'] -> ShowS
ActiveExtensionEntry' -> String
(Int -> ActiveExtensionEntry' -> ShowS)
-> (ActiveExtensionEntry' -> String)
-> ([ActiveExtensionEntry'] -> ShowS)
-> Show ActiveExtensionEntry'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActiveExtensionEntry' -> ShowS
showsPrec :: Int -> ActiveExtensionEntry' -> ShowS
$cshow :: ActiveExtensionEntry' -> String
show :: ActiveExtensionEntry' -> String
$cshowList :: [ActiveExtensionEntry'] -> ShowS
showList :: [ActiveExtensionEntry'] -> ShowS
Show, ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool
(ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool)
-> (ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool)
-> Eq ActiveExtensionEntry'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool
== :: ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool
$c/= :: ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool
/= :: ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool
Eq )

instance FromJSON ActiveExtensionEntry' where
    parseJSON :: Value -> Parser ActiveExtensionEntry'
parseJSON = String
-> (Object -> Parser ActiveExtensionEntry')
-> Value
-> Parser ActiveExtensionEntry'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActiveExtensionEntry" ((Object -> Parser ActiveExtensionEntry')
 -> Value -> Parser ActiveExtensionEntry')
-> (Object -> Parser ActiveExtensionEntry')
-> Value
-> Parser ActiveExtensionEntry'
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Bool
activeExtensionActive' <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active"
        if Bool
activeExtensionActive' then do
            String
activeExtensionExtensionId' <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            String
activeExtensionVersion' <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
            String
activeExtensionName' <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            ActiveExtensionEntry' -> Parser ActiveExtensionEntry'
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveExtensionEntry'{Bool
String
activeExtensionActive' :: Bool
activeExtensionExtensionId' :: String
activeExtensionVersion' :: String
activeExtensionName' :: String
activeExtensionActive' :: Bool
activeExtensionExtensionId' :: String
activeExtensionVersion' :: String
activeExtensionName' :: String
..}
        else ActiveExtensionEntry' -> Parser ActiveExtensionEntry'
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveExtensionEntry'
InactiveExtension

data ActiveExtensionEntry = ActiveExtensionEntry { ActiveExtensionEntry -> Bool
activeExtensionActive :: Bool
                                                 , ActiveExtensionEntry -> String
activeExtensionId :: String
                                                 , ActiveExtensionEntry -> String
activeExtensionVersion :: String
                                                 , ActiveExtensionEntry -> String
activeExtensionName :: String
                                                 } deriving ( Int -> ActiveExtensionEntry -> ShowS
[ActiveExtensionEntry] -> ShowS
ActiveExtensionEntry -> String
(Int -> ActiveExtensionEntry -> ShowS)
-> (ActiveExtensionEntry -> String)
-> ([ActiveExtensionEntry] -> ShowS)
-> Show ActiveExtensionEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActiveExtensionEntry -> ShowS
showsPrec :: Int -> ActiveExtensionEntry -> ShowS
$cshow :: ActiveExtensionEntry -> String
show :: ActiveExtensionEntry -> String
$cshowList :: [ActiveExtensionEntry] -> ShowS
showList :: [ActiveExtensionEntry] -> ShowS
Show, ActiveExtensionEntry -> ActiveExtensionEntry -> Bool
(ActiveExtensionEntry -> ActiveExtensionEntry -> Bool)
-> (ActiveExtensionEntry -> ActiveExtensionEntry -> Bool)
-> Eq ActiveExtensionEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveExtensionEntry -> ActiveExtensionEntry -> Bool
== :: ActiveExtensionEntry -> ActiveExtensionEntry -> Bool
$c/= :: ActiveExtensionEntry -> ActiveExtensionEntry -> Bool
/= :: ActiveExtensionEntry -> ActiveExtensionEntry -> Bool
Eq )

instance IsActive ActiveExtensionEntry where
    active :: ActiveExtensionEntry -> Bool
active = ActiveExtensionEntry -> Bool
activeExtensionActive

instance ExtensionId ActiveExtensionEntry where
    extensionId :: ActiveExtensionEntry -> String
extensionId = ActiveExtensionEntry -> String
activeExtensionId

instance Versioned ActiveExtensionEntry where
    version :: ActiveExtensionEntry -> String
version = ActiveExtensionEntry -> String
activeExtensionVersion

instance Named ActiveExtensionEntry where
    name :: ActiveExtensionEntry -> String
name = ActiveExtensionEntry -> String
activeExtensionName

filterActiveExtensions :: [ActiveExtensionEntry'] -> [ActiveExtensionEntry]
filterActiveExtensions :: [ActiveExtensionEntry'] -> [ActiveExtensionEntry]
filterActiveExtensions = [ActiveExtensionEntry] -> [ActiveExtensionEntry]
forall a. [a] -> [a]
reverse ([ActiveExtensionEntry] -> [ActiveExtensionEntry])
-> ([ActiveExtensionEntry'] -> [ActiveExtensionEntry])
-> [ActiveExtensionEntry']
-> [ActiveExtensionEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ActiveExtensionEntry]
 -> ActiveExtensionEntry' -> [ActiveExtensionEntry])
-> [ActiveExtensionEntry]
-> [ActiveExtensionEntry']
-> [ActiveExtensionEntry]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [ActiveExtensionEntry]
-> ActiveExtensionEntry' -> [ActiveExtensionEntry]
filterActiveExtensions' []

filterActiveExtensions' :: [ActiveExtensionEntry] -> ActiveExtensionEntry' -> [ActiveExtensionEntry]
filterActiveExtensions' :: [ActiveExtensionEntry]
-> ActiveExtensionEntry' -> [ActiveExtensionEntry]
filterActiveExtensions' [ActiveExtensionEntry]
as ActiveExtensionEntry'
InactiveExtension = [ActiveExtensionEntry]
as
filterActiveExtensions' [ActiveExtensionEntry]
as (ActiveExtensionEntry' Bool
_ String
i String
v String
n) = Bool -> String -> String -> String -> ActiveExtensionEntry
ActiveExtensionEntry Bool
True String
i String
v String
n ActiveExtensionEntry
-> [ActiveExtensionEntry] -> [ActiveExtensionEntry]
forall a. a -> [a] -> [a]
: [ActiveExtensionEntry]
as

data ActiveExtensionsResponse = ActiveExtensionsResponse { ActiveExtensionsResponse -> [ActiveComponentExtensionEntry]
components :: [ActiveComponentExtensionEntry]
                                                         , ActiveExtensionsResponse -> [ActiveExtensionEntry]
overlays :: [ActiveExtensionEntry]
                                                         , ActiveExtensionsResponse -> [ActiveExtensionEntry]
panels :: [ActiveExtensionEntry]
                                                         } deriving ( Int -> ActiveExtensionsResponse -> ShowS
[ActiveExtensionsResponse] -> ShowS
ActiveExtensionsResponse -> String
(Int -> ActiveExtensionsResponse -> ShowS)
-> (ActiveExtensionsResponse -> String)
-> ([ActiveExtensionsResponse] -> ShowS)
-> Show ActiveExtensionsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActiveExtensionsResponse -> ShowS
showsPrec :: Int -> ActiveExtensionsResponse -> ShowS
$cshow :: ActiveExtensionsResponse -> String
show :: ActiveExtensionsResponse -> String
$cshowList :: [ActiveExtensionsResponse] -> ShowS
showList :: [ActiveExtensionsResponse] -> ShowS
Show, ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool
(ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool)
-> (ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool)
-> Eq ActiveExtensionsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool
== :: ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool
$c/= :: ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool
/= :: ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool
Eq )

instance FromJSON ActiveExtensionsResponse where
    parseJSON :: Value -> Parser ActiveExtensionsResponse
parseJSON = String
-> (Object -> Parser ActiveExtensionsResponse)
-> Value
-> Parser ActiveExtensionsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActiveExtensionsResponse" ((Object -> Parser ActiveExtensionsResponse)
 -> Value -> Parser ActiveExtensionsResponse)
-> (Object -> Parser ActiveExtensionsResponse)
-> Value
-> Parser ActiveExtensionsResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [ActiveComponentExtensionEntry]
components <- (((Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data") Parser Object
-> (Object -> Parser (KeyMap ActiveComponentExtensionEntry'))
-> Parser (KeyMap ActiveComponentExtensionEntry')
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser (KeyMap ActiveComponentExtensionEntry')
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"component")) Parser (KeyMap ActiveComponentExtensionEntry')
-> (KeyMap ActiveComponentExtensionEntry'
    -> [ActiveComponentExtensionEntry'])
-> Parser [ActiveComponentExtensionEntry']
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (((Key, ActiveComponentExtensionEntry')
-> ActiveComponentExtensionEntry'
forall a b. (a, b) -> b
snd ((Key, ActiveComponentExtensionEntry')
 -> ActiveComponentExtensionEntry')
-> [(Key, ActiveComponentExtensionEntry')]
-> [ActiveComponentExtensionEntry']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Key, ActiveComponentExtensionEntry')]
 -> [ActiveComponentExtensionEntry'])
-> (KeyMap ActiveComponentExtensionEntry'
    -> [(Key, ActiveComponentExtensionEntry')])
-> KeyMap ActiveComponentExtensionEntry'
-> [ActiveComponentExtensionEntry']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap ActiveComponentExtensionEntry'
-> [(Key, ActiveComponentExtensionEntry')]
forall v. KeyMap v -> [(Key, v)]
toAscList)) Parser [ActiveComponentExtensionEntry']
-> ([ActiveComponentExtensionEntry']
    -> [ActiveComponentExtensionEntry])
-> Parser [ActiveComponentExtensionEntry]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [ActiveComponentExtensionEntry'] -> [ActiveComponentExtensionEntry]
filterActiveComponentExtensions
        [ActiveExtensionEntry]
overlays <- (((Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data") Parser Object
-> (Object -> Parser (KeyMap ActiveExtensionEntry'))
-> Parser (KeyMap ActiveExtensionEntry')
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser (KeyMap ActiveExtensionEntry')
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"overlay")) Parser (KeyMap ActiveExtensionEntry')
-> (KeyMap ActiveExtensionEntry' -> [ActiveExtensionEntry'])
-> Parser [ActiveExtensionEntry']
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (((Key, ActiveExtensionEntry') -> ActiveExtensionEntry'
forall a b. (a, b) -> b
snd ((Key, ActiveExtensionEntry') -> ActiveExtensionEntry')
-> [(Key, ActiveExtensionEntry')] -> [ActiveExtensionEntry']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Key, ActiveExtensionEntry')] -> [ActiveExtensionEntry'])
-> (KeyMap ActiveExtensionEntry' -> [(Key, ActiveExtensionEntry')])
-> KeyMap ActiveExtensionEntry'
-> [ActiveExtensionEntry']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap ActiveExtensionEntry' -> [(Key, ActiveExtensionEntry')]
forall v. KeyMap v -> [(Key, v)]
toAscList)) Parser [ActiveExtensionEntry']
-> ([ActiveExtensionEntry'] -> [ActiveExtensionEntry])
-> Parser [ActiveExtensionEntry]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [ActiveExtensionEntry'] -> [ActiveExtensionEntry]
filterActiveExtensions
        [ActiveExtensionEntry]
panels <- (((Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data") Parser Object
-> (Object -> Parser (KeyMap ActiveExtensionEntry'))
-> Parser (KeyMap ActiveExtensionEntry')
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser (KeyMap ActiveExtensionEntry')
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"panel")) Parser (KeyMap ActiveExtensionEntry')
-> (KeyMap ActiveExtensionEntry' -> [ActiveExtensionEntry'])
-> Parser [ActiveExtensionEntry']
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (((Key, ActiveExtensionEntry') -> ActiveExtensionEntry'
forall a b. (a, b) -> b
snd ((Key, ActiveExtensionEntry') -> ActiveExtensionEntry')
-> [(Key, ActiveExtensionEntry')] -> [ActiveExtensionEntry']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Key, ActiveExtensionEntry')] -> [ActiveExtensionEntry'])
-> (KeyMap ActiveExtensionEntry' -> [(Key, ActiveExtensionEntry')])
-> KeyMap ActiveExtensionEntry'
-> [ActiveExtensionEntry']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap ActiveExtensionEntry' -> [(Key, ActiveExtensionEntry')]
forall v. KeyMap v -> [(Key, v)]
toAscList)) Parser [ActiveExtensionEntry']
-> ([ActiveExtensionEntry'] -> [ActiveExtensionEntry])
-> Parser [ActiveExtensionEntry]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [ActiveExtensionEntry'] -> [ActiveExtensionEntry]
filterActiveExtensions
        ActiveExtensionsResponse -> Parser ActiveExtensionsResponse
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveExtensionsResponse{[ActiveExtensionEntry]
[ActiveComponentExtensionEntry]
components :: [ActiveComponentExtensionEntry]
overlays :: [ActiveExtensionEntry]
panels :: [ActiveExtensionEntry]
components :: [ActiveComponentExtensionEntry]
overlays :: [ActiveExtensionEntry]
panels :: [ActiveExtensionEntry]
..}