{-# LANGUAGE BlockArguments #-}

module Hercules.CLI.Main
  ( main,
  )
where

import Hercules.CLI.Client (prettyPrintHttpErrors)
import qualified Hercules.CLI.Effect as Effect
import qualified Hercules.CLI.Exception as Exception
import qualified Hercules.CLI.Lock as Lock
import qualified Hercules.CLI.Login as Login
import Hercules.CLI.Options (execParser, helper, mkCommand, subparser)
import qualified Hercules.CLI.Secret as Secret
import qualified Hercules.CLI.State as State
import qualified Hercules.CNix.Exception
import Hercules.CNix.Verbosity (setShowTrace)
import qualified Options.Applicative as Optparse
import Protolude

main :: IO ()
main :: IO ()
main =
  IO () -> IO ()
forall a. IO a -> IO a
prettyPrintErrors (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IO () -> IO ()
forall a. IO a -> IO a
Exception.handleUserException (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      IO () -> IO ()
forall a. IO a -> IO a
prettyPrintHttpErrors (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ParserInfo (IO ()) -> IO (IO ())
forall a. ParserInfo a -> IO a
execParser ParserInfo (IO ())
opts

prettyPrintErrors :: IO a -> IO a
prettyPrintErrors :: forall a. IO a -> IO a
prettyPrintErrors = IO a -> IO a
forall a. IO a -> IO a
handleHaskell (IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall a. IO a -> IO a
Hercules.CNix.Exception.handleExceptions
  where
    handleHaskell :: IO a -> IO a
handleHaskell = (SomeException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle \SomeException
e ->
      case SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e :: Maybe ExitCode of
        Just ExitCode
_ -> SomeException -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
e
        Maybe ExitCode
Nothing -> do
          String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"hci: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
e
          IO a
forall a. IO a
exitFailure

opts :: Optparse.ParserInfo (IO ())
opts :: ParserInfo (IO ())
opts =
  Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Optparse.info
    (Parser (IO ())
commands Parser (IO ()) -> Parser (IO () -> IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper)
    (InfoMod (IO ())
forall a. InfoMod a
Optparse.fullDesc InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
Optparse.header String
"Command line interface to Hercules CI")

setCommonOpts :: Optparse.Parser (IO ())
setCommonOpts :: Parser (IO ())
setCommonOpts =
  IO () -> IO () -> Mod FlagFields (IO ()) -> Parser (IO ())
forall a. a -> a -> Mod FlagFields a -> Parser a
Optparse.flag IO ()
forall (f :: * -> *). Applicative f => f ()
pass (Bool -> IO ()
setShowTrace Bool
True) (String -> Mod FlagFields (IO ())
forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"show-trace")

commands :: Optparse.Parser (IO ())
commands :: Parser (IO ())
commands =
  IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    (IO () -> IO () -> IO ())
-> Parser (IO ()) -> Parser (IO () -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (IO ())
setCommonOpts
    Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser
      ( String
-> InfoMod (IO ()) -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
          String
"login"
          (String -> InfoMod (IO ())
forall a. String -> InfoMod a
Optparse.progDesc String
"Configure token for authentication to hercules-ci.com")
          Parser (IO ())
Login.commandParser
          Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> String
-> InfoMod (IO ()) -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
            String
"state"
            (String -> InfoMod (IO ())
forall a. String -> InfoMod a
Optparse.progDesc String
"Perform operations on state files")
            Parser (IO ())
State.commandParser
          Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> String
-> InfoMod (IO ()) -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
            String
"effect"
            (String -> InfoMod (IO ())
forall a. String -> InfoMod a
Optparse.progDesc String
"Run effects locally")
            Parser (IO ())
Effect.commandParser
          Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> String
-> InfoMod (IO ()) -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
            String
"secret"
            (String -> InfoMod (IO ())
forall a. String -> InfoMod a
Optparse.progDesc String
"Manipulate locally stored secrets")
            Parser (IO ())
Secret.commandParser
          Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> String
-> InfoMod (IO ()) -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
            String
"lock"
            (String -> InfoMod (IO ())
forall a. String -> InfoMod a
Optparse.progDesc String
"Opt-in locking for use with state")
            Parser (IO ())
Lock.commandParser
      )