diff --git a/README.md b/README.md
deleted file mode 100644
--- a/README.md
+++ /dev/null
@@ -1,1 +0,0 @@
-# sandwich-slack
diff --git a/sandwich-slack.cabal b/sandwich-slack.cabal
--- a/sandwich-slack.cabal
+++ b/sandwich-slack.cabal
@@ -4,10 +4,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: d446a77761b7441448561836b119c54e0f5f6fb6eb49a42e8d04b74a9ae208d1
+-- hash: 87b67607e636cc36cd53424fdd2c45e855177f019d67d230fd8d6d77bdbc6f3f
 
 name:           sandwich-slack
-version:        0.1.0.3
+version:        0.1.0.4
 synopsis:       Sandwich integration with Slack
 description:    Please see the documentation at <https://codedownio.github.io/sandwich/docs/extensions/sandwich-slack>
 category:       Testing
@@ -20,7 +20,6 @@
 license-file:   LICENSE
 build-type:     Simple
 extra-source-files:
-    README.md
     CHANGELOG.md
 
 source-repository head
@@ -29,12 +28,13 @@
 
 library
   exposed-modules:
-      Test.Sandwich.Formatters.Internal.Core
-      Test.Sandwich.Formatters.Internal.Markdown
-      Test.Sandwich.Formatters.Internal.ProgressBar
-      Test.Sandwich.Formatters.Internal.Types
       Test.Sandwich.Formatters.Slack
+      Test.Sandwich.Formatters.Slack.Internal
   other-modules:
+      Test.Sandwich.Formatters.Slack.Internal.Core
+      Test.Sandwich.Formatters.Slack.Internal.Markdown
+      Test.Sandwich.Formatters.Slack.Internal.ProgressBar
+      Test.Sandwich.Formatters.Slack.Internal.Types
       Paths_sandwich_slack
   hs-source-dirs:
       src
diff --git a/src/Test/Sandwich/Formatters/Internal/Core.hs b/src/Test/Sandwich/Formatters/Internal/Core.hs
deleted file mode 100644
--- a/src/Test/Sandwich/Formatters/Internal/Core.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Test.Sandwich.Formatters.Internal.Core where
-
-import Control.Lens hiding ((??))
-import Control.Monad.Except
-import Data.Aeson
-import qualified Data.Aeson as A
-import Data.Aeson.Lens
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Vector as V
-import qualified Network.Wreq as W
-import Test.Sandwich.Formatters.Internal.Types
-
-postMessage :: (MonadError T.Text m, MonadIO m) => SlackConfig -> ChannelName -> T.Text -> [A.Value] -> Maybe [A.Value] -> m Value
-postMessage conf cid msg as maybeBlocks =
-  makeSlackCall conf "chat.postMessage" $ A.object $ [
-    ("token", A.String $ slackApiToken conf)
-    , ("channel", A.String cid)
-    , ("text", A.String msg)
-    , ("attachments", A.Array $ V.fromList as)
-    , ("as_user", A.Bool True)
-    ]
-    <> (case maybeBlocks of Nothing -> []; Just blocks -> [("blocks", A.Array $ V.fromList blocks)])
-
-updateMessage :: (MonadError T.Text m, MonadIO m) => SlackConfig -> ChannelName -> T.Text -> T.Text -> [A.Value] -> Maybe [A.Value] -> m ()
-updateMessage conf cid ts msg as maybeBlocks =
-  void $ makeSlackCall conf "chat.update" $ A.object $ [
-    ("token", A.String $ slackApiToken conf)
-    , ("channel", A.String cid)
-    , ("text", A.String msg)
-    , ("attachments", A.Array $ V.fromList as)
-    , ("as_user", A.Bool True)
-    , ("ts", A.String ts)
-    ]
-    <> (case maybeBlocks of Nothing -> []; Just blocks -> [("blocks", A.Array $ V.fromList blocks)])
-
-encode' :: A.ToJSON a => a -> T.Text
-encode' = T.decodeUtf8 . BL.toStrict . encode
-
-makeSlackCall :: (MonadError T.Text m, MonadIO m) => SlackConfig -> String -> A.Value -> m Value
-makeSlackCall conf method body = do
-  let url = "https://slack.com/api/" ++ method
-  let opts = W.defaults & (W.header "Authorization" .~ ["Bearer " <> T.encodeUtf8 (slackApiToken conf)])
-  rawResp <- liftIO $ W.postWith opts url (body)
-  resp <- rawResp ^? W.responseBody . _Value ?? "Couldn't parse response"
-  case resp ^? key "ok" . _Bool of
-    Just True -> return resp
-    Just False -> throwError $ resp ^. key "error" . _String
-    Nothing -> throwError "Couldn't parse key 'ok' from response"
-
-infixl 7 ??
-(??) :: MonadError e m => Maybe a -> e -> m a
-x ?? e = maybe (throwError e) return x
diff --git a/src/Test/Sandwich/Formatters/Internal/Markdown.hs b/src/Test/Sandwich/Formatters/Internal/Markdown.hs
deleted file mode 100644
--- a/src/Test/Sandwich/Formatters/Internal/Markdown.hs
+++ /dev/null
@@ -1,38 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Test.Sandwich.Formatters.Internal.Markdown where
-
-import Data.Function
-import qualified Data.List as L
-import Data.String.Interpolate
-import qualified Data.Text as T
-import GHC.Stack
-import Test.Sandwich
-import Test.Sandwich.Formatters.Internal.Types
-
-
-toMarkdown :: FailureReason -> T.Text
-toMarkdown (Reason {..}) = T.pack failureReason
-toMarkdown (ExpectedButGot {..}) = [i|Expected *#{failureValue1}* but got *#{failureValue2}*|]
-toMarkdown (DidNotExpectButGot {..}) = [i|Did not expect *#{failureValue1}*|]
-toMarkdown (GotException {..}) = case failureMessage of
-  Just msg -> [i|Got exception (_#{msg}_): #{failureException}|]
-  Nothing -> [i|Got exception (no message): #{failureException}|]
-toMarkdown (Pending {..}) = "Example was pending"
-toMarkdown (GetContextException {..}) = [i|Context exception: #{failureException}|]
-toMarkdown (GotAsyncException {..}) = case failureMessage of
-  Just msg -> [i|Got async exception (_#{msg}_): #{failureAsyncException}|]
-  Nothing -> [i|Got async exception: #{failureAsyncException}|]
-
-callStackToMarkdown :: SlackFormatterShowCallStacks -> CallStack -> T.Text
-callStackToMarkdown SlackFormatterNoCallStacks _cs = ""
-callStackToMarkdown (SlackFormatterTopNCallStackFrames n) cs = "\n\n" <> showCallStack (fromCallSiteList $ L.take n $ getCallStack cs)
-callStackToMarkdown SlackFormatterFullCallStack cs = "\n\n" <> showCallStack cs
-
-showCallStack (getCallStack -> rows) = ["> *" <> (T.pack name) <> "*, called at "
-                                        <> [i|_#{srcLocPackage}_:*#{srcLocFile}*:#{srcLocStartLine}:#{srcLocStartCol}|]
-                                       | (name, SrcLoc {..}) <- rows]
-  & T.intercalate "\n"
diff --git a/src/Test/Sandwich/Formatters/Internal/ProgressBar.hs b/src/Test/Sandwich/Formatters/Internal/ProgressBar.hs
deleted file mode 100644
--- a/src/Test/Sandwich/Formatters/Internal/ProgressBar.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-
-module Test.Sandwich.Formatters.Internal.ProgressBar where
-
-
-import Control.Lens hiding ((??))
-import Control.Monad.Except
-import qualified Data.Aeson as A
-import Data.Aeson.Lens
-import qualified Data.ByteString.Lazy as BL
-import Data.Char
-import Data.Maybe
-import Data.String.Interpolate
-import qualified Data.Text as T
-import GHC.Int
-import Test.Sandwich.Formatters.Internal.Core
-import Test.Sandwich.Formatters.Internal.Types
-
--- | Create a progress bar message on the given channel.
--- Returns a 'ProgressBar' which can be used to update the message by calling 'updateProgressBar'.
-createProgressBar :: SlackConfig -> ChannelName -> Maybe Int64 -> ProgressBarInfo -> IO (Either T.Text ProgressBar)
-createProgressBar slackConfig channel maxMessageSize pbi@(ProgressBarInfo {..}) =
-  (runExceptT $ postMessage slackConfig channel message (getAttachments pbi) blocks) >>= \case
-    Left err -> return $ Left [i|Failed to send initial result: '#{err}'. Blocks were '#{A.encode progressBarInfoBlocks}'.|]
-    Right resp -> case (resp ^? key "ts" . _String, resp ^? key "channel" . _String) of
-      (Just ts, Just chan) -> return $ Right $ ProgressBar ts chan
-      _ -> return $ Left [i|Couldn't find timestamp and/or channel in response|]
-  where
-    message = getMessage pbi
-    blocks = truncateBlocksIfNecessary maxMessageSize <$> addMessageToBlocks message progressBarInfoBlocks
-
--- | Update an existing progress bar.
-updateProgressBar :: SlackConfig -> Maybe Int64 -> ProgressBar -> ProgressBarInfo -> IO (Either T.Text ())
-updateProgressBar slackConfig maxMessageSize (ProgressBar {..}) pbi@(ProgressBarInfo {..}) =
-  (runExceptT $ updateMessage slackConfig progressBarChannel progressBarTs (getMessage pbi) (getAttachments pbi) blocks) >>= \case
-    Left err -> return $ Left [i|Failed to update progress bar: '#{err}'|]
-    Right _ -> return $ Right ()
-  where
-    message = getMessage pbi
-    blocks = truncateBlocksIfNecessary maxMessageSize <$> addMessageToBlocks message progressBarInfoBlocks
-
--- * Internal
-
-getMessage :: ProgressBarInfo -> T.Text
-getMessage (ProgressBarInfo {..}) =
-  T.intercalate "\n" $ catMaybes [progressBarInfoTopMessage
-                                 , barSized <$> progressBarInfoSize
-                                 , progressBarInfoBottomMessage]
-
-getAttachments :: ProgressBarInfo -> [A.Value]
-getAttachments (ProgressBarInfo {..}) = maybe [] (fmap A.toJSON) progressBarInfoAttachments
-
-addMessageToBlocks :: T.Text -> Maybe [A.Value] -> Maybe [A.Value]
-addMessageToBlocks _ Nothing = Nothing
-addMessageToBlocks msg (Just blocks) = Just (textBlock : blocks)
-  where
-    textBlock = A.object [
-      ("type", A.String "section")
-      , ("text", A.object [("type", A.String "mrkdwn")
-                          , ("text", A.String msg)])
-      ]
-
--- | This is kind of wasteful, because it requires encoding every block to get the lengths.
--- It's also a little rough because it won't exactly match the length of the encoded blocks list
--- (with brackets etc.) and doesn't take into account the rest of the message. Hopefully it's close
--- enough to correct, but TODO find a way to do the truncating efficiently as part of encoding
--- the message onto the wire.
-truncateBlocksIfNecessary :: Maybe Int64 -> [A.Value] -> [A.Value]
-truncateBlocksIfNecessary _ [] = []
-truncateBlocksIfNecessary Nothing xs = xs
-truncateBlocksIfNecessary (Just bytesRemaining) (x:xs) = case BL.length $ A.encode x of
-  len | len >= bytesRemaining -> []
-  len -> x : (truncateBlocksIfNecessary (Just (bytesRemaining - len - 1)) xs)
-
-barSized :: Double -> T.Text
-barSized n = (T.replicate darkBlocks $ T.singleton $ chr 9608)
-             <> (T.replicate lightBlocks $ T.singleton $ chr 9617)
-             <> [i| #{roundTo 2 n}%|]
-  where darkBlocks = round $ n * multiplier
-        lightBlocks = round $ (100 - n) * multiplier
-        multiplier = 0.5
-
-        roundTo :: (Fractional a, RealFrac a) => Integer -> a -> a
-        roundTo places num = (fromInteger $ round $ num * (10^places)) / (10.0^^places)
diff --git a/src/Test/Sandwich/Formatters/Internal/Types.hs b/src/Test/Sandwich/Formatters/Internal/Types.hs
deleted file mode 100644
--- a/src/Test/Sandwich/Formatters/Internal/Types.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
-module Test.Sandwich.Formatters.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 { slackApiToken :: T.Text
-                                  -- ^ Slack API token
-                                  } deriving (Show)
-
--- | The state of a progress bar message.
-data ProgressBarInfo = ProgressBarInfo { progressBarInfoTopMessage :: Maybe T.Text
-                                       -- ^ Message to show above the progress bar
-                                       , progressBarInfoBottomMessage :: Maybe T.Text
-                                       -- ^ Message to show below the progress bar
-                                       , progressBarInfoSize :: Maybe Double
-                                       -- ^ Size of the progress bar, a 'Double' from 0 to 100
-                                       , progressBarInfoAttachments :: Maybe [ProgressBarAttachment]
-                                       -- ^ Slack attachments for the message
-                                       , progressBarInfoBlocks :: Maybe [A.Value]
-                                       -- ^ Structured blocks, using the <https://api.slack.com/block-kit Slack Block Kit>
-                                       }
-
--- | A Slack attachment.
-data ProgressBarAttachment = ProgressBarAttachment { progressBarAttachmentText :: T.Text
-                                                   -- ^ Attachment text
-                                                   , progressBarAttachmentColor :: T.Text
-                                                   -- ^ Attachment color
-                                                   }
-instance A.ToJSON ProgressBarAttachment
-  where toJSON (ProgressBarAttachment {..}) = A.object [("text", A.String progressBarAttachmentText)
-                                                       , ("color", A.String progressBarAttachmentColor)]
-
--- | An opaque type representing an existing Slack message.
-data ProgressBar = ProgressBar { progressBarTs :: T.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
diff --git a/src/Test/Sandwich/Formatters/Slack.hs b/src/Test/Sandwich/Formatters/Slack.hs
--- a/src/Test/Sandwich/Formatters/Slack.hs
+++ b/src/Test/Sandwich/Formatters/Slack.hs
@@ -7,12 +7,12 @@
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
 
-module Test.Sandwich.Formatters.Slack (
-  SlackFormatter
-  , SlackConfig(..)
+-- | The Slack formatter shows live-updating test progress and failures by sending messages to a Slack channel.
 
-  , defaultSlackFormatter
+module Test.Sandwich.Formatters.Slack (
+  defaultSlackFormatter
 
+  -- * Options
   , slackFormatterSlackConfig
   , slackFormatterChannel
 
@@ -26,6 +26,8 @@
 
   , slackFormatterMaxMessageSize
 
+  -- * Auxiliary types
+  , SlackConfig(..)
   , SlackFormatterShowCallStacks(..)
   ) where
 
@@ -48,11 +50,10 @@
 import GHC.Int
 import Safe
 import Test.Sandwich
-import Test.Sandwich.Formatters.Internal.Markdown
-import Test.Sandwich.Formatters.Internal.ProgressBar
-import Test.Sandwich.Formatters.Internal.Types
+import Test.Sandwich.Formatters.Slack.Internal.Markdown
+import Test.Sandwich.Formatters.Slack.Internal.ProgressBar
+import Test.Sandwich.Formatters.Slack.Internal.Types
 import Test.Sandwich.Internal
-import Test.Sandwich.Internal.Formatters
 
 
 data SlackFormatter = SlackFormatter {
@@ -87,7 +88,7 @@
   -- start dropping blocks from the end of the message until the size is small enough.
   -- Making use of 'slackFormatterMaxFailures', 'slackFormatterMaxFailureReasonLines', and
   -- 'slackFormatterMaxCallStackLines' is a good way to avoid hitting the limit.
-  }
+  } deriving (Show)
 
 defaultSlackFormatter :: SlackFormatter
 defaultSlackFormatter = SlackFormatter {
diff --git a/src/Test/Sandwich/Formatters/Slack/Internal.hs b/src/Test/Sandwich/Formatters/Slack/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/Formatters/Slack/Internal.hs
@@ -0,0 +1,12 @@
+
+module Test.Sandwich.Formatters.Slack.Internal (
+   module Test.Sandwich.Formatters.Slack.Internal.Core
+  , module Test.Sandwich.Formatters.Slack.Internal.Markdown
+  , module Test.Sandwich.Formatters.Slack.Internal.ProgressBar
+  , module Test.Sandwich.Formatters.Slack.Internal.Types
+  ) where
+
+import Test.Sandwich.Formatters.Slack.Internal.Core
+import Test.Sandwich.Formatters.Slack.Internal.Markdown
+import Test.Sandwich.Formatters.Slack.Internal.ProgressBar
+import Test.Sandwich.Formatters.Slack.Internal.Types
diff --git a/src/Test/Sandwich/Formatters/Slack/Internal/Core.hs b/src/Test/Sandwich/Formatters/Slack/Internal/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/Formatters/Slack/Internal/Core.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Test.Sandwich.Formatters.Slack.Internal.Core where
+
+import Control.Lens hiding ((??))
+import Control.Monad.Except
+import Data.Aeson
+import qualified Data.Aeson as A
+import Data.Aeson.Lens
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Vector as V
+import qualified Network.Wreq as W
+import Test.Sandwich.Formatters.Slack.Internal.Types
+
+postMessage :: (MonadError T.Text m, MonadIO m) => SlackConfig -> ChannelName -> T.Text -> [A.Value] -> Maybe [A.Value] -> m Value
+postMessage conf cid msg as maybeBlocks =
+  makeSlackCall conf "chat.postMessage" $ A.object $ [
+    ("token", A.String $ slackApiToken conf)
+    , ("channel", A.String cid)
+    , ("text", A.String msg)
+    , ("attachments", A.Array $ V.fromList as)
+    , ("as_user", A.Bool True)
+    ]
+    <> (case maybeBlocks of Nothing -> []; Just blocks -> [("blocks", A.Array $ V.fromList blocks)])
+
+updateMessage :: (MonadError T.Text m, MonadIO m) => SlackConfig -> ChannelName -> T.Text -> T.Text -> [A.Value] -> Maybe [A.Value] -> m ()
+updateMessage conf cid ts msg as maybeBlocks =
+  void $ makeSlackCall conf "chat.update" $ A.object $ [
+    ("token", A.String $ slackApiToken conf)
+    , ("channel", A.String cid)
+    , ("text", A.String msg)
+    , ("attachments", A.Array $ V.fromList as)
+    , ("as_user", A.Bool True)
+    , ("ts", A.String ts)
+    ]
+    <> (case maybeBlocks of Nothing -> []; Just blocks -> [("blocks", A.Array $ V.fromList blocks)])
+
+encode' :: A.ToJSON a => a -> T.Text
+encode' = T.decodeUtf8 . BL.toStrict . encode
+
+makeSlackCall :: (MonadError T.Text m, MonadIO m) => SlackConfig -> String -> A.Value -> m Value
+makeSlackCall conf method body = do
+  let url = "https://slack.com/api/" ++ method
+  let opts = W.defaults & (W.header "Authorization" .~ ["Bearer " <> T.encodeUtf8 (slackApiToken conf)])
+  rawResp <- liftIO $ W.postWith opts url (body)
+  resp <- rawResp ^? W.responseBody . _Value ?? "Couldn't parse response"
+  case resp ^? key "ok" . _Bool of
+    Just True -> return resp
+    Just False -> throwError $ resp ^. key "error" . _String
+    Nothing -> throwError "Couldn't parse key 'ok' from response"
+
+infixl 7 ??
+(??) :: MonadError e m => Maybe a -> e -> m a
+x ?? e = maybe (throwError e) return x
diff --git a/src/Test/Sandwich/Formatters/Slack/Internal/Markdown.hs b/src/Test/Sandwich/Formatters/Slack/Internal/Markdown.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/Formatters/Slack/Internal/Markdown.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Test.Sandwich.Formatters.Slack.Internal.Markdown where
+
+import Data.Function
+import qualified Data.List as L
+import Data.String.Interpolate
+import qualified Data.Text as T
+import GHC.Stack
+import Test.Sandwich
+import Test.Sandwich.Formatters.Slack.Internal.Types
+
+
+toMarkdown :: FailureReason -> T.Text
+toMarkdown (Reason {..}) = T.pack failureReason
+toMarkdown (ChildrenFailed {failureNumChildren=n}) = [i|#{n} #{if n == 1 then ("child" :: T.Text) else "children"} failed|]
+toMarkdown (ExpectedButGot {..}) = [i|Expected *#{failureValue1}* but got *#{failureValue2}*|]
+toMarkdown (DidNotExpectButGot {..}) = [i|Did not expect *#{failureValue1}*|]
+toMarkdown (GotException {..}) = case failureMessage of
+  Just msg -> [i|Got exception (_#{msg}_): #{failureException}|]
+  Nothing -> [i|Got exception (no message): #{failureException}|]
+toMarkdown (Pending {..}) = "Example was pending"
+toMarkdown (GetContextException {..}) = [i|Context exception: #{failureException}|]
+toMarkdown (GotAsyncException {..}) = case failureMessage of
+  Just msg -> [i|Got async exception (_#{msg}_): #{failureAsyncException}|]
+  Nothing -> [i|Got async exception: #{failureAsyncException}|]
+
+callStackToMarkdown :: SlackFormatterShowCallStacks -> CallStack -> T.Text
+callStackToMarkdown SlackFormatterNoCallStacks _cs = ""
+callStackToMarkdown (SlackFormatterTopNCallStackFrames n) cs = "\n\n" <> showCallStack (fromCallSiteList $ L.take n $ getCallStack cs)
+callStackToMarkdown SlackFormatterFullCallStack cs = "\n\n" <> showCallStack cs
+
+showCallStack (getCallStack -> rows) = ["> *" <> (T.pack name) <> "*, called at "
+                                        <> [i|_#{srcLocPackage}_:*#{srcLocFile}*:#{srcLocStartLine}:#{srcLocStartCol}|]
+                                       | (name, SrcLoc {..}) <- rows]
+  & T.intercalate "\n"
diff --git a/src/Test/Sandwich/Formatters/Slack/Internal/ProgressBar.hs b/src/Test/Sandwich/Formatters/Slack/Internal/ProgressBar.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/Formatters/Slack/Internal/ProgressBar.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Test.Sandwich.Formatters.Slack.Internal.ProgressBar where
+
+
+import Control.Lens hiding ((??))
+import Control.Monad.Except
+import qualified Data.Aeson as A
+import Data.Aeson.Lens
+import qualified Data.ByteString.Lazy as BL
+import Data.Char
+import Data.Maybe
+import Data.String.Interpolate
+import qualified Data.Text as T
+import GHC.Int
+import Test.Sandwich.Formatters.Slack.Internal.Core
+import Test.Sandwich.Formatters.Slack.Internal.Types
+
+-- | Create a progress bar message on the given channel.
+-- Returns a 'ProgressBar' which can be used to update the message by calling 'updateProgressBar'.
+createProgressBar :: SlackConfig -> ChannelName -> Maybe Int64 -> ProgressBarInfo -> IO (Either T.Text ProgressBar)
+createProgressBar slackConfig channel maxMessageSize pbi@(ProgressBarInfo {..}) =
+  (runExceptT $ postMessage slackConfig channel message (getAttachments pbi) blocks) >>= \case
+    Left err -> return $ Left [i|Failed to send initial result: '#{err}'. Blocks were '#{A.encode progressBarInfoBlocks}'.|]
+    Right resp -> case (resp ^? key "ts" . _String, resp ^? key "channel" . _String) of
+      (Just ts, Just chan) -> return $ Right $ ProgressBar ts chan
+      _ -> return $ Left [i|Couldn't find timestamp and/or channel in response|]
+  where
+    message = getMessage pbi
+    blocks = truncateBlocksIfNecessary maxMessageSize <$> addMessageToBlocks message progressBarInfoBlocks
+
+-- | Update an existing progress bar.
+updateProgressBar :: SlackConfig -> Maybe Int64 -> ProgressBar -> ProgressBarInfo -> IO (Either T.Text ())
+updateProgressBar slackConfig maxMessageSize (ProgressBar {..}) pbi@(ProgressBarInfo {..}) =
+  (runExceptT $ updateMessage slackConfig progressBarChannel progressBarTs (getMessage pbi) (getAttachments pbi) blocks) >>= \case
+    Left err -> return $ Left [i|Failed to update progress bar: '#{err}'|]
+    Right _ -> return $ Right ()
+  where
+    message = getMessage pbi
+    blocks = truncateBlocksIfNecessary maxMessageSize <$> addMessageToBlocks message progressBarInfoBlocks
+
+-- * Internal
+
+getMessage :: ProgressBarInfo -> T.Text
+getMessage (ProgressBarInfo {..}) =
+  T.intercalate "\n" $ catMaybes [progressBarInfoTopMessage
+                                 , barSized <$> progressBarInfoSize
+                                 , progressBarInfoBottomMessage]
+
+getAttachments :: ProgressBarInfo -> [A.Value]
+getAttachments (ProgressBarInfo {..}) = maybe [] (fmap A.toJSON) progressBarInfoAttachments
+
+addMessageToBlocks :: T.Text -> Maybe [A.Value] -> Maybe [A.Value]
+addMessageToBlocks _ Nothing = Nothing
+addMessageToBlocks msg (Just blocks) = Just (textBlock : blocks)
+  where
+    textBlock = A.object [
+      ("type", A.String "section")
+      , ("text", A.object [("type", A.String "mrkdwn")
+                          , ("text", A.String msg)])
+      ]
+
+-- | This is kind of wasteful, because it requires encoding every block to get the lengths.
+-- It's also a little rough because it won't exactly match the length of the encoded blocks list
+-- (with brackets etc.) and doesn't take into account the rest of the message. Hopefully it's close
+-- enough to correct, but TODO find a way to do the truncating efficiently as part of encoding
+-- the message onto the wire.
+truncateBlocksIfNecessary :: Maybe Int64 -> [A.Value] -> [A.Value]
+truncateBlocksIfNecessary _ [] = []
+truncateBlocksIfNecessary Nothing xs = xs
+truncateBlocksIfNecessary (Just bytesRemaining) (x:xs) = case BL.length $ A.encode x of
+  len | len >= bytesRemaining -> []
+  len -> x : (truncateBlocksIfNecessary (Just (bytesRemaining - len - 1)) xs)
+
+barSized :: Double -> T.Text
+barSized n = (T.replicate darkBlocks $ T.singleton $ chr 9608)
+             <> (T.replicate lightBlocks $ T.singleton $ chr 9617)
+             <> [i| #{roundTo 2 n}%|]
+  where darkBlocks = round $ n * multiplier
+        lightBlocks = round $ (100 - n) * multiplier
+        multiplier = 0.5
+
+        roundTo :: (Fractional a, RealFrac a) => Integer -> a -> a
+        roundTo places num = (fromInteger $ round $ num * (10^places)) / (10.0^^places)
diff --git a/src/Test/Sandwich/Formatters/Slack/Internal/Types.hs b/src/Test/Sandwich/Formatters/Slack/Internal/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/Formatters/Slack/Internal/Types.hs
@@ -0,0 +1,56 @@
+{-# 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 {
+  slackApiToken :: T.Text
+  -- ^ Slack API token
+  } deriving (Show)
+
+-- | The state of a progress bar message.
+data ProgressBarInfo = ProgressBarInfo {
+  progressBarInfoTopMessage :: Maybe T.Text
+  -- ^ Message to show above the progress bar
+  , progressBarInfoBottomMessage :: Maybe T.Text
+  -- ^ Message to show below the progress bar
+  , progressBarInfoSize :: Maybe Double
+  -- ^ Size of the progress bar, a 'Double' from 0 to 100
+  , progressBarInfoAttachments :: Maybe [ProgressBarAttachment]
+  -- ^ Slack attachments for the message
+  , progressBarInfoBlocks :: Maybe [A.Value]
+  -- ^ Structured blocks, using the <https://api.slack.com/block-kit Slack Block Kit>
+  }
+
+-- | A Slack attachment.
+data ProgressBarAttachment = ProgressBarAttachment {
+  progressBarAttachmentText :: T.Text
+  -- ^ Attachment text
+  , progressBarAttachmentColor :: T.Text
+  -- ^ Attachment color
+  }
+instance A.ToJSON ProgressBarAttachment
+  where toJSON (ProgressBarAttachment {..}) = A.object [
+          ("text", A.String progressBarAttachmentText)
+          , ("color", A.String progressBarAttachmentColor)
+          ]
+
+-- | An opaque type representing an existing Slack message.
+data ProgressBar = ProgressBar {
+  progressBarTs :: T.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