module Hix where import System.Exit (exitFailure) import Hix.Bootstrap (bootstrapProject) import qualified Hix.Console as Console import Hix.Console (errorMessage) import qualified Hix.Data.GlobalOptions import Hix.Data.GlobalOptions (GlobalOptions (GlobalOptions)) import qualified Hix.Data.Options as Options import Hix.Data.Options ( Command (..), LowerCommand (LowerAutoCmd, LowerInitCmd, LowerOptimizeCmd, LowerStabilizeCmd), Options (Options), ) import Hix.Env (printEnvRunner) import Hix.Error ( Error (..), printBootstrapError, printEnvError, printError, printFatalError, printGhciError, printNewError, printPreprocError, ) import Hix.Ghci (printGhciCmdline, printGhcidCmdline) import Hix.Managed.Bump.App (bumpCli) import Hix.Managed.Lower.App (lowerAutoCli, lowerInitCli, lowerOptimizeCli, lowerStabilizeCli) import Hix.Monad (M, runMWith) import Hix.New (newProject) import Hix.Options (parseCli) import Hix.Preproc (preprocess) handleError :: MonadIO m => GlobalOptions -> Error -> m () handleError :: forall (m :: * -> *). MonadIO m => GlobalOptions -> Error -> m () handleError GlobalOptions {Bool verbose :: Bool verbose :: GlobalOptions -> Bool verbose} = \case PreprocError Text err -> Text -> m () forall (m :: * -> *). MonadIO m => Text -> m () printPreprocError Text err EnvError Text err -> Text -> m () forall (m :: * -> *). MonadIO m => Text -> m () printEnvError Text err GhciError Text err -> Text -> m () forall (m :: * -> *). MonadIO m => Text -> m () printGhciError Text err NewError Text err -> Text -> m () forall (m :: * -> *). MonadIO m => Text -> m () printNewError Text err BootstrapError Text err -> Text -> m () forall (m :: * -> *). MonadIO m => Text -> m () printBootstrapError Text err NoMatch Text msg | Bool verbose -> Text -> m () forall (m :: * -> *). MonadIO m => Text -> m () printPreprocError Text msg NoMatch Text _ -> m () forall (f :: * -> *). Applicative f => f () unit Fatal Text err -> Text -> m () forall (m :: * -> *). MonadIO m => Text -> m () printFatalError Text err Client Text err -> Text -> m () forall (m :: * -> *). MonadIO m => Text -> m () Console.err (Text -> Text errorMessage Text err) runCommand :: Command -> M () runCommand :: Command -> M () runCommand = \case Preproc PreprocOptions opts -> PreprocOptions -> M () preprocess PreprocOptions opts EnvRunner EnvRunnerCommandOptions opts -> EnvRunnerOptions -> M () printEnvRunner EnvRunnerCommandOptions opts.options GhcidCmd GhcidOptions opts -> GhcidOptions -> M () printGhcidCmdline GhcidOptions opts GhciCmd GhciOptions opts -> GhciOptions -> M () printGhciCmdline GhciOptions opts NewCmd NewOptions opts -> NewProjectConfig -> M () newProject NewOptions opts.config BootstrapCmd BootstrapOptions opts -> BootstrapProjectConfig -> M () bootstrapProject BootstrapOptions opts.config BumpCmd BumpOptions opts -> BumpOptions -> M () bumpCli BumpOptions opts LowerCmd LowerCommand sub -> case LowerCommand sub of LowerInitCmd LowerOptions opts -> LowerOptions -> M () lowerInitCli LowerOptions opts LowerOptimizeCmd LowerOptions opts -> LowerOptions -> M () lowerOptimizeCli LowerOptions opts LowerStabilizeCmd LowerOptions opts -> LowerOptions -> M () lowerStabilizeCli LowerOptions opts LowerAutoCmd LowerOptions opts -> LowerOptions -> M () lowerAutoCli LowerOptions opts failure :: Bool -> Error -> IO () failure :: Bool -> Error -> IO () failure Bool verbose Error err = do Bool -> Error -> IO () forall (m :: * -> *). MonadIO m => Bool -> Error -> m () printError Bool verbose Error err IO () forall a. IO a exitFailure main :: IO () main :: IO () main = do Options GlobalOptions global Command cmd <- IO Options parseCli (Error -> IO ()) -> Either Error () -> IO () forall (m :: * -> *) a b. Applicative m => (a -> m b) -> Either a b -> m b leftA (Bool -> Error -> IO () failure GlobalOptions global.verbose) (Either Error () -> IO ()) -> IO (Either Error ()) -> IO () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< GlobalOptions -> M () -> IO (Either Error ()) forall a. GlobalOptions -> M a -> IO (Either Error a) runMWith GlobalOptions global (Command -> M () runCommand Command cmd)