{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedLists #-}

----------------------------------------------------------------------
-- |
-- Module: Web.Slack.User
-- Description:
--
--
--
----------------------------------------------------------------------

module Web.Slack.User
  ( Profile(..)
  , User(..)
  , ListRsp(..)
  , Email(..)
  , UserRsp(..)
  )
  where

-- aeson
import Data.Aeson.TH

-- base
import GHC.Generics (Generic)

-- slack-web
import Web.Slack.Common
import Web.Slack.Util

-- text
import Data.Text (Text)

-- time
import Data.Time.Clock.POSIX

-- http-api-data
import Web.HttpApiData
import Web.FormUrlEncoded

-- See https://api.slack.com/types/user

data Profile = 
  Profile 
    { Profile -> Maybe Text
profileAvatarHash :: Maybe Text
    , Profile -> Maybe Text
profileStatusText :: Maybe Text
    , Profile -> Maybe Text
profileStatusEmoji :: Maybe Text 
    , Profile -> Maybe Text
profileRealName :: Maybe Text 
    , Profile -> Maybe Text
profileDisplayName :: Maybe Text 
    , Profile -> Maybe Text
profileRealNameNormalized :: Maybe Text 
    , Profile -> Maybe Text
profileDisplayNameNormalized :: Maybe Text 
    , Profile -> Maybe Text
profileEmail :: Maybe Text 
    , Profile -> Text
profileImage_24 :: Text 
    , Profile -> Text
profileImage_32 :: Text 
    , Profile -> Text
profileImage_48 :: Text 
    , Profile -> Text
profileImage_72 :: Text 
    , Profile -> Text
profileImage_192 :: Text 
    , Profile -> Text
profileImage_512 :: Text 
    , Profile -> Maybe Text
profileTeam :: Maybe Text 
    }
  deriving (Profile -> Profile -> Bool
(Profile -> Profile -> Bool)
-> (Profile -> Profile -> Bool) -> Eq Profile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Profile -> Profile -> Bool
$c/= :: Profile -> Profile -> Bool
== :: Profile -> Profile -> Bool
$c== :: Profile -> Profile -> Bool
Eq, (forall x. Profile -> Rep Profile x)
-> (forall x. Rep Profile x -> Profile) -> Generic Profile
forall x. Rep Profile x -> Profile
forall x. Profile -> Rep Profile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Profile x -> Profile
$cfrom :: forall x. Profile -> Rep Profile x
Generic, Int -> Profile -> ShowS
[Profile] -> ShowS
Profile -> String
(Int -> Profile -> ShowS)
-> (Profile -> String) -> ([Profile] -> ShowS) -> Show Profile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Profile] -> ShowS
$cshowList :: [Profile] -> ShowS
show :: Profile -> String
$cshow :: Profile -> String
showsPrec :: Int -> Profile -> ShowS
$cshowsPrec :: Int -> Profile -> ShowS
Show)

$(deriveFromJSON (jsonOpts "profile") ''Profile)

data User =
  User
    { User -> UserId
userId :: UserId
    , User -> Text
userName :: Text
    , User -> Bool
userDeleted :: Bool
    , User -> Maybe Color
userColor :: Maybe Color
    , User -> Maybe Profile
userProfile :: Maybe Profile
    , User -> Maybe Bool
userIsAdmin :: Maybe Bool
    , User -> Maybe Bool
userIsOwner :: Maybe Bool
    , User -> Maybe Bool
userIsPrimaryOwner :: Maybe Bool
    , User -> Maybe Bool
userIsRestricted :: Maybe Bool
    , User -> Maybe Bool
userIsUltraRestricted :: Maybe Bool
    , User -> POSIXTime
userUpdated :: POSIXTime
    }
  deriving (User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: User -> User -> Bool
Eq, (forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep User x -> User
$cfrom :: forall x. User -> Rep User x
Generic, 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
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show)

$(deriveFromJSON (jsonOpts "user") ''User)

data ListRsp =
  ListRsp
    { ListRsp -> [User]
listRspMembers :: [User]
    }
  deriving (ListRsp -> ListRsp -> Bool
(ListRsp -> ListRsp -> Bool)
-> (ListRsp -> ListRsp -> Bool) -> Eq ListRsp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListRsp -> ListRsp -> Bool
$c/= :: ListRsp -> ListRsp -> Bool
== :: ListRsp -> ListRsp -> Bool
$c== :: ListRsp -> ListRsp -> Bool
Eq, (forall x. ListRsp -> Rep ListRsp x)
-> (forall x. Rep ListRsp x -> ListRsp) -> Generic ListRsp
forall x. Rep ListRsp x -> ListRsp
forall x. ListRsp -> Rep ListRsp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListRsp x -> ListRsp
$cfrom :: forall x. ListRsp -> Rep ListRsp x
Generic, Int -> ListRsp -> ShowS
[ListRsp] -> ShowS
ListRsp -> String
(Int -> ListRsp -> ShowS)
-> (ListRsp -> String) -> ([ListRsp] -> ShowS) -> Show ListRsp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListRsp] -> ShowS
$cshowList :: [ListRsp] -> ShowS
show :: ListRsp -> String
$cshow :: ListRsp -> String
showsPrec :: Int -> ListRsp -> ShowS
$cshowsPrec :: Int -> ListRsp -> ShowS
Show)

$(deriveFromJSON (jsonOpts "listRsp") ''ListRsp)


data UserRsp =
  UserRsp
    { UserRsp -> User
userRspUser :: User
    }
  deriving (UserRsp -> UserRsp -> Bool
(UserRsp -> UserRsp -> Bool)
-> (UserRsp -> UserRsp -> Bool) -> Eq UserRsp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserRsp -> UserRsp -> Bool
$c/= :: UserRsp -> UserRsp -> Bool
== :: UserRsp -> UserRsp -> Bool
$c== :: UserRsp -> UserRsp -> Bool
Eq, (forall x. UserRsp -> Rep UserRsp x)
-> (forall x. Rep UserRsp x -> UserRsp) -> Generic UserRsp
forall x. Rep UserRsp x -> UserRsp
forall x. UserRsp -> Rep UserRsp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserRsp x -> UserRsp
$cfrom :: forall x. UserRsp -> Rep UserRsp x
Generic, Int -> UserRsp -> ShowS
[UserRsp] -> ShowS
UserRsp -> String
(Int -> UserRsp -> ShowS)
-> (UserRsp -> String) -> ([UserRsp] -> ShowS) -> Show UserRsp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserRsp] -> ShowS
$cshowList :: [UserRsp] -> ShowS
show :: UserRsp -> String
$cshow :: UserRsp -> String
showsPrec :: Int -> UserRsp -> ShowS
$cshowsPrec :: Int -> UserRsp -> ShowS
Show)

$(deriveFromJSON (jsonOpts "UserRsp") ''UserRsp)

newtype Email = Email Text deriving (Email -> Email -> Bool
(Email -> Email -> Bool) -> (Email -> Email -> Bool) -> Eq Email
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Email -> Email -> Bool
$c/= :: Email -> Email -> Bool
== :: Email -> Email -> Bool
$c== :: Email -> Email -> Bool
Eq, (forall x. Email -> Rep Email x)
-> (forall x. Rep Email x -> Email) -> Generic Email
forall x. Rep Email x -> Email
forall x. Email -> Rep Email x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Email x -> Email
$cfrom :: forall x. Email -> Rep Email x
Generic, Int -> Email -> ShowS
[Email] -> ShowS
Email -> String
(Int -> Email -> ShowS)
-> (Email -> String) -> ([Email] -> ShowS) -> Show Email
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Email] -> ShowS
$cshowList :: [Email] -> ShowS
show :: Email -> String
$cshow :: Email -> String
showsPrec :: Int -> Email -> ShowS
$cshowsPrec :: Int -> Email -> ShowS
Show)
instance ToForm Email where 
  toForm :: Email -> Form
toForm (Email Text
txt) = [(Text
"email", Text -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Text
txt)]