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

----------------------------------------------------------------------

----------------------------------------------------------------------

-- |
-- Module: Web.Slack.User
-- Description:
module Web.Slack.User
  ( Profile (..),
    User (..),
    ListRsp (..),
    Email (..),
    UserRsp (..),
  )
where

-- FIXME: Web.Slack.Prelude

-- aeson
import Data.Aeson.TH
-- base

-- slack-web

-- text
import Data.Text (Text)
-- time
import Data.Time.Clock.POSIX
import GHC.Generics (Generic)
-- http-api-data

import Web.FormUrlEncoded
import Web.HttpApiData
import Web.Slack.Common
import Web.Slack.Util
import Prelude

-- 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 stock (Profile -> Profile -> Bool
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. 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
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 stock (User -> User -> Bool
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. 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
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 stock (ListRsp -> ListRsp -> Bool
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. 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
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 stock (UserRsp -> UserRsp -> Bool
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. 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
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 stock (Email -> Email -> Bool
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. 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
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", forall a. ToHttpApiData a => a -> Text
toQueryParam Text
txt)]