module Hix.Managed.ProjectContextProto where import Exon (exon) import Hix.Class.Map (nBy, nKeys, nKeysSet, nMap, nTo, (!!), (!?)) import Hix.Data.EnvName (EnvName) import Hix.Data.Monad (M) import qualified Hix.Data.Options import Hix.Data.Options (ProjectOptions) import Hix.Managed.Data.BuildConfig (BuildConfig) import qualified Hix.Managed.Data.EnvContext import Hix.Managed.Data.EnvContext (EnvContext, EnvDeps) import Hix.Managed.Data.Envs (Envs) import qualified Hix.Managed.Data.ManagedPackage import Hix.Managed.Data.ManagedPackage (ManagedPackage (ManagedPackage)) import Hix.Managed.Data.Mutable (MutableDep, depName) import Hix.Managed.Data.Packages (Deps, Packages) import qualified Hix.Managed.Data.ProjectContext import Hix.Managed.Data.ProjectContext (ProjectContext (ProjectContext)) import qualified Hix.Managed.Data.ProjectContextProto import Hix.Managed.Data.ProjectContextProto (ProjectContextProto) import Hix.Managed.Data.ProjectState (ProjectState) import Hix.Managed.Data.Query (RawQuery (RawQuery)) import Hix.Managed.EnvContext (envContexts) import qualified Hix.Managed.ManagedPackageProto as ManagedPackageProto import qualified Hix.Managed.ProjectStateProto as ProjectStateProto import Hix.Monad (clientError, noteClient) validateQuery :: Packages ManagedPackage -> RawQuery -> M (Maybe (NonEmpty MutableDep)) validateQuery :: Packages ManagedPackage -> RawQuery -> M (Maybe (NonEmpty MutableDep)) validateQuery Packages ManagedPackage packages (RawQuery [PackageName] deps) = [MutableDep] -> Maybe (NonEmpty MutableDep) forall a. [a] -> Maybe (NonEmpty a) nonEmpty ([MutableDep] -> Maybe (NonEmpty MutableDep)) -> M [MutableDep] -> M (Maybe (NonEmpty MutableDep)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (PackageName -> M MutableDep) -> [PackageName] -> M [MutableDep] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> [a] -> f [b] traverse PackageName -> M MutableDep check [PackageName] deps where check :: PackageName -> M MutableDep check PackageName dep | Just MutableDep m <- Deps MutableDep mutables Deps MutableDep -> PackageName -> Maybe MutableDep forall map k v sort l. (NMap map k v sort, NLookup sort k v l) => map -> k -> l !! PackageName dep = MutableDep -> M MutableDep forall a. a -> M a forall (f :: * -> *) a. Applicative f => a -> f a pure MutableDep m | Bool otherwise = Text -> M MutableDep forall a. Text -> M a clientError [exon|'##{dep}' is not a dependency of any package.|] mutables :: Deps MutableDep mutables :: Deps MutableDep mutables = Set MutableDep -> (MutableDep -> PackageName) -> Deps MutableDep forall (t :: * -> *) map k v sort. (Foldable t, NMap map k v sort) => t v -> (v -> k) -> map nBy Set MutableDep mutablesSet MutableDep -> PackageName depName mutablesSet :: Set MutableDep mutablesSet = [Set MutableDep] -> Set MutableDep forall a. Monoid a => [a] -> a mconcat (Packages ManagedPackage -> (LocalPackage -> ManagedPackage -> Set MutableDep) -> [Set MutableDep] forall map k v sort a. NMap map k v sort => map -> (k -> v -> a) -> [a] nTo Packages ManagedPackage packages \ LocalPackage _ ManagedPackage {MutableRanges mutable :: MutableRanges mutable :: ManagedPackage -> MutableRanges mutable} -> MutableRanges -> Set MutableDep forall map k v sort. NMap map k v sort => map -> Set k nKeysSet MutableRanges mutable) noEnvs :: Text noEnvs :: Text noEnvs = [exon|The flake config contains no managed envs. Most likely this means that you ran the CLI directly. Please use one of the flake apps '.#bump', .#lower.init', '.#lower.optimize' or '.#lower.stabilize'.|] unknownEnv :: EnvName -> Text unknownEnv :: EnvName -> Text unknownEnv EnvName name = [exon|You requested to update the env '##{name}', but it is not present in the managed deps config. Maybe this env is not enabled for managed dependencies.|] selectEnvs :: Envs (Either EnvDeps EnvContext) -> [EnvName] -> M (NonEmpty (Either EnvName EnvContext)) selectEnvs :: Envs (Either EnvDeps EnvContext) -> [EnvName] -> M (NonEmpty (Either EnvName EnvContext)) selectEnvs Envs (Either EnvDeps EnvContext) envs [EnvName] specified = (EnvName -> M (Either EnvName EnvContext)) -> NonEmpty EnvName -> M (NonEmpty (Either EnvName EnvContext)) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> NonEmpty a -> f (NonEmpty b) traverse EnvName -> M (Either EnvName EnvContext) valid (NonEmpty EnvName -> M (NonEmpty (Either EnvName EnvContext))) -> M (NonEmpty EnvName) -> M (NonEmpty (Either EnvName EnvContext)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Text -> Maybe (NonEmpty EnvName) -> M (NonEmpty EnvName) forall a. Text -> Maybe a -> M a noteClient Text noEnvs ([EnvName] -> Maybe (NonEmpty EnvName) forall a. [a] -> Maybe (NonEmpty a) nonEmpty [EnvName] specified Maybe (NonEmpty EnvName) -> Maybe (NonEmpty EnvName) -> Maybe (NonEmpty EnvName) forall a. Maybe a -> Maybe a -> Maybe a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> [EnvName] -> Maybe (NonEmpty EnvName) forall a. [a] -> Maybe (NonEmpty a) nonEmpty (Envs (Either EnvDeps EnvContext) -> [EnvName] forall map k v sort. NMap map k v sort => map -> [k] nKeys Envs (Either EnvDeps EnvContext) envs)) where valid :: EnvName -> M (Either EnvName EnvContext) valid EnvName env = Text -> Maybe (Either EnvName EnvContext) -> M (Either EnvName EnvContext) forall a. Text -> Maybe a -> M a noteClient (EnvName -> Text unknownEnv EnvName env) ((EnvDeps -> EnvName) -> Either EnvDeps EnvContext -> Either EnvName EnvContext forall a b c. (a -> b) -> Either a c -> Either b c forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first (EnvName -> EnvDeps -> EnvName forall a b. a -> b -> a const EnvName env) (Either EnvDeps EnvContext -> Either EnvName EnvContext) -> Maybe (Either EnvDeps EnvContext) -> Maybe (Either EnvName EnvContext) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Envs (Either EnvDeps EnvContext) envs Envs (Either EnvDeps EnvContext) -> EnvName -> Maybe (Either EnvDeps EnvContext) forall map k v sort. NMap map k v sort => map -> k -> Maybe v !? EnvName env) projectContext :: BuildConfig -> ProjectState -> Packages ManagedPackage -> NonEmpty (Either EnvName EnvContext) -> ProjectContext projectContext :: BuildConfig -> ProjectState -> Packages ManagedPackage -> NonEmpty (Either EnvName EnvContext) -> ProjectContext projectContext BuildConfig build ProjectState state Packages ManagedPackage packages NonEmpty (Either EnvName EnvContext) envs = ProjectContext { BuildConfig build :: BuildConfig build :: BuildConfig build, ProjectState state :: ProjectState state :: ProjectState state, Packages ManagedPackage packages :: Packages ManagedPackage packages :: Packages ManagedPackage packages, NonEmpty (Either EnvName EnvContext) envs :: NonEmpty (Either EnvName EnvContext) envs :: NonEmpty (Either EnvName EnvContext) envs } validate :: ProjectOptions -> ProjectContextProto -> M ProjectContext validate :: ProjectOptions -> ProjectContextProto -> M ProjectContext validate ProjectOptions opts ProjectContextProto proto = do Maybe (NonEmpty MutableDep) query <- Packages ManagedPackage -> RawQuery -> M (Maybe (NonEmpty MutableDep)) validateQuery Packages ManagedPackage packages ProjectOptions opts.query Envs (Either EnvDeps EnvContext) contexts <- ProjectOptions -> Packages ManagedPackage -> Envs EnvConfig -> Maybe (NonEmpty MutableDep) -> M (Envs (Either EnvDeps EnvContext)) envContexts ProjectOptions opts Packages ManagedPackage packages ProjectContextProto proto.envs Maybe (NonEmpty MutableDep) query let envDeps :: Envs EnvDeps envDeps = (Either EnvDeps EnvContext -> EnvDeps) -> Envs (Either EnvDeps EnvContext) -> Envs EnvDeps forall map1 k v1 sort1 map2 v2 sort2. (NMap map1 k v1 sort1, NMap map2 k v2 sort2) => (v1 -> v2) -> map1 -> map2 nMap ((EnvDeps -> EnvDeps) -> (EnvContext -> EnvDeps) -> Either EnvDeps EnvContext -> EnvDeps forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either EnvDeps -> EnvDeps forall a. a -> a id (.deps)) Envs (Either EnvDeps EnvContext) contexts ProjectState state <- ProjectOptions -> Packages ManagedPackage -> Envs EnvDeps -> ProjectStateProto -> M ProjectState ProjectStateProto.validateProjectState ProjectOptions opts Packages ManagedPackage packages Envs EnvDeps envDeps ProjectContextProto proto.state NonEmpty (Either EnvName EnvContext) envTargets <- Envs (Either EnvDeps EnvContext) -> [EnvName] -> M (NonEmpty (Either EnvName EnvContext)) selectEnvs Envs (Either EnvDeps EnvContext) contexts ProjectOptions opts.envs pure (BuildConfig -> ProjectState -> Packages ManagedPackage -> NonEmpty (Either EnvName EnvContext) -> ProjectContext projectContext ProjectOptions opts.build ProjectState state Packages ManagedPackage packages NonEmpty (Either EnvName EnvContext) envTargets) where packages :: Packages ManagedPackage packages = Packages ManagedPackageProto -> Packages ManagedPackage ManagedPackageProto.validate ProjectContextProto proto.packages