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 SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
" " SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
y
parens :: SlackText -> SlackText
parens :: SlackText -> SlackText
parens SlackText
x = SlackText
"(" SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
x SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
")"
brackets :: SlackText -> SlackText
brackets :: SlackText -> SlackText
brackets SlackText
x = SlackText
"[" SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
x SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
"]"
angleBrackets :: SlackText -> SlackText
angleBrackets :: SlackText -> SlackText
angleBrackets SlackText
x = SlackText
"<" SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
x SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
">"
ticks :: SlackText -> SlackText
ticks :: SlackText -> SlackText
ticks SlackText
x = SlackText
"`" SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
x SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
"`"
monospaced :: (Slack a) => a -> SlackText
monospaced :: forall a. Slack a => a -> SlackText
monospaced = SlackText -> SlackText
ticks (SlackText -> SlackText) -> (a -> SlackText) -> a -> SlackText
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> SlackText
forall a. Slack a => a -> SlackText
message
codeBlock :: SlackText -> SlackText
codeBlock :: SlackText -> SlackText
codeBlock SlackText
x = SlackText
"```\n" SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
x SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
"\n```"
bold :: SlackText -> SlackText
bold :: SlackText -> SlackText
bold SlackText
x = SlackText
"*" SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
x SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
"*"
italic :: SlackText -> SlackText
italic :: SlackText -> SlackText
italic SlackText
x = SlackText
"_" SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
x SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
"_"
newline :: SlackText -> SlackText
newline :: SlackText -> SlackText
newline SlackText
x = SlackText
"\n" SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
x
unorderedList :: [SlackText] -> SlackText
unorderedList :: [SlackText] -> SlackText
unorderedList = [SlackText] -> SlackText
forall a. Monoid a => [a] -> a
mconcat ([SlackText] -> SlackText)
-> ([SlackText] -> [SlackText]) -> [SlackText] -> SlackText
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (SlackText -> SlackText) -> [SlackText] -> [SlackText]
forall a b. (a -> b) -> [a] -> [b]
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
"- " SlackText -> SlackText -> SlackText
forall a. Semigroup a => a -> a -> a
<> SlackText
t))
mentionUser :: UserId -> SlackText
mentionUser :: UserId -> SlackText
mentionUser UserId
slackUserId = Text -> SlackText
forall a. Slack a => a -> SlackText
message (Text -> SlackText) -> Text -> SlackText
forall a b. (a -> b) -> a -> b
$ Text
"<@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UserId -> Text
unUserId UserId
slackUserId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
mentionUserGroupById :: SlackText -> SlackText
mentionUserGroupById :: SlackText -> SlackText
mentionUserGroupById SlackText
userGroupId = SlackText -> SlackText
angleBrackets (SlackText -> SlackText) -> SlackText -> SlackText
forall a b. (a -> b) -> a -> b
$ SlackText
"!subteam^" SlackText -> SlackText -> SlackText
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 Text -> Text -> Bool
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
`isInfixOf` [Text] -> Element [Text]
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 (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text) -> (SlackMessage -> Text) -> SlackMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText (Value -> Text) -> (SlackMessage -> Value) -> SlackMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SlackMessage -> Value
forall a. ToJSON a => a -> Value
toJSON (SlackMessage -> Text) -> SlackMessage -> Text
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) = [(SlackBlock, Bool)] -> ([SlackBlock], [Bool])
forall a b. [(a, b)] -> ([a], [b])
forall (f :: * -> *) a b. Zip f => f (a, b) -> (f a, f b)
unzip ([(SlackBlock, Bool)] -> ([SlackBlock], [Bool]))
-> [(SlackBlock, Bool)] -> ([SlackBlock], [Bool])
forall a b. (a -> b) -> a -> b
$ (SlackBlock -> (SlackBlock, Bool))
-> [SlackBlock] -> [(SlackBlock, Bool)]
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, [Bool] -> Bool
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 SlackSection {Maybe [SlackText]
Maybe SlackBlockId
Maybe SlackText
Maybe SlackAccessory
slackSectionText :: Maybe SlackText
slackSectionBlockId :: Maybe SlackBlockId
slackSectionFields :: Maybe [SlackText]
slackSectionAccessory :: Maybe SlackAccessory
slackSectionText :: SlackSection -> Maybe SlackText
slackSectionBlockId :: SlackSection -> Maybe SlackBlockId
slackSectionFields :: SlackSection -> Maybe [SlackText]
slackSectionAccessory :: SlackSection -> Maybe SlackAccessory
..}) =
let texts :: [Text]
texts = [Text] -> (SlackText -> [Text]) -> Maybe SlackText -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text]
forall a. Monoid a => a
mempty SlackText -> [Text]
unSlackTexts Maybe SlackText
slackSectionText
messageLength :: Element [Int]
messageLength = [Int] -> Element [Int]
forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
sum ([Int] -> Element [Int]) -> [Int] -> Element [Int]
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
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 = Index Text -> Text -> Text
forall seq. IsSequence seq => Index seq -> seq -> seq
take (Int
lengthLimit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
truncationMessageLength) ([Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat [Text]
ts)
truncatedSection :: SlackBlock
truncatedSection =
SlackSection -> SlackBlock
SlackBlockSection
SlackSection
{ slackSectionText :: Maybe SlackText
slackSectionText = SlackText -> Maybe SlackText
forall a. a -> Maybe a
Just (SlackText -> Maybe SlackText) -> SlackText -> Maybe SlackText
forall a b. (a -> b) -> a -> b
$ [Text] -> SlackText
SlackText [[Text] -> Text
truncateTexts [Text]
texts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n...Rest of message truncated for slack\n"]
, Maybe SlackAccessory
slackSectionAccessory :: Maybe SlackAccessory
slackSectionAccessory :: Maybe SlackAccessory
slackSectionAccessory
, Maybe SlackBlockId
slackSectionBlockId :: Maybe SlackBlockId
slackSectionBlockId :: Maybe SlackBlockId
slackSectionBlockId
, Maybe [SlackText]
slackSectionFields :: Maybe [SlackText]
slackSectionFields :: Maybe [SlackText]
slackSectionFields
}
in if Int
Element [Int]
messageLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lengthLimit
then (SlackBlock
truncatedSection, 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 SlackSection {Maybe [SlackText]
Maybe SlackBlockId
Maybe SlackText
Maybe SlackAccessory
slackSectionText :: SlackSection -> Maybe SlackText
slackSectionBlockId :: SlackSection -> Maybe SlackBlockId
slackSectionFields :: SlackSection -> Maybe [SlackText]
slackSectionAccessory :: SlackSection -> Maybe SlackAccessory
slackSectionText :: Maybe SlackText
slackSectionBlockId :: Maybe SlackBlockId
slackSectionFields :: Maybe [SlackText]
slackSectionAccessory :: Maybe SlackAccessory
..} : [SlackBlock]
sbs) =
let prefixedSection :: SlackBlock
prefixedSection =
SlackSection -> SlackBlock
SlackBlockSection
SlackSection
{ slackSectionText :: Maybe SlackText
slackSectionText = SlackText -> SlackText -> SlackText
forall a. Monoid a => a -> a -> a
mappend (Text -> SlackText
forall a. Slack a => a -> SlackText
message Text
prefix) (SlackText -> SlackText) -> Maybe SlackText -> Maybe SlackText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SlackText
slackSectionText
, Maybe SlackBlockId
slackSectionBlockId :: Maybe SlackBlockId
slackSectionBlockId :: Maybe SlackBlockId
slackSectionBlockId
, Maybe [SlackText]
slackSectionFields :: Maybe [SlackText]
slackSectionFields :: Maybe [SlackText]
slackSectionFields
, Maybe SlackAccessory
slackSectionAccessory :: Maybe SlackAccessory
slackSectionAccessory :: Maybe SlackAccessory
slackSectionAccessory
}
in (SlackBlock
prefixedSection SlackBlock -> [SlackBlock] -> [SlackBlock]
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 SlackBlock -> [SlackBlock] -> [SlackBlock]
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 SlackMessage -> [SlackMessage] -> [SlackMessage]
forall a. a -> [a] -> [a]
: [SlackMessage]
sms
else SlackMessage
sm SlackMessage -> [SlackMessage] -> [SlackMessage]
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 ([SlackBlock] -> SlackMessage)
-> ([SlackText] -> [SlackBlock]) -> [SlackText] -> SlackMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SlackBlock -> [SlackBlock]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlackBlock -> [SlackBlock])
-> ([SlackText] -> SlackBlock) -> [SlackText] -> [SlackBlock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SlackSection -> SlackBlock
SlackBlockSection (SlackSection -> SlackBlock)
-> ([SlackText] -> SlackSection) -> [SlackText] -> SlackBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SlackText -> SlackSection
slackSectionWithText (SlackText -> SlackSection)
-> ([SlackText] -> SlackText) -> [SlackText] -> SlackSection
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [SlackText] -> SlackText
forall a. Monoid a => [a] -> a
mconcat