module Hix.Managed.EnvResult where import Data.List.Extra (nubSortOn) import Data.These (These (That, These, This)) import Data.These.Combinators (justHere, justThere) import GHC.Generics (Generically (Generically)) import Hix.Class.Map (nElems, nZipWithKey) import Hix.Data.Version (Version) import Hix.Data.VersionBounds (VersionBounds) import Hix.Managed.Data.Diff ( BoundsChange, BoundsDiffDetail (BoundsDiffDetail), Change (Changed, Unchanged), Diff (DiffAdded, DiffChanged), VersionChange, ) import Hix.Managed.Data.EnvResult (EnvResult (..)) import qualified Hix.Managed.Data.EnvState import Hix.Managed.Data.Mutable (MutableDep, MutableDeps) import qualified Hix.Managed.Data.MutableId import Hix.Managed.Data.MutableId (MutableId (MutableId)) import Hix.Managed.Data.Mutation (FailedMutation) import Hix.Managed.Data.StageResult (stageFailures) import Hix.Managed.Diff (diffOriginal, reifyBoundsChange, reifyVersionChange) import Hix.These (maybeThese) newtype BoundsModification = BoundsModification (These (Maybe Version) (Maybe Version)) deriving stock (Eq, Show, Generic) data DepModification = DepAdded (Maybe BoundsModification) | DepUpdated (These Version BoundsModification) deriving stock (Eq, Show, Generic) data DepResultDetail = DepModified DepModification | DepUnmodified deriving stock (Eq, Show, Generic) data DepResult = DepResult { package :: MutableDep, version :: Version, bounds :: VersionBounds, detail :: DepResultDetail } deriving stock (Eq, Show, Generic) depResultId :: DepResult -> MutableId depResultId DepResult {package, version} = MutableId {name = package, version} depResult :: MutableDep -> VersionChange -> BoundsChange -> Maybe DepResult depResult package versionChange boundsChange = do version <- reifyVersionChange versionChange pure DepResult { package, version, bounds = reifyBoundsChange boundsChange, detail } where detail = case versionChange of Changed (DiffAdded _) -> DepModified (DepAdded boundsUpdate) Changed (DiffChanged original _ _) -> DepModified (DepUpdated (maybe This (flip These) boundsUpdate original)) Unchanged _ | Just b <- boundsUpdate -> DepModified (DepUpdated (That b)) _ -> DepUnmodified boundsUpdate = case boundsChange of Changed (DiffChanged _ _ (BoundsDiffDetail det)) -> BoundsModification <$> maybeThese (diffOriginal <$> justHere det) (diffOriginal <$> justThere det) _ -> Nothing deps :: EnvResult -> [DepResult] deps EnvResult {state = Nothing} = [] deps EnvResult {state = Just state} = catMaybes (nElems dv) where dv :: MutableDeps (Maybe DepResult) dv = nZipWithKey depResult state.versions state.bounds data DepResults = DepResults { added :: [DepResult], updated :: [DepResult], unmodified :: [DepResult] } deriving stock (Eq, Show, Generic) deriving (Semigroup, Monoid) via (Generically DepResults) -- TODO When this is used after merging envs for a report, it should probably combine packages from different lists. -- If one env updates a package, we don't want to report it as unmodified because there's another env with the same dep. -- Most likely the output should be env-keyed though, but not sure this is always desirable. normalizeDepResults :: DepResults -> DepResults normalizeDepResults DepResults {..} = DepResults {added = normalize added, updated = normalize updated, unmodified = normalize unmodified} where normalize = nubSortOn (.package) grouped :: EnvResult -> DepResults grouped result = normalizeDepResults DepResults {..} where (added, updated, unmodified) = foldr (flip step) mempty (deps result) step (a, up, un) dep = case dep.detail of DepModified DepAdded {} -> (dep : a, up, un) DepModified DepUpdated {} -> (a, dep : up, un) DepUnmodified -> (a, up, dep : un) failures :: EnvResult -> [FailedMutation] failures EnvResult {summaries} = stageFailures =<< toList summaries