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