-- |
-- Module: Rollbar.CLI
-- Copyright: (c) 2020 Stack Builders Inc.
-- License: MIT
-- Maintainer: Sebastián Estrella <sestrella@stackbuilders.com>
module Rollbar.CLI
  ( Command(..)
  , DeployCommand(..)
  , parseCommand
  , runCommand
  ) where

import Options.Applicative
import Rollbar.Client

data Command
  = CommandPing
    -- ^ Pings Rollbar API server.
    --
    -- @since 0.1.0
  | CommandDeploy DeployCommand
    -- ^ Tracks a deploy in Rollbar.
    --
    -- @since 0.1.0
  deriving (Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)

data DeployCommand = DeployCommandReport (Maybe Revision)
  deriving (DeployCommand -> DeployCommand -> Bool
(DeployCommand -> DeployCommand -> Bool)
-> (DeployCommand -> DeployCommand -> Bool) -> Eq DeployCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeployCommand -> DeployCommand -> Bool
$c/= :: DeployCommand -> DeployCommand -> Bool
== :: DeployCommand -> DeployCommand -> Bool
$c== :: DeployCommand -> DeployCommand -> Bool
Eq, Int -> DeployCommand -> ShowS
[DeployCommand] -> ShowS
DeployCommand -> String
(Int -> DeployCommand -> ShowS)
-> (DeployCommand -> String)
-> ([DeployCommand] -> ShowS)
-> Show DeployCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeployCommand] -> ShowS
$cshowList :: [DeployCommand] -> ShowS
show :: DeployCommand -> String
$cshow :: DeployCommand -> String
showsPrec :: Int -> DeployCommand -> ShowS
$cshowsPrec :: Int -> DeployCommand -> ShowS
Show)

-- | Parses a 'Command'.
--
-- @since 0.1.0
parseCommand :: IO Command
parseCommand :: IO Command
parseCommand = ParserInfo Command -> IO Command
forall a. ParserInfo a -> IO a
execParser ParserInfo Command
commandParserInfo

commandParserInfo :: ParserInfo Command
commandParserInfo :: ParserInfo Command
commandParserInfo = Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Command
commandParser Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
helper) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [InfoMod Command] -> InfoMod Command
forall a. Monoid a => [a] -> a
mconcat
  [ InfoMod Command
forall a. InfoMod a
fullDesc
  , String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Simple CLI to talk with Rollbar API"
  ]

commandParser :: Parser Command
commandParser :: Parser Command
commandParser = Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields Command] -> Mod CommandFields Command
forall a. Monoid a => [a] -> a
mconcat
  [ String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"ping" (ParserInfo Command -> Mod CommandFields Command)
-> ParserInfo Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Command
pingParser Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
helper) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [InfoMod Command] -> InfoMod Command
forall a. Monoid a => [a] -> a
mconcat
      [ InfoMod Command
forall a. InfoMod a
fullDesc
      , String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Ping the API server"
      ]
  , String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"deploy" (ParserInfo Command -> Mod CommandFields Command)
-> ParserInfo Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Command
deployParser Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
helper) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [InfoMod Command] -> InfoMod Command
forall a. Monoid a => [a] -> a
mconcat
      [ InfoMod Command
forall a. InfoMod a
fullDesc
      , String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Deploy specific commands"
      ]
  ]
  where
    pingParser :: Parser Command
pingParser = Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
CommandPing
    deployParser :: Parser Command
deployParser = DeployCommand -> Command
CommandDeploy (DeployCommand -> Command)
-> Parser DeployCommand -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DeployCommand
deployCommandParser

deployCommandParser :: Parser DeployCommand
deployCommandParser :: Parser DeployCommand
deployCommandParser = Mod CommandFields DeployCommand -> Parser DeployCommand
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields DeployCommand -> Parser DeployCommand)
-> Mod CommandFields DeployCommand -> Parser DeployCommand
forall a b. (a -> b) -> a -> b
$
  String
-> ParserInfo DeployCommand -> Mod CommandFields DeployCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"report" (ParserInfo DeployCommand -> Mod CommandFields DeployCommand)
-> ParserInfo DeployCommand -> Mod CommandFields DeployCommand
forall a b. (a -> b) -> a -> b
$ Parser DeployCommand
-> InfoMod DeployCommand -> ParserInfo DeployCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser DeployCommand
deployCommandReportParser Parser DeployCommand
-> Parser (DeployCommand -> DeployCommand) -> Parser DeployCommand
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (DeployCommand -> DeployCommand)
forall a. Parser (a -> a)
helper) (InfoMod DeployCommand -> ParserInfo DeployCommand)
-> InfoMod DeployCommand -> ParserInfo DeployCommand
forall a b. (a -> b) -> a -> b
$ [InfoMod DeployCommand] -> InfoMod DeployCommand
forall a. Monoid a => [a] -> a
mconcat
    [ InfoMod DeployCommand
forall a. InfoMod a
fullDesc
    , String -> InfoMod DeployCommand
forall a. String -> InfoMod a
progDesc String
"Tracks a deploy in Rollbar"
    ]

deployCommandReportParser :: Parser DeployCommand
deployCommandReportParser :: Parser DeployCommand
deployCommandReportParser =
  Maybe Revision -> DeployCommand
DeployCommandReport (Maybe Revision -> DeployCommand)
-> Parser (Maybe Revision) -> Parser DeployCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Revision -> Parser (Maybe Revision)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Revision
Revision (Text -> Revision) -> Parser Text -> Parser Revision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption Mod OptionFields Text
forall a. Mod OptionFields a
revisionOptions)
  where
    revisionOptions :: Mod OptionFields a
revisionOptions = [Mod OptionFields a] -> Mod OptionFields a
forall a. Monoid a => [a] -> a
mconcat
      [ Char -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r'
      , String -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"revision"
      , String -> Mod OptionFields a
forall (f :: * -> *) a. String -> Mod f a
help (String -> Mod OptionFields a) -> String -> Mod OptionFields a
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"Git SHA of revision being deployed, if this argument is not present"
        , String
" it would try to get the value from the configuration file first"
        , String
" before calling git."
        ]
      ]

runCommand :: Settings -> Command -> IO ()
runCommand :: Settings -> Command -> IO ()
runCommand Settings
settings Command
cmd = do
  case Command
cmd of
    Command
CommandPing -> do
      Pong
pong <- Settings -> Rollbar Pong -> IO Pong
forall (m :: * -> *) a. MonadIO m => Settings -> Rollbar a -> m a
runRollbar Settings
settings Rollbar Pong
forall (m :: * -> *). MonadHttp m => m Pong
ping
      Pong -> IO ()
forall a. Show a => a -> IO ()
print Pong
pong
    CommandDeploy (DeployCommandReport Maybe Revision
mrevision) -> do
      DeployId
deployId <- Settings -> Rollbar DeployId -> IO DeployId
forall (m :: * -> *) a. MonadIO m => Settings -> Rollbar a -> m a
runRollbar Settings
settings (Rollbar DeployId -> IO DeployId)
-> Rollbar DeployId -> IO DeployId
forall a b. (a -> b) -> a -> b
$ do
        Revision
revision <- case Maybe Revision
mrevision of
          Maybe Revision
Nothing -> Rollbar Revision
forall (m :: * -> *). (HasSettings m, MonadIO m) => m Revision
getRevision
          Just Revision
revision -> Revision -> Rollbar Revision
forall (m :: * -> *) a. Monad m => a -> m a
return Revision
revision
        Deploy
deploy <- Revision -> Rollbar Deploy
forall (m :: * -> *).
(HasSettings m, MonadIO m) =>
Revision -> m Deploy
mkDeploy Revision
revision
        Deploy -> Rollbar DeployId
forall (m :: * -> *).
(HasSettings m, MonadHttp m) =>
Deploy -> m DeployId
reportDeploy Deploy
deploy

      DeployId -> IO ()
forall a. Show a => a -> IO ()
print DeployId
deployId