diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for sandwich-slack
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Tom McLaughlin (c) 2021
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Tom McLaughlin nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,1 @@
+# sandwich-slack
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Concurrent
+import Control.Monad.IO.Class
+import Data.Time
+import GHC.Stack
+import Test.Sandwich
+import Test.Sandwich.Formatters.Print
+import Test.Sandwich.Formatters.Slack
+import Test.Sandwich.Formatters.TerminalUI
+
+simple :: TopSpec
+simple = parallel $ do
+  it "does the thing 1" sleepThenSucceed
+  it "does the thing 2" sleepThenSucceed
+  it "does the thing 3" deepSleepThenFail
+  describe "should happen sequentially" $ do
+    it "sequential 1" sleepThenSucceed
+    it "sequential 2" sleepThenFail
+    it "sequential 3" sleepThenSucceed
+  it "does the thing 4" deepSleepThenFail
+  it "does the thing 5" sleepThenSucceed
+  it "does the thing 6" sleepThenSucceed
+
+
+slackFormatter = defaultSlackFormatter {
+  slackFormatterSlackConfig = SlackConfig ""
+  , slackFormatterTopMessage = Just "Top message"
+  , slackFormatterChannel = "test-channel"
+
+  , slackFormatterMaxFailures = Just 2
+  , slackFormatterMaxFailureReasonLines = Just 1
+  , slackFormatterMaxCallStackLines = Just 3
+
+  , slackFormatterVisibilityThreshold = Just 50
+  }
+
+baseFormatter = SomeFormatter defaultTerminalUIFormatter
+-- baseFormatter = SomeFormatter defaultPrintFormatter
+
+main :: IO ()
+main = runSandwich options simple
+  where
+    options = defaultOptions {
+      optionsTestArtifactsDirectory = TestArtifactsGeneratedDirectory "test_runs" (show <$> getCurrentTime)
+      , optionsFormatters = [baseFormatter, SomeFormatter slackFormatter]
+      }
+
+-- * Util
+
+sleepThenSucceed :: (HasCallStack) => ExampleM context ()
+sleepThenSucceed = do
+  -- liftIO $ threadDelay (2 * 10^1)
+  liftIO $ threadDelay (2 * 10^5)
+  -- liftIO $ threadDelay (1 * 10^6)
+  -- liftIO $ threadDelay (3 * 10^6)
+
+sleepThenFail :: (HasCallStack) => ExampleM context ()
+sleepThenFail = do
+  -- liftIO $ threadDelay (2 * 10^1)
+  liftIO $ threadDelay (2 * 10^5)
+  -- liftIO $ threadDelay (1 * 10^6)
+  -- liftIO $ threadDelay (3 * 10^6)
+  2 `shouldBe` 3
+
+
+deepSleepThenFail :: (HasCallStack) => ExampleM context ()
+deepSleepThenFail = deepSleepThenFail2
+
+deepSleepThenFail2 :: (HasCallStack) => ExampleM context ()
+deepSleepThenFail2 = deepSleepThenFail3
+
+deepSleepThenFail3 :: (HasCallStack) => ExampleM context ()
+deepSleepThenFail3 = sleepThenFail
diff --git a/sandwich-slack.cabal b/sandwich-slack.cabal
new file mode 100644
--- /dev/null
+++ b/sandwich-slack.cabal
@@ -0,0 +1,117 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: d7320880fc7447510af33486a1a9fc622e995d778acdafb73e966bc9b2fb67ec
+
+name:           sandwich-slack
+version:        0.1.0.0
+synopsis:       Slack integration for Sandwich
+description:    Please see the README on GitHub at <https://github.com/codedownio/sandwich-slack#readme>
+category:       Testing
+homepage:       https://github.com/codedownio/sandwich-slack#readme
+bug-reports:    https://github.com/codedownio/sandwich-slack/issues
+author:         Tom McLaughlin
+maintainer:     tom@codedown.io
+copyright:      2021 Tom McLaughlin
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/codedownio/sandwich-slack
+
+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
+  other-modules:
+      Paths_sandwich_slack
+  hs-source-dirs:
+      src
+  ghc-options: -W
+  build-depends:
+      aeson
+    , base <=4.14
+    , bytestring
+    , containers
+    , lens
+    , lens-aeson
+    , monad-logger
+    , mtl
+    , safe
+    , safe-exceptions
+    , sandwich
+    , stm
+    , string-interpolate
+    , text
+    , time
+    , vector
+    , wreq
+  default-language: Haskell2010
+
+executable sandwich-slack-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_sandwich_slack
+  hs-source-dirs:
+      app
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      aeson
+    , base <=4.14
+    , bytestring
+    , containers
+    , lens
+    , lens-aeson
+    , monad-logger
+    , mtl
+    , safe
+    , safe-exceptions
+    , sandwich
+    , sandwich-slack
+    , stm
+    , string-interpolate
+    , text
+    , time
+    , vector
+    , wreq
+  default-language: Haskell2010
+
+test-suite sandwich-slack-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_sandwich_slack
+  hs-source-dirs:
+      test
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      aeson
+    , base <=4.14
+    , bytestring
+    , containers
+    , lens
+    , lens-aeson
+    , monad-logger
+    , mtl
+    , safe
+    , safe-exceptions
+    , sandwich
+    , sandwich-slack
+    , stm
+    , string-interpolate
+    , text
+    , time
+    , vector
+    , wreq
+  default-language: Haskell2010
diff --git a/src/Test/Sandwich/Formatters/Internal/Core.hs b/src/Test/Sandwich/Formatters/Internal/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/Formatters/Internal/Core.hs
@@ -0,0 +1,58 @@
+{-# 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
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/Formatters/Internal/Markdown.hs
@@ -0,0 +1,38 @@
+{-# 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
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/Formatters/Internal/ProgressBar.hs
@@ -0,0 +1,87 @@
+{-# 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
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/Formatters/Internal/Types.hs
@@ -0,0 +1,49 @@
+{-# 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
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/Formatters/Slack.hs
@@ -0,0 +1,256 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Test.Sandwich.Formatters.Slack (
+  SlackFormatter
+  , SlackConfig(..)
+
+  , defaultSlackFormatter
+
+  , slackFormatterSlackConfig
+  , slackFormatterChannel
+
+  , slackFormatterTopMessage
+
+  , slackFormatterMaxFailures
+  , slackFormatterMaxFailureReasonLines
+  , slackFormatterMaxCallStackLines
+
+  , slackFormatterVisibilityThreshold
+
+  , slackFormatterMaxMessageSize
+
+  , SlackFormatterShowCallStacks(..)
+  ) where
+
+import Control.Applicative
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Exception.Safe
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Logger hiding (logError)
+import qualified Data.Aeson as A
+import Data.Foldable
+import Data.Function
+import qualified Data.List as L
+import qualified Data.Map as M
+import Data.Maybe
+import Data.String.Interpolate
+import qualified Data.Text as T
+import Data.Time
+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.Internal
+import Test.Sandwich.Internal.Formatters
+
+
+data SlackFormatter = SlackFormatter {
+  slackFormatterSlackConfig :: SlackConfig
+  -- ^ Slack credentials
+  , slackFormatterChannel :: String
+  -- ^ Slack channel on which to create the progress bar.
+
+  , slackFormatterTopMessage :: Maybe String
+  -- ^ Message to put above the progress bar.
+  -- For example, the name of the test suite and a link to the run in the CI system.
+
+  , slackFormatterMaxFailures :: Maybe Int
+  -- ^ Maximum number of failures to include in a message.
+  -- If too many are included, it's possible to hit Slack's request limit of 8KB, which
+  -- causes the message to fail to update.
+  -- Defaults to 30.
+  , slackFormatterMaxFailureReasonLines :: Maybe Int
+  -- ^ Maximum number of lines to devote to showing the failure reason underneath a failure.
+  -- Set to 'Just 0' to disable showing failure reasons.
+  , slackFormatterMaxCallStackLines :: Maybe Int
+  -- ^ Maximum number of lines to devote to showing the call stack underneath a failure.
+  -- Set to 'Just 0' to disable showing call stacks.
+
+  , slackFormatterVisibilityThreshold :: Maybe Int
+  -- ^ If present, filter the headings on failures to only include nodes whose visibility
+  -- threshold is less than or equal to the value.
+
+  , slackFormatterMaxMessageSize :: Maybe Int64
+  -- ^ If present, make sure the messages we transmit to Slack default don't exceed this number
+  -- of bytes. When a message does exceed it (probably because there are a ton of failures),
+  -- 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.
+  }
+
+defaultSlackFormatter :: SlackFormatter
+defaultSlackFormatter = SlackFormatter {
+  slackFormatterSlackConfig = SlackConfig "my-password"
+  , slackFormatterChannel = "slack-channel"
+
+  , slackFormatterTopMessage = Just "Top message"
+
+  , slackFormatterMaxFailures = Just 30
+  , slackFormatterMaxFailureReasonLines = Just 5
+  , slackFormatterMaxCallStackLines = Just 5
+
+  , slackFormatterVisibilityThreshold = Nothing
+
+  -- 8KB, although Slack might accept 16KB now?
+  , slackFormatterMaxMessageSize = Just 8192
+  }
+
+instance Formatter SlackFormatter where
+  formatterName _ = "slack-formatter"
+  runFormatter baseFormatter rts (Just clo) bc = runApp (addCommandLineOptions clo baseFormatter) rts bc
+  runFormatter baseFormatter rts Nothing bc = runApp baseFormatter rts bc
+  finalizeFormatter _ _ _ = return ()
+
+addCommandLineOptions :: CommandLineOptions a -> SlackFormatter -> SlackFormatter
+addCommandLineOptions (CommandLineOptions {optSlackOptions=(CommandLineSlackOptions {..})}) baseFormatter@(SlackFormatter {..}) = baseFormatter {
+  slackFormatterSlackConfig = maybe slackFormatterSlackConfig (SlackConfig . T.pack) optSlackToken
+  , slackFormatterChannel = fromMaybe slackFormatterChannel optSlackChannel
+  , slackFormatterTopMessage = optSlackTopMessage <|> slackFormatterTopMessage
+  , slackFormatterMaxFailures = optSlackMaxFailures <|> slackFormatterMaxFailures
+  , slackFormatterMaxFailureReasonLines = optSlackMaxFailureReasonLines <|> slackFormatterMaxFailureReasonLines
+  , slackFormatterMaxCallStackLines = optSlackMaxCallStackLines <|> slackFormatterMaxCallStackLines
+  , slackFormatterVisibilityThreshold = optSlackVisibilityThreshold <|> slackFormatterVisibilityThreshold
+  , slackFormatterMaxMessageSize = optSlackMaxMessageSize <|> slackFormatterMaxMessageSize
+  }
+
+runApp :: (MonadIO m, MonadCatch m, MonadLogger m) => SlackFormatter -> [RunNode BaseContext] -> BaseContext -> m ()
+runApp sf@(SlackFormatter {..}) rts _bc = do
+  startTime <- liftIO getCurrentTime
+
+  let extractFromNode node = let RunNodeCommonWithStatus {..} = runNodeCommon node in (runTreeId, (T.pack runTreeLabel, runTreeVisibilityLevel))
+  let idToLabelAndVisibilityThreshold = M.fromList $ mconcat [extractValues extractFromNode node | node <- rts]
+
+  rtsFixed <- liftIO $ atomically $ mapM fixRunTree rts
+  let pbi = publishTree sf idToLabelAndVisibilityThreshold 0 rtsFixed
+  pb <- (liftIO $ createProgressBar slackFormatterSlackConfig (T.pack slackFormatterChannel) slackFormatterMaxMessageSize pbi) >>= \case
+    Left err -> liftIO $ throwIO $ userError $ T.unpack err
+    Right pb -> return pb
+
+  unless (allIsDone rtsFixed) $ do
+    currentFixedTree <- liftIO $ newTVarIO rtsFixed
+    fix $ \loop -> do
+      newFixedTree <- liftIO $ atomically $ do
+        currentFixed <- readTVar currentFixedTree
+        newFixed <- mapM fixRunTree rts
+        when (fmap getCommons newFixed == fmap getCommons currentFixed) retry
+        writeTVar currentFixedTree newFixed
+        return newFixed
+
+      now <- liftIO getCurrentTime
+      let pbi' = publishTree sf idToLabelAndVisibilityThreshold (diffUTCTime now startTime) newFixedTree
+      tryAny (liftIO $ updateProgressBar slackFormatterSlackConfig slackFormatterMaxMessageSize pb pbi') >>= \case
+        Left err -> logError [i|Error updating progress bar: '#{err}'|]
+        Right (Left err) -> logError [i|Inner error updating progress bar: '#{err}'. Blocks were '#{A.encode $ progressBarInfoBlocks pbi'}'|]
+        Right (Right ()) -> return ()
+
+      if | allIsDone newFixedTree -> do
+             debug [i|All tree nodes are done, exiting!|]
+             return ()
+         | otherwise -> do
+             liftIO $ threadDelay 100000 -- Sleep 100ms
+             loop
+
+
+publishTree sf idToLabelAndVisibilityThreshold elapsed tree = pbi
+  where
+    pbi = ProgressBarInfo {
+      progressBarInfoTopMessage = T.pack <$> (slackFormatterTopMessage sf)
+      , progressBarInfoBottomMessage = Just fullBottomMessage
+      , progressBarInfoSize = Just (100.0 * (fromIntegral (succeeded + pending + failed) / (fromIntegral total)))
+      , progressBarInfoAttachments = Nothing
+      , progressBarInfoBlocks = Just $ case slackFormatterMaxFailures sf of
+          Nothing -> mconcat blocks
+          Just n -> case L.splitAt n blocks of
+            (xs, []) -> mconcat xs
+            (xs, rest) -> mconcat xs <> [extraFailuresBlock (L.length rest)]
+      }
+
+    runningMessage = headMay $ L.sort $ catMaybes $ flip concatMap tree $
+      extractValues (\node -> if isRunningItBlock node then Just $ runTreeLabel $ runNodeCommon node else Nothing)
+
+    fullBottomMessage = case runningMessage of
+      Nothing -> bottomMessage
+      Just t -> T.pack t <> "\n" <> bottomMessage
+    bottomMessage = [i|#{succeeded} succeeded, #{failed} failed, #{pending} pending, #{totalRunningTests} running of #{total} (#{formatNominalDiffTime elapsed} elapsed)|]
+
+    blocks = catMaybes $ flip concatMap tree $ extractValuesControlRecurse $ \case
+      -- Recurse into grouping nodes, because their failures are actually just derived from child failures
+      RunNodeDescribe {} -> (True, Nothing)
+      RunNodeParallel {} -> (True, Nothing)
+      ((runTreeStatus . runNodeCommon) -> (Done {statusResult=(Failure (Pending {}))})) -> (False, Nothing)
+      node@((runTreeStatus . runNodeCommon) -> (Done {statusResult=(Failure reason)})) | isFailedBlock node ->
+        (False, Just $ singleFailureBlocks sf idToLabelAndVisibilityThreshold node reason)
+      _ -> (True, Nothing)
+
+    total = countWhere isItBlock tree
+    succeeded = countWhere isSuccessItBlock tree
+    pending = countWhere isPendingItBlock tree
+    failed = countWhere isFailedItBlock tree
+    totalRunningTests = countWhere isRunningItBlock tree
+    -- totalNotStartedTests = countWhere isNotStartedItBlock tree
+
+
+singleFailureBlocks sf idToLabelAndVisibilityThreshold node reason = catMaybes [
+  Just $ markdownSectionWithLines [":red_circle: *" <> label <> "*"]
+
+  -- Failure reason info
+  , case (markdownLinesToShow, _overflowMarkdownLines) of
+      ([], _) -> Nothing
+      (toShow, []) -> Just $ markdownSectionWithLines toShow
+      (toShow, overflow) -> Just $ markdownSectionWithLines $ addToLastLine toShow [i| (+ #{L.length overflow} more lines)|]
+
+  -- Callstack info
+  , case (callStackLinesToShow, _overflowCallStackLines) of
+      ([], _) -> Nothing
+      (toShow, []) -> Just $ markdownSectionWithLines toShow
+      (toShow, overflow) -> Just $ markdownSectionWithLines $ addToLastLine toShow [i| (+ #{L.length overflow} more lines)|]
+  ]
+  where
+    allMarkdownLines = T.lines $ toMarkdown reason
+    (markdownLinesToShow, _overflowMarkdownLines) = case slackFormatterMaxFailureReasonLines sf of
+      Nothing -> (allMarkdownLines, [])
+      Just n -> L.splitAt n allMarkdownLines
+
+    allCallStackLines = case failureCallStack reason of
+      Just cs -> L.filter (not . T.null) $ T.lines $ callStackToMarkdown SlackFormatterFullCallStack cs
+      _ -> []
+    (callStackLinesToShow, _overflowCallStackLines) = case slackFormatterMaxCallStackLines sf of
+      Nothing -> (allCallStackLines, [])
+      Just n -> L.splitAt n allCallStackLines
+
+    -- Show a question mark if we can't determine the label for a node (should never happen).
+    -- Otherwise, use slackFormatterVisibilityThreshold to filter if provided.
+    filterFn k = case M.lookup k idToLabelAndVisibilityThreshold of
+      Nothing -> Just "?"
+      Just (l, thresh) -> case slackFormatterVisibilityThreshold sf of
+        Just maxThresh | thresh > maxThresh -> Nothing
+        _ -> Just l
+    label = T.intercalate ", " $ mapMaybe filterFn $ toList $ runTreeAncestors $ runNodeCommon node
+
+extraFailuresBlock numExtraFailures = markdownSectionWithLines [[i|+ #{numExtraFailures} more failure|]]
+
+markdownBlockWithLines ls = A.object [("type", A.String "mrkdwn"), ("text", A.String $ T.unlines ls)]
+
+markdownSectionWithLines ls = A.object [("type", A.String "section"), ("text", markdownBlockWithLines ls)]
+
+addToLastLine :: [T.Text] -> T.Text -> [T.Text]
+addToLastLine [] _ = []
+addToLastLine xs toAdd = (init xs) <> [last xs <> toAdd]
+
+allIsDone :: [RunNodeFixed context] -> Bool
+allIsDone = all (isDone . runTreeStatus . runNodeCommon)
+  where
+    isDone :: Status -> Bool
+    isDone (Done {}) = True
+    isDone _ = False
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"