module Web.Slack.Experimental.Blocks
(
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 (..),
RichItem (..),
RichStyle (..),
RichLinkAttrs (..),
RichTextSectionItem (..),
RichText (..),
RenderedSlackMessage (..),
render,
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
),
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
SlackText
x <+> :: SlackText -> SlackText -> SlackText
<+> SlackText
y = SlackText
x forall a. Semigroup a => a -> a -> a
<> SlackText
" " forall a. Semigroup a => a -> a -> a
<> SlackText
y
parens :: SlackText -> SlackText
parens :: SlackText -> SlackText
parens SlackText
x = SlackText
"(" forall a. Semigroup a => a -> a -> a
<> SlackText
x forall a. Semigroup a => a -> a -> a
<> SlackText
")"
brackets :: SlackText -> SlackText
brackets :: SlackText -> SlackText
brackets SlackText
x = SlackText
"[" forall a. Semigroup a => a -> a -> a
<> SlackText
x forall a. Semigroup a => a -> a -> a
<> SlackText
"]"
angleBrackets :: SlackText -> SlackText
angleBrackets :: SlackText -> SlackText
angleBrackets SlackText
x = SlackText
"<" forall a. Semigroup a => a -> a -> a
<> SlackText
x forall a. Semigroup a => a -> a -> a
<> SlackText
">"
ticks :: SlackText -> SlackText
ticks :: SlackText -> SlackText
ticks SlackText
x = SlackText
"`" forall a. Semigroup a => a -> a -> a
<> SlackText
x forall a. Semigroup a => a -> a -> a
<> SlackText
"`"
monospaced :: Slack a => a -> SlackText
monospaced :: forall a. Slack a => a -> SlackText
monospaced = SlackText -> SlackText
ticks forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Slack a => a -> SlackText
message
codeBlock :: SlackText -> SlackText
codeBlock :: SlackText -> SlackText
codeBlock SlackText
x = SlackText
"```\n" forall a. Semigroup a => a -> a -> a
<> SlackText
x forall a. Semigroup a => a -> a -> a
<> SlackText
"\n```"
bold :: SlackText -> SlackText
bold :: SlackText -> SlackText
bold SlackText
x = SlackText
"*" forall a. Semigroup a => a -> a -> a
<> SlackText
x forall a. Semigroup a => a -> a -> a
<> SlackText
"*"
italic :: SlackText -> SlackText
italic :: SlackText -> SlackText
italic SlackText
x = SlackText
"_" forall a. Semigroup a => a -> a -> a
<> SlackText
x forall a. Semigroup a => a -> a -> a
<> SlackText
"_"
newline :: SlackText -> SlackText
newline :: SlackText -> SlackText
newline SlackText
x = SlackText
"\n" forall a. Semigroup a => a -> a -> a
<> SlackText
x
unorderedList :: [SlackText] -> SlackText
unorderedList :: [SlackText] -> SlackText
unorderedList = forall a. Monoid a => [a] -> a
mconcat forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SlackText
t -> SlackText -> SlackText
newline (forall a. Slack a => a -> SlackText
message @Text Text
"- " forall a. Semigroup a => a -> a -> a
<> SlackText
t))
mentionUser :: UserId -> SlackText
mentionUser :: UserId -> SlackText
mentionUser UserId
slackUserId = forall a. Slack a => a -> SlackText
message forall a b. (a -> b) -> a -> b
$ Text
"<@" forall a. Semigroup a => a -> a -> a
<> UserId -> Text
unUserId UserId
slackUserId forall a. Semigroup a => a -> a -> a
<> Text
">"
mentionUserGroupById :: SlackText -> SlackText
mentionUserGroupById :: SlackText -> SlackText
mentionUserGroupById SlackText
userGroupId = SlackText -> SlackText
angleBrackets forall a b. (a -> b) -> a -> b
$ SlackText
"!subteam^" forall a. Semigroup a => a -> a -> a
<> SlackText
userGroupId
isSubStringOf :: Text -> SlackText -> Bool
Text
needle isSubStringOf :: Text -> SlackText -> Bool
`isSubStringOf` (SlackText [Text]
haystack) = Text
needle forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
`isInfixOf` forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat [Text]
haystack
data RenderedSlackMessage = RenderedSlackMessage
{ RenderedSlackMessage -> SlackMessage
_originalMessage :: SlackMessage
, RenderedSlackMessage -> Text
_renderedMessage :: Text
, RenderedSlackMessage -> Bool
_truncated :: Bool
}
render :: SlackMessage -> RenderedSlackMessage
render :: SlackMessage -> RenderedSlackMessage
render SlackMessage
sm =
let (SlackMessage
truncatedSm, Bool
isTruncated) = SlackMessage -> (SlackMessage, Bool)
truncateSlackMessage SlackMessage
sm
in SlackMessage -> Text -> Bool -> RenderedSlackMessage
RenderedSlackMessage SlackMessage
sm (forall a b. ConvertibleStrings a b => a -> b
cs forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ToJSON a => a -> Text
encodeToLazyText forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ SlackMessage
truncatedSm) Bool
isTruncated
truncateSlackMessage :: SlackMessage -> (SlackMessage, Bool)
truncateSlackMessage :: SlackMessage -> (SlackMessage, Bool)
truncateSlackMessage (SlackMessage [SlackBlock]
blocks) =
let ([SlackBlock]
truncatedBlocks, [Bool]
isTruncateds) = forall (f :: * -> *) a b. Zip f => f (a, b) -> (f a, f b)
unzip forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SlackBlock -> (SlackBlock, Bool)
truncateSlackBlock [SlackBlock]
blocks
in ([SlackBlock] -> SlackMessage
SlackMessage [SlackBlock]
truncatedBlocks, forall mono.
(MonoFoldable mono, Element mono ~ Bool) =>
mono -> Bool
or [Bool]
isTruncateds)
truncateSlackBlock :: SlackBlock -> (SlackBlock, Bool)
truncateSlackBlock :: SlackBlock -> (SlackBlock, Bool)
truncateSlackBlock sb :: SlackBlock
sb@(SlackBlockSection (SlackText [Text]
texts) Maybe SlackAccessory
mAccessory) =
let messageLength :: Element [Int]
messageLength = forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
sum forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Int
T.length [Text]
texts
lengthLimit :: Int
lengthLimit = Int
3000
truncationMessage :: Text
truncationMessage = Text
"\n...Rest of message truncated for slack\n"
truncationMessageLength :: Int
truncationMessageLength = Text -> Int
T.length Text
truncationMessage
truncateTexts :: [Text] -> Text
truncateTexts [Text]
ts = forall seq. IsSequence seq => Index seq -> seq -> seq
take (Int
lengthLimit forall a. Num a => a -> a -> a
- Int
truncationMessageLength) (forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat [Text]
ts)
in if Element [Int]
messageLength forall a. Ord a => a -> a -> Bool
> Int
lengthLimit
then (SlackText -> Maybe SlackAccessory -> SlackBlock
SlackBlockSection ([Text] -> SlackText
SlackText [[Text] -> Text
truncateTexts [Text]
texts forall a. Semigroup a => a -> a -> a
<> Text
"\n...Rest of message truncated for slack\n"]) Maybe SlackAccessory
mAccessory, Bool
True)
else (SlackBlock
sb, Bool
False)
truncateSlackBlock SlackBlock
x = (SlackBlock
x, Bool
False)
prefixFirstSlackBlockSection :: Text -> [SlackBlock] -> ([SlackBlock], Bool)
prefixFirstSlackBlockSection :: Text -> [SlackBlock] -> ([SlackBlock], Bool)
prefixFirstSlackBlockSection Text
prefix (SlackBlockSection SlackText
text Maybe SlackAccessory
mAccessory : [SlackBlock]
sbs) = (SlackText -> Maybe SlackAccessory -> SlackBlock
SlackBlockSection (forall a. Slack a => a -> SlackText
message Text
prefix forall a. Semigroup a => a -> a -> a
<> SlackText
text) Maybe SlackAccessory
mAccessory forall a. a -> [a] -> [a]
: [SlackBlock]
sbs, Bool
True)
prefixFirstSlackBlockSection Text
prefix (SlackBlock
sb : [SlackBlock]
sbs) = let ([SlackBlock]
prefixedSbs, Bool
match) = Text -> [SlackBlock] -> ([SlackBlock], Bool)
prefixFirstSlackBlockSection Text
prefix [SlackBlock]
sbs in (SlackBlock
sb forall a. a -> [a] -> [a]
: [SlackBlock]
prefixedSbs, Bool
match)
prefixFirstSlackBlockSection Text
_ [] = ([], Bool
False)
prefixFirstSlackMessage :: Text -> [SlackMessage] -> [SlackMessage]
prefixFirstSlackMessage :: Text -> [SlackMessage] -> [SlackMessage]
prefixFirstSlackMessage Text
prefix (SlackMessage
sm : [SlackMessage]
sms) =
let SlackMessage [SlackBlock]
slackBlocks = SlackMessage
sm
([SlackBlock]
prefixedSlackBlocks, Bool
match) = Text -> [SlackBlock] -> ([SlackBlock], Bool)
prefixFirstSlackBlockSection Text
prefix [SlackBlock]
slackBlocks
in if Bool
match
then [SlackBlock] -> SlackMessage
SlackMessage [SlackBlock]
prefixedSlackBlocks forall a. a -> [a] -> [a]
: [SlackMessage]
sms
else SlackMessage
sm forall a. a -> [a] -> [a]
: Text -> [SlackMessage] -> [SlackMessage]
prefixFirstSlackMessage Text
prefix [SlackMessage]
sms
prefixFirstSlackMessage Text
_ [] = []
slackMessage :: [SlackText] -> SlackMessage
slackMessage :: [SlackText] -> SlackMessage
slackMessage = [SlackBlock] -> SlackMessage
SlackMessage forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (SlackText -> Maybe SlackAccessory -> SlackBlock
`SlackBlockSection` forall a. Maybe a
Nothing) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Monoid a => [a] -> a
mconcat