{-# 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
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 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
        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")

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")

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
"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
      )