{-# 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 =
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
[String]
args <- IO [String]
getArgs
case [String]
args of
[String
"--version"] -> do
IO ()
exitVersion
[String]
_ -> IO ()
forall (f :: * -> *). Applicative f => f ()
pass
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
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 = (IO a -> IO a) -> f (IO a) -> f (IO a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IO ()
initNix IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
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 = IO a -> IO a
forall a. IO a -> IO a
handleFinal (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
handleFatal (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
handleRemainingCpp (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
handleFinal :: IO a -> IO a
handleFinal = (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 ()
forall (m :: * -> *). MonadIO m => String -> 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
handleFatal :: IO a -> IO a
handleFatal = (FatalError -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle \FatalError
e -> do
Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"hci: Unexpected exception: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FatalError -> Text
fatalErrorMessage FatalError
e
IO a
forall a. IO a
exitFailure
handleRemainingCpp :: IO a -> IO a
handleRemainingCpp = (CppException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle \case
C.CppStdException CppExceptionPtr
_ptr ByteString
msg Maybe ByteString
mt -> do
ByteString -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
forall (m :: * -> *). MonadIO m => ByteString -> m ()
putErrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
"hci: Unexpected C++ exception: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString
" of type" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) Maybe ByteString
mt
IO a
forall a. IO a
exitFailure
C.CppHaskellException SomeException
actual -> do
IO a -> IO a
forall a. IO a -> IO a
prettyPrintErrors (SomeException -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
actual)
C.CppNonStdException CppExceptionPtr
_ptr Maybe ByteString
t -> do
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"hci: Unexpected C++ exception of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Maybe ByteString
t
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")
exitVersion :: IO ()
exitVersion :: IO ()
exitVersion = do
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText (Text
"hci " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ver)
IO ()
forall a. IO a
exitSuccess
where
ver :: Text
ver = String -> Text
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 =
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" Mod FlagFields (IO ())
-> Mod FlagFields (IO ()) -> Mod FlagFields (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (IO ())
forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Print evaluation stack traces in full")
commands :: Optparse.Parser (IO ())
commands :: Parser (IO ())
commands =
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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
"version"
(String -> InfoMod (IO ())
forall a. String -> InfoMod a
Optparse.progDesc String
"Print the command name and version")
(IO () -> Parser (IO ())
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IO ()
exitVersion)
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 ()) -> Parser (IO ())
forall (f :: * -> *) a. Functor f => f (IO a) -> f (IO a)
addNix 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
)