{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Test.Sandwich.Formatters.Slack.Internal.Types where

import qualified Data.Aeson as A
import qualified Data.Text as T

-- | Configuration options needed to connect to the Slack API
newtype SlackConfig = SlackConfig {
  SlackConfig -> Text
slackApiToken :: T.Text
  -- ^ Slack API token
  } deriving (Int -> SlackConfig -> ShowS
[SlackConfig] -> ShowS
SlackConfig -> String
(Int -> SlackConfig -> ShowS)
-> (SlackConfig -> String)
-> ([SlackConfig] -> ShowS)
-> Show SlackConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlackConfig] -> ShowS
$cshowList :: [SlackConfig] -> ShowS
show :: SlackConfig -> String
$cshow :: SlackConfig -> String
showsPrec :: Int -> SlackConfig -> ShowS
$cshowsPrec :: Int -> SlackConfig -> ShowS
Show)

-- | The state of a progress bar message.
data ProgressBarInfo = ProgressBarInfo {
  ProgressBarInfo -> Maybe Text
progressBarInfoTopMessage :: Maybe T.Text
  -- ^ Message to show above the progress bar
  , ProgressBarInfo -> Maybe Text
progressBarInfoBottomMessage :: Maybe T.Text
  -- ^ Message to show below the progress bar
  , ProgressBarInfo -> Maybe Double
progressBarInfoSize :: Maybe Double
  -- ^ Size of the progress bar, a 'Double' from 0 to 100
  , ProgressBarInfo -> Maybe [ProgressBarAttachment]
progressBarInfoAttachments :: Maybe [ProgressBarAttachment]
  -- ^ Slack attachments for the message
  , ProgressBarInfo -> Maybe [Value]
progressBarInfoBlocks :: Maybe [A.Value]
  -- ^ Structured blocks, using the <https://api.slack.com/block-kit Slack Block Kit>
  }

-- | A Slack attachment.
data ProgressBarAttachment = ProgressBarAttachment {
  ProgressBarAttachment -> Text
progressBarAttachmentText :: T.Text
  -- ^ Attachment text
  , ProgressBarAttachment -> Text
progressBarAttachmentColor :: T.Text
  -- ^ Attachment color
  }
instance A.ToJSON ProgressBarAttachment
  where toJSON :: ProgressBarAttachment -> Value
toJSON (ProgressBarAttachment {Text
progressBarAttachmentColor :: Text
progressBarAttachmentText :: Text
progressBarAttachmentColor :: ProgressBarAttachment -> Text
progressBarAttachmentText :: ProgressBarAttachment -> Text
..}) = [Pair] -> Value
A.object [
          (Text
"text", Text -> Value
A.String Text
progressBarAttachmentText)
          , (Text
"color", Text -> Value
A.String Text
progressBarAttachmentColor)
          ]

-- | An opaque type representing an existing Slack message.
data ProgressBar = ProgressBar {
  ProgressBar -> Text
progressBarTs :: T.Text
  , ProgressBar -> Text
progressBarChannel :: T.Text
  }

data SlackFormatterShowCallStacks =
  SlackFormatterNoCallStacks
  -- ^ Don't include callstacks in failure messages
  | SlackFormatterTopNCallStackFrames Int
  -- ^ Include the top N stack frames
  | SlackFormatterFullCallStack
  -- ^ Include the full callstack

type ChannelName = T.Text