Blocks.hs

module Web.Slack.Experimental.Blocks
  ( -- * General Slack Messages
    SlackText,
    (<+>),
    parens,
    brackets,
    angleBrackets,
    ticks,
    codeBlock,
    bold,
    italic,
    newline,
    unorderedList,
    link,
    monospaced,
    mentionUser,
    isSubStringOf,
    SlackImage (..),
    SlackMessage,
    Markdown (..),
    Image (..),
    context,
    textToMessage,
    prefixFirstSlackMessage,
    mentionUserGroupById,
    textToContext,
    slackMessage,
    SlackBlock (..),

    -- ** Blocks' rich text formatting (receive only!)
    RichItem (..),
    RichStyle (..),
    RichLinkAttrs (..),
    RichTextSectionItem (..),
    RichText (..),

    -- * Rendered messages
    RenderedSlackMessage (..),
    render,

    -- * Introduction to Slack Interactive Messages
    -- $interactive

    -- * Creating Slack Interactive Messages
    actions,
    actionsWithBlockId,
    SlackActionId (..),
    SlackBlockId,
    setting,
    emptySetting,
    SlackStyle (..),
    plaintext,
    plaintextonly,
    mrkdwn,
    button,
    buttonSettings,
    ButtonSettings
      ( buttonUrl,
        buttonValue,
        buttonStyle,
        buttonConfirm
      ),
    confirm,
    confirmAreYouSure,
    ConfirmSettings
      ( confirmTitle,
        confirmText,
        confirmConfirm,
        confirmDeny,
        confirmStyle
      ),

    -- * Responding to Slack Interactive Messages
    SlackInteractiveResponse (..),
  )
where

import Data.Aeson.Text (encodeToLazyText)
import Data.Text qualified as T
import Web.Slack.Experimental.Blocks.Types
import Web.Slack.Prelude
import Web.Slack.Types

(<+>) :: SlackText -> SlackText -> SlackText
x <+> y = x <> " " <> y

parens :: SlackText -> SlackText
parens x = "(" <> x <> ")"

brackets :: SlackText -> SlackText
brackets x = "[" <> x <> "]"

angleBrackets :: SlackText -> SlackText
angleBrackets x = "<" <> x <> ">"

ticks :: SlackText -> SlackText
ticks x = "`" <> x <> "`"

-- | Render a 'Slack' renderable value with ticks around it. Alias for @ticks . message@
monospaced :: Slack a => a -> SlackText
monospaced = ticks . message

codeBlock :: SlackText -> SlackText
codeBlock x = "```\n" <> x <> "\n```"

bold :: SlackText -> SlackText
bold x = "*" <> x <> "*"

italic :: SlackText -> SlackText
italic x = "_" <> x <> "_"

newline :: SlackText -> SlackText
newline x = "\n" <> x

-- | Render an unordered (bulleted) list
unorderedList :: [SlackText] -> SlackText
unorderedList = mconcat . fmap (\t -> newline (message @Text "- " <> t))

-- | https://api.slack.com/reference/surfaces/formatting#mentioning-users
mentionUser :: UserId -> SlackText
mentionUser slackUserId = message $ "<@" <> unUserId slackUserId <> ">"

-- | https://api.slack.com/reference/surfaces/formatting#mentioning-groups
mentionUserGroupById :: SlackText -> SlackText
mentionUserGroupById userGroupId = angleBrackets $ "!subteam^" <> userGroupId

isSubStringOf :: Text -> SlackText -> Bool
needle `isSubStringOf` (SlackText haystack) = needle `isInfixOf` concat haystack

-- | RenderedSlackMessage contains the original SlackMessage, the rendered version, and a
--   boolean indicating whether truncation was done.
--
--   Usage:
--
--   @
--      let
--        msg =
--        (mkPostMsgReq channel "")
--          { postMsgReqBlocks = Just blocks
--          , postMsgReqThreadTs = mThreadTs
--          }
--    chatPostMessage msg
--   @
data RenderedSlackMessage = RenderedSlackMessage
  { _originalMessage :: SlackMessage
  , _renderedMessage :: Text
  , _truncated :: Bool
  }

render :: SlackMessage -> RenderedSlackMessage
render sm =
  let (truncatedSm, isTruncated) = truncateSlackMessage sm
   in RenderedSlackMessage sm (cs . encodeToLazyText . toJSON $ truncatedSm) isTruncated

-- | Slack will fail if any text block is over 3000 chars.
--   truncateSlackMessage will truncate all text blocks and also return an bool
--   indicating whether any truncation was done.
truncateSlackMessage :: SlackMessage -> (SlackMessage, Bool)
truncateSlackMessage (SlackMessage blocks) =
  let (truncatedBlocks, isTruncateds) = unzip $ map truncateSlackBlock blocks
   in (SlackMessage truncatedBlocks, or isTruncateds)

truncateSlackBlock :: SlackBlock -> (SlackBlock, Bool)
truncateSlackBlock sb@(SlackBlockSection (SlackText texts) mAccessory) =
  let messageLength = sum $ map T.length texts
      lengthLimit = 3000
      truncationMessage = "\n...Rest of message truncated for slack\n"
      truncationMessageLength = T.length truncationMessage
      truncateTexts ts = take (lengthLimit - truncationMessageLength) (concat ts)
   in if messageLength > lengthLimit
        then (SlackBlockSection (SlackText [truncateTexts texts <> "\n...Rest of message truncated for slack\n"]) mAccessory, True)
        else (sb, False)
-- possible to also truncate SlackContexts, but we never put long strings in there.
truncateSlackBlock x = (x, False)

prefixFirstSlackBlockSection :: Text -> [SlackBlock] -> ([SlackBlock], Bool)
prefixFirstSlackBlockSection prefix (SlackBlockSection text mAccessory : sbs) = (SlackBlockSection (message prefix <> text) mAccessory : sbs, True)
prefixFirstSlackBlockSection prefix (sb : sbs) = let (prefixedSbs, match) = prefixFirstSlackBlockSection prefix sbs in (sb : prefixedSbs, match)
prefixFirstSlackBlockSection _ [] = ([], False)

prefixFirstSlackMessage :: Text -> [SlackMessage] -> [SlackMessage]
prefixFirstSlackMessage prefix (sm : sms) =
  let SlackMessage slackBlocks = sm
      (prefixedSlackBlocks, match) = prefixFirstSlackBlockSection prefix slackBlocks
   in if match
        then SlackMessage prefixedSlackBlocks : sms
        else sm : prefixFirstSlackMessage prefix sms
prefixFirstSlackMessage _ [] = []

-- | Concatenate a list of 'SlackText' into a single block, and wrap it up as a full message
slackMessage :: [SlackText] -> SlackMessage
slackMessage = SlackMessage . pure . (`SlackBlockSection` Nothing) . mconcat

-- $interactive
--
-- = Slack Interactive Messages
--
-- First, familiarize yourself with [Slack's Interactivity documentation](https://api.slack.com/interactivity).
-- Currently we only support [Block Kit interactive components](https://api.slack.com/interactivity/components),
-- i.e. components like buttons attached to messages.
--
-- To make an Slack message interactive, you need to include an \"Actions\" block that has one or more interactive components.
-- These should generally only be created using the builder functions such as 'actions' and 'button'. Consumers of this module
-- should avoid directly importing "Web.Slack.Experimental.Blocks.Types".