{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module HWM.CLI.Command.Sync (sync) where import HWM.Core.Common (Name) import HWM.Core.Formatting (Color (..), Format (..), chalk) import HWM.Domain.ConfigT (ConfigT) import HWM.Domain.Matrix (BuildEnvironment (..), getBuildEnvironment) import HWM.Integrations.Toolchain.Hie (syncHie) import HWM.Integrations.Toolchain.Package (syncPackages) import HWM.Integrations.Toolchain.Stack (syncStackYaml) import HWM.Runtime.Cache (Registry (..), updateRegistry) import HWM.Runtime.UI (sectionConfig, sectionTableM) import Relude sync :: Maybe Name -> ConfigT () sync :: Maybe Text -> ConfigT () sync Maybe Text tag = do BuildEnvironment env <- Maybe Text -> ConfigT BuildEnvironment forall env (m :: * -> *). (MonadReader env m, Has env Matrix, Has env [WorkspaceGroup], Has env Cache, MonadIO m, MonadError Issue m) => Maybe Text -> m BuildEnvironment getBuildEnvironment Maybe Text tag (Registry -> Registry) -> ConfigT () forall env (m :: * -> *). (MonadReader env m, Has env Cache, MonadIO m) => (Registry -> Registry) -> m () updateRegistry ((Registry -> Registry) -> ConfigT ()) -> (Registry -> Registry) -> ConfigT () forall a b. (a -> b) -> a -> b $ \Registry reg -> Registry reg {currentEnv = buildName env} Int -> Text -> [(Text, ConfigT Text)] -> ConfigT () forall (m :: * -> *). MonadUI m => Int -> Text -> [(Text, m Text)] -> m () sectionTableM Int 0 Text "sync" [ (Text "enviroment", Text -> ConfigT Text forall a. a -> ConfigT a forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> ConfigT Text) -> Text -> ConfigT Text forall a b. (a -> b) -> a -> b $ Color -> Text -> Text chalk Color Cyan (Text -> Text) -> Text -> Text forall a b. (a -> b) -> a -> b $ BuildEnvironment -> Text forall a. Format a => a -> Text format BuildEnvironment env), (Text "resolver", Text -> ConfigT Text forall a. a -> ConfigT a forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> ConfigT Text) -> Text -> ConfigT Text forall a b. (a -> b) -> a -> b $ BuildEnvironment -> Text buildResolver BuildEnvironment env) ] Int -> [(Text, ConfigT Text)] -> ConfigT () forall (m :: * -> *). MonadUI m => Int -> [(Text, m Text)] -> m () sectionConfig Int 0 [ (Text "stack.yaml", ConfigT () syncStackYaml ConfigT () -> Text -> ConfigT Text forall (f :: * -> *) a b. Functor f => f a -> b -> f b $> Color -> Text -> Text chalk Color Green Text "✓"), (Text "hie.yaml", ConfigT () syncHie ConfigT () -> Text -> ConfigT Text forall (f :: * -> *) a b. Functor f => f a -> b -> f b $> Color -> Text -> Text chalk Color Green Text "✓") ] ConfigT () syncPackages