module Hix.Managed.EnvContext where import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Set as Set import Exon (exon) import Hix.Class.Map (nKeysSet, nMapWithKey) import Hix.Data.EnvName (EnvName) import Hix.Data.Monad (M) import qualified Hix.Data.Options import Hix.Data.Options (ProjectOptions) import Hix.Data.PackageName (LocalPackage) import qualified Hix.Managed.Data.EnvConfig import Hix.Managed.Data.EnvConfig (EnvConfig) import qualified Hix.Managed.Data.EnvContext import Hix.Managed.Data.EnvContext (EnvContext (EnvContext), EnvDeps (EnvDeps)) import Hix.Managed.Data.Envs (Envs) import Hix.Managed.Data.ManagedPackage (ManagedPackage) import Hix.Managed.Data.Mutable (MutableDep, mutRelax) import Hix.Managed.Data.Packages (Packages) import qualified Hix.Managed.ManagedPackage as ManagedPackage import Hix.Monad (clientError) import Hix.Pretty (showPL) unknownTargets :: EnvName -> NonEmpty LocalPackage -> M () unknownTargets :: EnvName -> NonEmpty LocalPackage -> M () unknownTargets EnvName env NonEmpty LocalPackage missing = Text -> M () forall a. Text -> M a clientError Text msg where msg :: Text msg = [exon|The flake config for '##{env}' references #{number} in its targets that #{verb} present|] Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> [exon| in the configuration: #{showPL (toList missing)}|] (Text number, Text verb) | [Item (NonEmpty LocalPackage) _] <- NonEmpty LocalPackage missing = (Text "a package", Text "isn't") | Bool otherwise = (Text "several packages", Text "aren't") envContext :: ProjectOptions -> Packages ManagedPackage -> Maybe (NonEmpty MutableDep) -> EnvName -> EnvConfig -> Either EnvDeps EnvContext envContext :: ProjectOptions -> Packages ManagedPackage -> Maybe (NonEmpty MutableDep) -> EnvName -> EnvConfig -> Either EnvDeps EnvContext envContext ProjectOptions opts Packages ManagedPackage packages Maybe (NonEmpty MutableDep) querySpec EnvName env EnvConfig envConfig = EnvDeps -> Maybe EnvContext -> Either EnvDeps EnvContext forall l r. l -> Maybe r -> Either l r maybeToRight EnvDeps deps (NonEmpty MutableDep -> EnvContext create (NonEmpty MutableDep -> EnvContext) -> Maybe (NonEmpty MutableDep) -> Maybe EnvContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [MutableDep] -> Maybe (NonEmpty MutableDep) forall a. [a] -> Maybe (NonEmpty a) nonEmpty [MutableDep] envQuery) where create :: NonEmpty MutableDep -> EnvContext create NonEmpty MutableDep query = EnvContext {ghc :: GhcDb ghc = EnvConfig envConfig.ghc, NonEmpty MutableDep query :: NonEmpty MutableDep query :: NonEmpty MutableDep query, EnvDeps deps :: EnvDeps deps :: EnvDeps deps, Targets EnvName Ranges env :: EnvName solverBounds :: Ranges targets :: Targets solverBounds :: Ranges targets :: Targets env :: EnvName ..} deps :: EnvDeps deps = EnvDeps {Set LocalPackage local :: Set LocalPackage local :: Set LocalPackage local, Set MutableDep mutable :: Set MutableDep mutable :: Set MutableDep mutable} solverBounds :: Ranges solverBounds | ProjectOptions opts.mergeBounds = MutableRanges -> Ranges forall map1 v s1 map2 s2. (NMap map1 MutableDep v s1, NMap map2 PackageName v s2) => map1 -> map2 mutRelax MutableRanges mutableDeps | Bool otherwise = Ranges forall a. Monoid a => a mempty envQuery :: [MutableDep] envQuery = [MutableDep] -> (NonEmpty MutableDep -> [MutableDep]) -> Maybe (NonEmpty MutableDep) -> [MutableDep] forall b a. b -> (a -> b) -> Maybe a -> b maybe (Set MutableDep -> [MutableDep] forall a. Set a -> [a] forall (t :: * -> *) a. Foldable t => t a -> [a] toList Set MutableDep mutable) ((MutableDep -> Bool) -> NonEmpty MutableDep -> [MutableDep] forall a. (a -> Bool) -> NonEmpty a -> [a] NonEmpty.filter ((MutableDep -> Set MutableDep -> Bool) -> Set MutableDep -> MutableDep -> Bool forall a b c. (a -> b -> c) -> b -> a -> c flip MutableDep -> Set MutableDep -> Bool forall a. Ord a => a -> Set a -> Bool Set.member Set MutableDep mutable)) Maybe (NonEmpty MutableDep) querySpec local :: Set LocalPackage local = LocalRanges -> Set LocalPackage forall map k v sort. NMap map k v sort => map -> Set k nKeysSet LocalRanges localDeps mutable :: Set MutableDep mutable = MutableRanges -> Set MutableDep forall map k v sort. NMap map k v sort => map -> Set k nKeysSet MutableRanges mutableDeps (Targets targets, LocalRanges localDeps, MutableRanges mutableDeps) = Packages ManagedPackage -> [LocalPackage] -> (Targets, LocalRanges, MutableRanges) ManagedPackage.forTargets Packages ManagedPackage packages EnvConfig envConfig.targets envContexts :: ProjectOptions -> Packages ManagedPackage -> Envs EnvConfig -> Maybe (NonEmpty MutableDep) -> M (Envs (Either EnvDeps EnvContext)) envContexts :: ProjectOptions -> Packages ManagedPackage -> Envs EnvConfig -> Maybe (NonEmpty MutableDep) -> M (Envs (Either EnvDeps EnvContext)) envContexts ProjectOptions opts Packages ManagedPackage packages Envs EnvConfig envConfigs Maybe (NonEmpty MutableDep) query = do Envs (Either EnvDeps EnvContext) -> M (Envs (Either EnvDeps EnvContext)) forall a. a -> M a forall (f :: * -> *) a. Applicative f => a -> f a pure ((EnvName -> EnvConfig -> Either EnvDeps EnvContext) -> Envs EnvConfig -> Envs (Either EnvDeps EnvContext) forall map1 k v1 sort1 map2 v2 sort2. (NMap map1 k v1 sort1, NMap map2 k v2 sort2) => (k -> v1 -> v2) -> map1 -> map2 nMapWithKey (ProjectOptions -> Packages ManagedPackage -> Maybe (NonEmpty MutableDep) -> EnvName -> EnvConfig -> Either EnvDeps EnvContext envContext ProjectOptions opts Packages ManagedPackage packages Maybe (NonEmpty MutableDep) query) Envs EnvConfig envConfigs)