{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show )

instance Req.HelixRequest User where
    toRequest :: User -> Request
toRequest User
user =
        let [(ByteString, Maybe ByteString)]
lookupId' :: [(BS.ByteString, Maybe BS.ByteString)] = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
i -> [(ByteString
"id", forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ String
i)]) (User -> Maybe String
lookupId User
user)
            [(ByteString, Maybe ByteString)]
username' :: [(BS.ByteString, Maybe BS.ByteString)] = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
u -> [(ByteString
"login", forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack 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 forall a b. (a -> b) -> a -> b
$ [(ByteString, Maybe ByteString)]
lookupId' forall a. [a] -> [a] -> [a]
++ [(ByteString, Maybe ByteString)]
username'
        in Request -> Request
setQuery 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{} = forall a. a -> Maybe a
Just String
"user:read:email"

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

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

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

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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Users] -> ShowS
$cshowList :: [Users] -> ShowS
show :: Users -> String
$cshow :: Users -> String
showsPrec :: Int -> Users -> ShowS
$cshowsPrec :: Int -> Users -> ShowS
Show, Users -> Users -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Users -> Users -> Bool
$c/= :: Users -> Users -> Bool
== :: Users -> Users -> Bool
$c== :: 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", forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Integer
i)) 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", forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ String
u)) 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 forall a b. (a -> b) -> a -> b
$ [(ByteString, Maybe ByteString)]
lookupId' forall a. [a] -> [a] -> [a]
++ [(ByteString, Maybe ByteString)]
username'
        in Request -> Request
setQuery 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{} = forall a. Maybe a
Nothing

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

instance FromJSON UsersResponse where
    parseJSON :: Value -> Parser UsersResponse
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UsersResponse" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [UserEntry]
users <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
        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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Follows] -> ShowS
$cshowList :: [Follows] -> ShowS
show :: Follows -> String
$cshow :: Follows -> String
showsPrec :: Int -> Follows -> ShowS
$cshowsPrec :: Int -> Follows -> ShowS
Show, Follows -> Follows -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Follows -> Follows -> Bool
$c/= :: Follows -> Follows -> Bool
== :: Follows -> Follows -> Bool
$c== :: 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)] = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
a -> [(ByteString
"after", forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ String
a)]) (Follows -> Maybe String
after Follows
user)
            [(ByteString, Maybe ByteString)]
max' :: [(BS.ByteString, Maybe BS.ByteString)] = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
u -> [(ByteString
"first", forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Integer
u)]) (Follows -> Maybe Integer
from Follows
user)
            [(ByteString, Maybe ByteString)]
fromId' :: [(BS.ByteString, Maybe BS.ByteString)] = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
u -> [(ByteString
"after", forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Integer
u)]) (Follows -> Maybe Integer
from Follows
user)
            [(ByteString, Maybe ByteString)]
toId' :: [(BS.ByteString, Maybe BS.ByteString)] = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
u -> [(ByteString
"after", forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show 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 forall a b. (a -> b) -> a -> b
$ 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 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{} = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FollowEntry] -> ShowS
$cshowList :: [FollowEntry] -> ShowS
show :: FollowEntry -> String
$cshow :: FollowEntry -> String
showsPrec :: Int -> FollowEntry -> ShowS
$cshowsPrec :: Int -> FollowEntry -> ShowS
Show, FollowEntry -> FollowEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FollowEntry -> FollowEntry -> Bool
$c/= :: FollowEntry -> FollowEntry -> Bool
== :: FollowEntry -> FollowEntry -> Bool
$c== :: FollowEntry -> FollowEntry -> Bool
Eq )

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

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

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

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

instance Req.HelixRequest BlockList where
    toRequest :: BlockList -> Request
toRequest BlockList
user =
        [(ByteString, Maybe ByteString)] -> Request -> Request
HTTP.setQueryString [(ByteString
"login", forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockList -> Integer
broadcasterId forall a b. (a -> b) -> a -> b
$ BlockList
user)] 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{} = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockListEntry] -> ShowS
$cshowList :: [BlockListEntry] -> ShowS
show :: BlockListEntry -> String
$cshow :: BlockListEntry -> String
showsPrec :: Int -> BlockListEntry -> ShowS
$cshowsPrec :: Int -> BlockListEntry -> ShowS
Show, BlockListEntry -> BlockListEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockListEntry -> BlockListEntry -> Bool
$c/= :: BlockListEntry -> BlockListEntry -> Bool
== :: BlockListEntry -> BlockListEntry -> Bool
$c== :: BlockListEntry -> BlockListEntry -> Bool
Eq )

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

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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockListResponse] -> ShowS
$cshowList :: [BlockListResponse] -> ShowS
show :: BlockListResponse -> String
$cshow :: BlockListResponse -> String
showsPrec :: Int -> BlockListResponse -> ShowS
$cshowsPrec :: Int -> BlockListResponse -> ShowS
Show, BlockListResponse -> BlockListResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockListResponse -> BlockListResponse -> Bool
$c/= :: BlockListResponse -> BlockListResponse -> Bool
== :: BlockListResponse -> BlockListResponse -> Bool
$c== :: BlockListResponse -> BlockListResponse -> Bool
Eq )

instance FromJSON BlockListResponse where
    parseJSON :: Value -> Parser BlockListResponse
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BlockListResponse" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [BlockListEntry]
blocks <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
        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 = forall a. a -> Maybe a
Just String
"user:read:broadcast"

data ExtensionType = Component | Mobile | Panel | Overlay deriving ( Int -> ExtensionType -> ShowS
[ExtensionType] -> ShowS
ExtensionType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtensionType] -> ShowS
$cshowList :: [ExtensionType] -> ShowS
show :: ExtensionType -> String
$cshow :: ExtensionType -> String
showsPrec :: Int -> ExtensionType -> ShowS
$cshowsPrec :: Int -> ExtensionType -> ShowS
Show, ExtensionType -> ExtensionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtensionType -> ExtensionType -> Bool
$c/= :: ExtensionType -> ExtensionType -> Bool
== :: ExtensionType -> ExtensionType -> Bool
$c== :: 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
_           = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtensionsEntry] -> ShowS
$cshowList :: [ExtensionsEntry] -> ShowS
show :: ExtensionsEntry -> String
$cshow :: ExtensionsEntry -> String
showsPrec :: Int -> ExtensionsEntry -> ShowS
$cshowsPrec :: Int -> ExtensionsEntry -> ShowS
Show, ExtensionsEntry -> ExtensionsEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtensionsEntry -> ExtensionsEntry -> Bool
$c/= :: ExtensionsEntry -> ExtensionsEntry -> Bool
== :: ExtensionsEntry -> ExtensionsEntry -> Bool
$c== :: 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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExtensionsEntry" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [String]
extensionTypes' :: [String] <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        let [ExtensionType]
extensionTypes :: [ExtensionType] = forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
extensionTypes'
        Bool
canActivate <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"can_activate"
        String
extensionEntryId <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        String
extensionName <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
        String
extensionVersion <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
        forall (m :: * -> *) a. Monad m => a -> m a
return ExtensionsEntry{Bool
String
[ExtensionType]
extensionVersion :: String
extensionName :: String
extensionEntryId :: String
canActivate :: Bool
extensionTypes :: [ExtensionType]
extensionVersion :: String
extensionTypes :: [ExtensionType]
extensionName :: String
extensionEntryId :: String
canActivate :: Bool
..}

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

instance FromJSON ExtensionsResponse where
    parseJSON :: Value -> Parser ExtensionsResponse
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExtensionsResponse" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [ExtensionsEntry]
extensions <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
        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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveExtensions] -> ShowS
$cshowList :: [ActiveExtensions] -> ShowS
show :: ActiveExtensions -> String
$cshow :: ActiveExtensions -> String
showsPrec :: Int -> ActiveExtensions -> ShowS
$cshowsPrec :: Int -> ActiveExtensions -> ShowS
Show, ActiveExtensions -> ActiveExtensions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveExtensions -> ActiveExtensions -> Bool
$c/= :: ActiveExtensions -> ActiveExtensions -> Bool
== :: ActiveExtensions -> ActiveExtensions -> Bool
$c== :: 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", forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Integer
i)]
        in Request -> Request
setQuery 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 = forall a. Maybe a
Nothing
    scope (ActiveExtensionsFor Integer
_) = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveComponentExtensionEntry'] -> ShowS
$cshowList :: [ActiveComponentExtensionEntry'] -> ShowS
show :: ActiveComponentExtensionEntry' -> String
$cshow :: ActiveComponentExtensionEntry' -> String
showsPrec :: Int -> ActiveComponentExtensionEntry' -> ShowS
$cshowsPrec :: Int -> ActiveComponentExtensionEntry' -> ShowS
Show, ActiveComponentExtensionEntry'
-> ActiveComponentExtensionEntry' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveComponentExtensionEntry'
-> ActiveComponentExtensionEntry' -> Bool
$c/= :: ActiveComponentExtensionEntry'
-> ActiveComponentExtensionEntry' -> Bool
== :: ActiveComponentExtensionEntry'
-> ActiveComponentExtensionEntry' -> Bool
$c== :: ActiveComponentExtensionEntry'
-> ActiveComponentExtensionEntry' -> Bool
Eq )

instance FromJSON ActiveComponentExtensionEntry' where
    parseJSON :: Value -> Parser ActiveComponentExtensionEntry'
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActiveExtensionEntry" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Bool
activeComponentActive' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active"
        if Bool
activeComponentActive' then do
            String
activeComponentExtensionId' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            String
activeComponentVersion' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
            String
activeComponentName' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            Integer
activeComponentX <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x"
            Integer
activeComponentY <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"y"
            forall (m :: * -> *) a. Monad m => a -> m a
return ActiveComponentExtensionEntry'{Bool
Integer
String
activeComponentY :: Integer
activeComponentX :: Integer
activeComponentName' :: String
activeComponentVersion' :: String
activeComponentExtensionId' :: String
activeComponentActive' :: Bool
activeComponentY :: Integer
activeComponentX :: Integer
activeComponentName' :: String
activeComponentVersion' :: String
activeComponentExtensionId' :: String
activeComponentActive' :: Bool
..}
        else 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveComponentExtensionEntry] -> ShowS
$cshowList :: [ActiveComponentExtensionEntry] -> ShowS
show :: ActiveComponentExtensionEntry -> String
$cshow :: ActiveComponentExtensionEntry -> String
showsPrec :: Int -> ActiveComponentExtensionEntry -> ShowS
$cshowsPrec :: Int -> ActiveComponentExtensionEntry -> ShowS
Show, ActiveComponentExtensionEntry
-> ActiveComponentExtensionEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveComponentExtensionEntry
-> ActiveComponentExtensionEntry -> Bool
$c/= :: ActiveComponentExtensionEntry
-> ActiveComponentExtensionEntry -> Bool
== :: ActiveComponentExtensionEntry
-> ActiveComponentExtensionEntry -> Bool
$c== :: 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 = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveExtensionEntry'] -> ShowS
$cshowList :: [ActiveExtensionEntry'] -> ShowS
show :: ActiveExtensionEntry' -> String
$cshow :: ActiveExtensionEntry' -> String
showsPrec :: Int -> ActiveExtensionEntry' -> ShowS
$cshowsPrec :: Int -> ActiveExtensionEntry' -> ShowS
Show, ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool
$c/= :: ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool
== :: ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool
$c== :: ActiveExtensionEntry' -> ActiveExtensionEntry' -> Bool
Eq )

instance FromJSON ActiveExtensionEntry' where
    parseJSON :: Value -> Parser ActiveExtensionEntry'
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActiveExtensionEntry" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Bool
activeExtensionActive' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active"
        if Bool
activeExtensionActive' then do
            String
activeExtensionExtensionId' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            String
activeExtensionVersion' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
            String
activeExtensionName' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            forall (m :: * -> *) a. Monad m => a -> m a
return ActiveExtensionEntry'{Bool
String
activeExtensionName' :: String
activeExtensionVersion' :: String
activeExtensionExtensionId' :: String
activeExtensionActive' :: Bool
activeExtensionName' :: String
activeExtensionVersion' :: String
activeExtensionExtensionId' :: String
activeExtensionActive' :: Bool
..}
        else 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveExtensionEntry] -> ShowS
$cshowList :: [ActiveExtensionEntry] -> ShowS
show :: ActiveExtensionEntry -> String
$cshow :: ActiveExtensionEntry -> String
showsPrec :: Int -> ActiveExtensionEntry -> ShowS
$cshowsPrec :: Int -> ActiveExtensionEntry -> ShowS
Show, ActiveExtensionEntry -> ActiveExtensionEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveExtensionEntry -> ActiveExtensionEntry -> Bool
$c/= :: ActiveExtensionEntry -> ActiveExtensionEntry -> Bool
== :: ActiveExtensionEntry -> ActiveExtensionEntry -> Bool
$c== :: 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 = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveExtensionsResponse] -> ShowS
$cshowList :: [ActiveExtensionsResponse] -> ShowS
show :: ActiveExtensionsResponse -> String
$cshow :: ActiveExtensionsResponse -> String
showsPrec :: Int -> ActiveExtensionsResponse -> ShowS
$cshowsPrec :: Int -> ActiveExtensionsResponse -> ShowS
Show, ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool
$c/= :: ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool
== :: ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool
$c== :: ActiveExtensionsResponse -> ActiveExtensionsResponse -> Bool
Eq )

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