{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}

----------------------------------------------------------------------
-- |
-- Module: Web.Slack.Classy
-- Description: For compatibility with Web.Slack prior to v0.4.0.0.
--
--
--
----------------------------------------------------------------------

module Web.Slack.Classy
  ( SlackConfig(..)
  , mkSlackConfig
  , apiTest
  , authTest
  , chatPostMessage
  , conversationsList
  , conversationsHistory
  , conversationsHistoryAll
  , conversationsReplies
  , repliesFetchAll
  , getUserDesc
  , usersList
  , userLookupByEmail
  , authenticateReq
  , Response
  , LoadPage
  , HasManager(..)
  , HasToken(..)
  )
  where

-- base
import Control.Arrow ((&&&))
import Data.Maybe

-- containers
import qualified Data.Map as Map

-- http-client
import Network.HTTP.Client (Manager)

-- mtl
import Control.Monad.Reader

-- slack-web
import qualified Web.Slack.Api as Api
import qualified Web.Slack.Auth as Auth
import qualified Web.Slack.Conversation as Conversation
import qualified Web.Slack.Chat as Chat
import qualified Web.Slack.Common as Common
import qualified Web.Slack.User as User
import           Web.Slack.Pager
import qualified Web.Slack as NonClassy
import           Web.Slack (SlackConfig (..), authenticateReq, mkSlackConfig)

-- text
import Data.Text (Text)

#if !MIN_VERSION_servant(0,13,0)
mkClientEnv :: Manager -> BaseUrl -> ClientEnv
mkClientEnv = ClientEnv
#endif

-- | Implemented by 'SlackConfig'
class HasManager a where
    getManager :: a -> Manager

-- | Implemented by 'SlackConfig'
class HasToken a where
    getToken :: a -> Text

instance HasManager SlackConfig where
    getManager :: SlackConfig -> Manager
getManager = SlackConfig -> Manager
slackConfigManager
instance HasToken SlackConfig where
    getToken :: SlackConfig -> Text
getToken = SlackConfig -> Text
slackConfigToken


-- |
--
-- Check API calling code.
--
-- <https://api.slack.com/methods/api.test>

apiTest
  :: (MonadReader env m, HasManager env, MonadIO m)
  => Api.TestReq
  -> m (Response Api.TestRsp)
apiTest :: TestReq -> m (Response TestRsp)
apiTest = (env -> IO (Response TestRsp)) -> m (Response TestRsp)
forall env (m :: * -> *) a.
(MonadReader env m, MonadIO m) =>
(env -> IO a) -> m a
liftToReader ((env -> IO (Response TestRsp)) -> m (Response TestRsp))
-> (TestReq -> env -> IO (Response TestRsp))
-> TestReq
-> m (Response TestRsp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (env -> TestReq -> IO (Response TestRsp))
-> TestReq -> env -> IO (Response TestRsp)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Manager -> TestReq -> IO (Response TestRsp)
NonClassy.apiTest (Manager -> TestReq -> IO (Response TestRsp))
-> (env -> Manager) -> env -> TestReq -> IO (Response TestRsp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> Manager
forall a. HasManager a => a -> Manager
getManager)


-- |
--
-- Check authentication and identity.
--
-- <https://api.slack.com/methods/auth.test>

authTest
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => m (Response Auth.TestRsp)
authTest :: m (Response TestRsp)
authTest = (SlackConfig -> IO (Response TestRsp)) -> m (Response TestRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
(SlackConfig -> IO a) -> m a
liftNonClassy SlackConfig -> IO (Response TestRsp)
NonClassy.authTest


-- |
--
-- Retrieve conversations list.
--
-- <https://api.slack.com/methods/conversations.list>

conversationsList
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => Conversation.ListReq
  -> m (Response Conversation.ListRsp)
conversationsList :: ListReq -> m (Response ListRsp)
conversationsList = (SlackConfig -> IO (Response ListRsp)) -> m (Response ListRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
(SlackConfig -> IO a) -> m a
liftNonClassy ((SlackConfig -> IO (Response ListRsp)) -> m (Response ListRsp))
-> (ListReq -> SlackConfig -> IO (Response ListRsp))
-> ListReq
-> m (Response ListRsp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlackConfig -> ListReq -> IO (Response ListRsp))
-> ListReq -> SlackConfig -> IO (Response ListRsp)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SlackConfig -> ListReq -> IO (Response ListRsp)
NonClassy.conversationsList


-- |
--
-- Retrieve ceonversation history.
-- Consider using 'historyFetchAll' in combination with this function.
--
-- <https://api.slack.com/methods/conversations.history>

conversationsHistory
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => Conversation.HistoryReq
  -> m (Response Conversation.HistoryRsp)
conversationsHistory :: HistoryReq -> m (Response HistoryRsp)
conversationsHistory = (SlackConfig -> IO (Response HistoryRsp))
-> m (Response HistoryRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
(SlackConfig -> IO a) -> m a
liftNonClassy ((SlackConfig -> IO (Response HistoryRsp))
 -> m (Response HistoryRsp))
-> (HistoryReq -> SlackConfig -> IO (Response HistoryRsp))
-> HistoryReq
-> m (Response HistoryRsp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlackConfig -> HistoryReq -> IO (Response HistoryRsp))
-> HistoryReq -> SlackConfig -> IO (Response HistoryRsp)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SlackConfig -> HistoryReq -> IO (Response HistoryRsp)
NonClassy.conversationsHistory


-- |
--
-- Retrieve replies of a conversation.
-- Consider using 'repliesFetchAll' if you want to get entire replies
-- of a conversation.
--
-- <https://api.slack.com/methods/conversations.replies>

conversationsReplies
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => Conversation.RepliesReq
  -> m (Response Conversation.HistoryRsp)
conversationsReplies :: RepliesReq -> m (Response HistoryRsp)
conversationsReplies = (SlackConfig -> IO (Response HistoryRsp))
-> m (Response HistoryRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
(SlackConfig -> IO a) -> m a
liftNonClassy ((SlackConfig -> IO (Response HistoryRsp))
 -> m (Response HistoryRsp))
-> (RepliesReq -> SlackConfig -> IO (Response HistoryRsp))
-> RepliesReq
-> m (Response HistoryRsp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlackConfig -> RepliesReq -> IO (Response HistoryRsp))
-> RepliesReq -> SlackConfig -> IO (Response HistoryRsp)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SlackConfig -> RepliesReq -> IO (Response HistoryRsp)
NonClassy.conversationsReplies


-- |
--
-- Send a message to a channel.
--
-- <https://api.slack.com/methods/chat.postMessage>

chatPostMessage
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => Chat.PostMsgReq
  -> m (Response Chat.PostMsgRsp)
chatPostMessage :: PostMsgReq -> m (Response PostMsgRsp)
chatPostMessage = (SlackConfig -> IO (Response PostMsgRsp))
-> m (Response PostMsgRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
(SlackConfig -> IO a) -> m a
liftNonClassy ((SlackConfig -> IO (Response PostMsgRsp))
 -> m (Response PostMsgRsp))
-> (PostMsgReq -> SlackConfig -> IO (Response PostMsgRsp))
-> PostMsgReq
-> m (Response PostMsgRsp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlackConfig -> PostMsgReq -> IO (Response PostMsgRsp))
-> PostMsgReq -> SlackConfig -> IO (Response PostMsgRsp)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SlackConfig -> PostMsgReq -> IO (Response PostMsgRsp)
NonClassy.chatPostMessage


-- |
--
-- This method returns a list of all users in the team.
-- This includes deleted/deactivated users.
--
-- <https://api.slack.com/methods/users.list>

usersList
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => m (Response User.ListRsp)
usersList :: m (Response ListRsp)
usersList = (SlackConfig -> IO (Response ListRsp)) -> m (Response ListRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
(SlackConfig -> IO a) -> m a
liftNonClassy SlackConfig -> IO (Response ListRsp)
NonClassy.usersList


-- |
--
-- This method returns a list of all users in the team.
-- This includes deleted/deactivated users.
--
-- <https://api.slack.com/methods/users.lookupByEmail>

userLookupByEmail
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => User.Email
  -> m (Response User.UserRsp)
userLookupByEmail :: Email -> m (Response UserRsp)
userLookupByEmail = (SlackConfig -> IO (Response UserRsp)) -> m (Response UserRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
(SlackConfig -> IO a) -> m a
liftNonClassy ((SlackConfig -> IO (Response UserRsp)) -> m (Response UserRsp))
-> (Email -> SlackConfig -> IO (Response UserRsp))
-> Email
-> m (Response UserRsp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlackConfig -> Email -> IO (Response UserRsp))
-> Email -> SlackConfig -> IO (Response UserRsp)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SlackConfig -> Email -> IO (Response UserRsp)
NonClassy.userLookupByEmail


-- | Returns a function to get a username from a 'Common.UserId'.
-- Comes in handy to use 'Web.Slack.MessageParser.messageToHtml'
getUserDesc
  :: (Common.UserId -> Text)
  -- ^ A function to give a default username in case the username is unknown
  -> User.ListRsp
  -- ^ List of users as known by the slack server. See 'usersList'.
  -> (Common.UserId -> Text)
  -- ^ A function from 'Common.UserId' to username.
getUserDesc :: (UserId -> Text) -> ListRsp -> UserId -> Text
getUserDesc UserId -> Text
unknownUserFn ListRsp
users =
  let userMap :: Map UserId Text
userMap = [(UserId, Text)] -> Map UserId Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(UserId, Text)] -> Map UserId Text)
-> [(UserId, Text)] -> Map UserId Text
forall a b. (a -> b) -> a -> b
$ (User -> UserId
User.userId (User -> UserId) -> (User -> Text) -> User -> (UserId, Text)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& User -> Text
User.userName) (User -> (UserId, Text)) -> [User] -> [(UserId, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRsp -> [User]
User.listRspMembers ListRsp
users
  in
    \UserId
userId -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (UserId -> Text
unknownUserFn UserId
userId) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ UserId -> Map UserId Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UserId
userId Map UserId Text
userMap


-- | Returns an action to send a request to get the history of a conversation.
--
--   To fetch all messages in the conversation, run the returned 'LoadPage' action
--   repeatedly until it returns an empty list.
conversationsHistoryAll
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  =>  Conversation.HistoryReq
  -- ^ The first request to send. _NOTE_: 'Conversation.historyReqCursor' is silently ignored.
  -> m (LoadPage m Common.Message)
  -- ^ An action which returns a new page of messages every time called.
  --   If there are no pages anymore, it returns an empty list.
conversationsHistoryAll :: HistoryReq -> m (LoadPage m Message)
conversationsHistoryAll = (HistoryReq -> m (Response HistoryRsp))
-> HistoryReq -> m (LoadPage m Message)
forall (m :: * -> *).
MonadIO m =>
(HistoryReq -> m (Response HistoryRsp))
-> HistoryReq -> m (LoadPage m Message)
conversationsHistoryAllBy HistoryReq -> m (Response HistoryRsp)
forall env (m :: * -> *).
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
HistoryReq -> m (Response HistoryRsp)
conversationsHistory


-- | Returns an action to send a request to get the replies of a conversation.
--
--   To fetch all replies in the conversation, run the returned 'LoadPage' action
--   repeatedly until it returns an empty list.
--
--   *NOTE*: The conversations.replies endpoint always returns the first message
--           of the thread. So every page returned by the 'LoadPage' action includes
--           the first message of the thread. You should drop it if you want to
--           collect messages in a thread without duplicates.
repliesFetchAll
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  =>  Conversation.RepliesReq
  -- ^ The first request to send. _NOTE_: 'Conversation.repliesReqCursor' is silently ignored.
  -> m (LoadPage m Common.Message)
  -- ^ An action which returns a new page of messages every time called.
  --   If there are no pages anymore, it returns an empty list.
repliesFetchAll :: RepliesReq -> m (LoadPage m Message)
repliesFetchAll = (RepliesReq -> m (Response HistoryRsp))
-> RepliesReq -> m (LoadPage m Message)
forall (m :: * -> *).
MonadIO m =>
(RepliesReq -> m (Response HistoryRsp))
-> RepliesReq -> m (LoadPage m Message)
repliesFetchAllBy RepliesReq -> m (Response HistoryRsp)
forall env (m :: * -> *).
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
RepliesReq -> m (Response HistoryRsp)
conversationsReplies


liftNonClassy
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => (SlackConfig -> IO a) -> m a
liftNonClassy :: (SlackConfig -> IO a) -> m a
liftNonClassy SlackConfig -> IO a
f =
  (env -> IO a) -> m a
forall env (m :: * -> *) a.
(MonadReader env m, MonadIO m) =>
(env -> IO a) -> m a
liftToReader ((env -> IO a) -> m a) -> (env -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \env
env -> SlackConfig -> IO a
f (SlackConfig -> IO a) -> SlackConfig -> IO a
forall a b. (a -> b) -> a -> b
$ Manager -> Text -> SlackConfig
SlackConfig (env -> Manager
forall a. HasManager a => a -> Manager
getManager env
env) (env -> Text
forall a. HasToken a => a -> Text
getToken env
env)


liftToReader
  :: (MonadReader env m, MonadIO m)
  => (env -> IO a) -> m a
liftToReader :: (env -> IO a) -> m a
liftToReader env -> IO a
f = do
  env
env <- m env
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ env -> IO a
f env
env