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

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

module Web.Slack.Chat
  ( PostMsg(..)
  , PostMsgReq(..)
  , mkPostMsgReq
  , PostMsgRsp(..)
  )
  where

-- aeson
import Data.Aeson.TH

-- base
import GHC.Generics (Generic)

-- deepseq
import Control.DeepSeq (NFData)

-- http-api-data
import Web.FormUrlEncoded

-- slack-web
import Web.Slack.Util

-- text
import Data.Text (Text)


data PostMsg =
  PostMsg
    { PostMsg -> Text
postMsgText :: Text
    , PostMsg -> Maybe Text
postMsgParse :: Maybe Text
    , PostMsg -> Maybe Bool
postMsgLinkNames :: Maybe Bool
    , PostMsg -> Maybe Text
postMsgAttachments :: Maybe Text
    , PostMsg -> Maybe Bool
postMsgUnfurlLinks :: Maybe Bool
    , PostMsg -> Maybe Bool
postMsgUnfurlMedia :: Maybe Bool
    , PostMsg -> Maybe Text
postMsgUsername :: Maybe Text
    , PostMsg -> Maybe Bool
postMsgAsUser :: Maybe Bool
    , PostMsg -> Maybe Text
postMsgIconUrl :: Maybe Text
    , PostMsg -> Maybe Text
postMsgIconEmoji :: Maybe Text
    , PostMsg -> Maybe Text
postMsgThreadTs :: Maybe Text
    , PostMsg -> Maybe Bool
postMsgReplyBroadcast :: Maybe Bool
    }
  deriving (PostMsg -> PostMsg -> Bool
(PostMsg -> PostMsg -> Bool)
-> (PostMsg -> PostMsg -> Bool) -> Eq PostMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostMsg -> PostMsg -> Bool
$c/= :: PostMsg -> PostMsg -> Bool
== :: PostMsg -> PostMsg -> Bool
$c== :: PostMsg -> PostMsg -> Bool
Eq, (forall x. PostMsg -> Rep PostMsg x)
-> (forall x. Rep PostMsg x -> PostMsg) -> Generic PostMsg
forall x. Rep PostMsg x -> PostMsg
forall x. PostMsg -> Rep PostMsg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostMsg x -> PostMsg
$cfrom :: forall x. PostMsg -> Rep PostMsg x
Generic, Int -> PostMsg -> ShowS
[PostMsg] -> ShowS
PostMsg -> String
(Int -> PostMsg -> ShowS)
-> (PostMsg -> String) -> ([PostMsg] -> ShowS) -> Show PostMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostMsg] -> ShowS
$cshowList :: [PostMsg] -> ShowS
show :: PostMsg -> String
$cshow :: PostMsg -> String
showsPrec :: Int -> PostMsg -> ShowS
$cshowsPrec :: Int -> PostMsg -> ShowS
Show)

instance NFData PostMsg


-- |
--
--

$(deriveJSON (jsonOpts "postMsg") ''PostMsg)


-- |
--
--

data PostMsgReq =
  PostMsgReq
    { PostMsgReq -> Text
postMsgReqChannel :: Text
    , PostMsgReq -> Text
postMsgReqText :: Text
    , PostMsgReq -> Maybe Text
postMsgReqParse :: Maybe Text
    , PostMsgReq -> Maybe Bool
postMsgReqLinkNames :: Maybe Bool
    , PostMsgReq -> Maybe Text
postMsgReqAttachments :: Maybe Text
    , PostMsgReq -> Maybe Text
postMsgReqBlocks :: Maybe Text
    , PostMsgReq -> Maybe Bool
postMsgReqUnfurlLinks :: Maybe Bool
    , PostMsgReq -> Maybe Bool
postMsgReqUnfurlMedia :: Maybe Bool
    , PostMsgReq -> Maybe Text
postMsgReqUsername :: Maybe Text
    , PostMsgReq -> Maybe Bool
postMsgReqAsUser :: Maybe Bool
    , PostMsgReq -> Maybe Text
postMsgReqIconUrl :: Maybe Text
    , PostMsgReq -> Maybe Text
postMsgReqIconEmoji :: Maybe Text
    , PostMsgReq -> Maybe Text
postMsgReqThreadTs :: Maybe Text
    , PostMsgReq -> Maybe Bool
postMsgReqReplyBroadcast :: Maybe Bool
    }
  deriving (PostMsgReq -> PostMsgReq -> Bool
(PostMsgReq -> PostMsgReq -> Bool)
-> (PostMsgReq -> PostMsgReq -> Bool) -> Eq PostMsgReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostMsgReq -> PostMsgReq -> Bool
$c/= :: PostMsgReq -> PostMsgReq -> Bool
== :: PostMsgReq -> PostMsgReq -> Bool
$c== :: PostMsgReq -> PostMsgReq -> Bool
Eq, (forall x. PostMsgReq -> Rep PostMsgReq x)
-> (forall x. Rep PostMsgReq x -> PostMsgReq) -> Generic PostMsgReq
forall x. Rep PostMsgReq x -> PostMsgReq
forall x. PostMsgReq -> Rep PostMsgReq x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostMsgReq x -> PostMsgReq
$cfrom :: forall x. PostMsgReq -> Rep PostMsgReq x
Generic, Int -> PostMsgReq -> ShowS
[PostMsgReq] -> ShowS
PostMsgReq -> String
(Int -> PostMsgReq -> ShowS)
-> (PostMsgReq -> String)
-> ([PostMsgReq] -> ShowS)
-> Show PostMsgReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostMsgReq] -> ShowS
$cshowList :: [PostMsgReq] -> ShowS
show :: PostMsgReq -> String
$cshow :: PostMsgReq -> String
showsPrec :: Int -> PostMsgReq -> ShowS
$cshowsPrec :: Int -> PostMsgReq -> ShowS
Show)

instance NFData PostMsgReq


-- |
--
--

$(deriveJSON (jsonOpts "postMsgReq") ''PostMsgReq)


-- |
--
--

instance ToForm PostMsgReq where
  toForm :: PostMsgReq -> Form
toForm =
    FormOptions -> PostMsgReq -> Form
forall a.
(Generic a, GToForm a (Rep a)) =>
FormOptions -> a -> Form
genericToForm (Text -> FormOptions
formOpts Text
"postMsgReq")


-- |
--
--

mkPostMsgReq
  :: Text
  -> Text
  -> PostMsgReq
mkPostMsgReq :: Text -> Text -> PostMsgReq
mkPostMsgReq Text
channel Text
text =
  PostMsgReq :: Text
-> Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> PostMsgReq
PostMsgReq
    { postMsgReqChannel :: Text
postMsgReqChannel = Text
channel
    , postMsgReqText :: Text
postMsgReqText = Text
text
    , postMsgReqParse :: Maybe Text
postMsgReqParse = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqLinkNames :: Maybe Bool
postMsgReqLinkNames = Maybe Bool
forall a. Maybe a
Nothing
    , postMsgReqAttachments :: Maybe Text
postMsgReqAttachments = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqBlocks :: Maybe Text
postMsgReqBlocks = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqUnfurlLinks :: Maybe Bool
postMsgReqUnfurlLinks = Maybe Bool
forall a. Maybe a
Nothing
    , postMsgReqUnfurlMedia :: Maybe Bool
postMsgReqUnfurlMedia = Maybe Bool
forall a. Maybe a
Nothing
    , postMsgReqUsername :: Maybe Text
postMsgReqUsername = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqAsUser :: Maybe Bool
postMsgReqAsUser = Maybe Bool
forall a. Maybe a
Nothing
    , postMsgReqIconUrl :: Maybe Text
postMsgReqIconUrl = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqIconEmoji :: Maybe Text
postMsgReqIconEmoji = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqThreadTs :: Maybe Text
postMsgReqThreadTs = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqReplyBroadcast :: Maybe Bool
postMsgReqReplyBroadcast = Maybe Bool
forall a. Maybe a
Nothing
    }


-- |
--
--

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

instance NFData PostMsgRsp

$(deriveFromJSON (jsonOpts "postMsgRsp") ''PostMsgRsp)