{-# LANGUAGE BlockArguments #-}
module Hercules.CLI.Main
( main,
)
where
import Data.Version (showVersion)
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
import qualified Hercules.CNix.Exception
import qualified Hercules.CNix.Util
import Hercules.CNix.Verbosity (setShowTrace)
import qualified Language.C.Inline.Cpp.Exception as C
import qualified Options.Applicative as Optparse
import Paths_hercules_ci_cli
import Protolude
main :: IO ()
main :: IO ()
main =
forall a. IO a -> IO a
prettyPrintErrors forall a b. (a -> b) -> a -> b
$
forall a. IO a -> IO a
Exception.handleUserException forall a b. (a -> b) -> a -> b
$
forall a. IO a -> IO a
prettyPrintHttpErrors forall a b. (a -> b) -> a -> b
$ do
[String]
args <- IO [String]
getArgs
case [String]
args of
[String
"--version"] -> do
IO ()
exitVersion
[String]
_ -> forall (f :: * -> *). Applicative f => f ()
pass
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a. ParserInfo a -> IO a
execParser ParserInfo (IO ())
opts
initNix :: IO ()
initNix :: IO ()
initNix = do
IO ()
Hercules.CNix.init
IO ()
Hercules.CNix.Util.installDefaultSigINTHandler
addNix :: Functor f => f (IO a) -> f (IO a)
addNix :: forall (f :: * -> *) a. Functor f => f (IO a) -> f (IO a)
addNix = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IO ()
initNix forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>)
prettyPrintErrors :: IO a -> IO a
prettyPrintErrors :: forall a. IO a -> IO a
prettyPrintErrors = forall a. IO a -> IO a
handleFinal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
handleFatal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
handleRemainingCpp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
Hercules.CNix.Exception.handleExceptions
where
handleFinal :: IO a -> IO a
handleFinal = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle \SomeException
e ->
case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e :: Maybe ExitCode of
Just ExitCode
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
e
Maybe ExitCode
Nothing -> do
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putErrLn forall a b. (a -> b) -> a -> b
$ String
"hci: " forall a. Semigroup a => a -> a -> a
<> forall e. Exception e => e -> String
displayException SomeException
e
forall a. IO a
exitFailure
handleFatal :: IO a -> IO a
handleFatal = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle \FatalError
e -> do
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putErrLn forall a b. (a -> b) -> a -> b
$ Text
"hci: Unexpected exception: " forall a. Semigroup a => a -> a -> a
<> FatalError -> Text
fatalErrorMessage FatalError
e
forall a. IO a
exitFailure
handleRemainingCpp :: IO a -> IO a
handleRemainingCpp = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle \case
C.CppStdException CppExceptionPtr
_ptr ByteString
msg Maybe ByteString
mt -> do
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putErrLn forall a b. (a -> b) -> a -> b
$ ByteString
"hci: Unexpected C++ exception: " forall a. Semigroup a => a -> a -> a
<> ByteString
msg forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString
" of type" forall a. Semigroup a => a -> a -> a
<>) Maybe ByteString
mt
forall a. IO a
exitFailure
C.CppHaskellException SomeException
actual -> do
forall a. IO a -> IO a
prettyPrintErrors (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
actual)
C.CppNonStdException CppExceptionPtr
_ptr Maybe ByteString
t -> do
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText forall a b. (a -> b) -> a -> b
$ Text
"hci: Unexpected C++ exception of type " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show Maybe ByteString
t
forall a. IO a
exitFailure
opts :: Optparse.ParserInfo (IO ())
opts :: ParserInfo (IO ())
opts =
forall a. Parser a -> InfoMod a -> ParserInfo a
Optparse.info
(Parser (IO ())
commands forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
(forall a. InfoMod a
Optparse.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
Optparse.header String
"Command line interface to Hercules CI")
exitVersion :: IO ()
exitVersion :: IO ()
exitVersion = do
forall (m :: * -> *). MonadIO m => Text -> m ()
putText (Text
"hci " forall a. Semigroup a => a -> a -> a
<> Text
ver)
forall a. IO a
exitSuccess
where
ver :: Text
ver = forall a b. ConvertText a b => a -> b
toS (Version -> String
showVersion Version
Paths_hercules_ci_cli.version)
setCommonOpts :: Optparse.Parser (IO ())
setCommonOpts :: Parser (IO ())
setCommonOpts =
forall a. a -> a -> Mod FlagFields a -> Parser a
Optparse.flag forall (f :: * -> *). Applicative f => f ()
pass (Bool -> IO ()
setShowTrace Bool
True) (forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"show-trace" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Print evaluation stack traces in full")
commands :: Optparse.Parser (IO ())
commands :: Parser (IO ())
commands =
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (IO ())
setCommonOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Mod CommandFields a -> Parser a
subparser
( forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
String
"login"
(forall a. String -> InfoMod a
Optparse.progDesc String
"Configure token for authentication to hercules-ci.com")
Parser (IO ())
Login.commandParser
forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
String
"state"
(forall a. String -> InfoMod a
Optparse.progDesc String
"Perform operations on state files")
Parser (IO ())
State.commandParser
forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
String
"version"
(forall a. String -> InfoMod a
Optparse.progDesc String
"Print the command name and version")
(forall (f :: * -> *) a. Applicative f => a -> f a
pure IO ()
exitVersion)
forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
String
"effect"
(forall a. String -> InfoMod a
Optparse.progDesc String
"Run effects locally")
(forall (f :: * -> *) a. Functor f => f (IO a) -> f (IO a)
addNix Parser (IO ())
Effect.commandParser)
forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
String
"secret"
(forall a. String -> InfoMod a
Optparse.progDesc String
"Manipulate locally stored secrets")
Parser (IO ())
Secret.commandParser
forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
String
"lock"
(forall a. String -> InfoMod a
Optparse.progDesc String
"Opt-in locking for use with state")
Parser (IO ())
Lock.commandParser
)