Create async pointing threads in slack

point-it.hs

#!/usr/bin/env stack
{- stack
    script
    --resolver lts-12.24
    --package "aeson bytestring lens lens-aeson optparse-applicative split text wreq"
    --ghc-options -Wall
-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Lens ((&), (.~), (^?))
import Data.Aeson.Lens (_String, key)
import qualified Data.ByteString.Char8 as BSC
import Data.Foldable (traverse_)
import Data.List.Split (splitOn)
import Data.Semigroup ((<>))
import qualified Data.Text as Text
import Network.Wreq as Wreq
  ( FormParam((:=))
  , asValue
  , defaults
  , getWith
  , header
  , post
  , responseBody
  )
import qualified Options.Applicative as OP

main :: IO ()
main = do
  config <- OP.execParser configParser
  putStr "Fetching stories..."
  stories <- traverse (fetchStory config) $ getIds config
  putStrLn "Done!"
  putStr "Sending messages..."
  let action =
        if getOnlyPrint config
          then putStrLn . formatMessage config
          else sendMessage config
  traverse_ action stories
  putStrLn "Done!"

data Config = Config
  { getIds :: [String]
  , getPtApiKey :: String
  , getSlackToken :: String
  , getChannel :: String
  , getFlair :: String
  , getOnlyPrint :: Bool
  }

configParser :: OP.ParserInfo Config
configParser = OP.info parser info
  where
    info = OP.fullDesc <> OP.progDesc "Creates async pointer threads in slack"
    parser =
      Config <$>
      listOption
        (OP.long "ids" <>
         OP.help "Commy separated list of story ids to be pointed" <>
         OP.metavar "IDS") <*>
      OP.strOption
        (OP.long "pt-key" <> OP.help "Your PT api key" <> OP.metavar "PT_KEY") <*>
      OP.strOption
        (OP.long "slack-token" <> OP.help "Your legacy slack token" <>
         OP.metavar "SLACK_KEY") <*>
      OP.strOption
        (OP.long "channel" <> OP.help "The channel to send messages" <>
         OP.metavar "CHANNEL") <*>
      OP.strOption
        (OP.long "--flair" <>
         OP.help "Flair to add to the beginning of your message" <>
         OP.value "👉") <*>
      OP.switch
        (OP.long "only-print" <>
         OP.help "Just print the messages to the console instead")
    listOption =
      OP.option $ OP.maybeReader $ \raw ->
        case splitOn "," raw of
          [] -> Nothing
          x -> Just $ normalizeId <$> x

data Story = Story
  { getTitle :: String
  , getUrl :: String
  } deriving (Show)

fetchStory :: Config -> String -> IO Story
fetchStory config storyId = do
  let opts =
        Wreq.defaults & header "X-TrackerToken" .~
        [BSC.pack $ getPtApiKey config]
  r <-
    asValue =<<
    (getWith opts $ "https://www.pivotaltracker.com/services/v5/stories/" ++
     storyId)
  let getKey name = Text.unpack <$> r ^? responseBody . key name . _String
  let maybeStory = Story <$> (getKey "name") <*> (getKey "url")
  case maybeStory of
    Just story -> pure story
    Nothing -> fail "Unable to parse story from response"

sendMessage :: Config -> Story -> IO ()
sendMessage config story = do
  _ <-
    post
      "https://api.slack.com/api/chat.postMessage"
      [ "token" := getSlackToken config
      , "channel" := getChannel config
      , "text" := formatMessage config story
      , "as_user" := ("true" :: String)
      ]
  pure ()

formatMessage :: Config -> Story -> String
formatMessage config story =
  (getFlair config) ++ " " ++ (getTitle story) ++ "\n" ++ (getUrl story)

normalizeId :: String -> String
normalizeId ('#':rest) = rest
normalizeId storyId = storyId