module Hix.Managed.Diff where import Hix.Class.Map (NMap, nAmend, nMap) import Hix.Data.Version (Version) import qualified Hix.Data.VersionBounds import Hix.Data.VersionBounds (anyBounds, VersionBounds) import Hix.Managed.Data.Diff (BoundsChange, BoundsDiffDetail (..), Change (..), Diff (..), VersionChange) import Hix.Managed.Data.Mutable (MutableBounds, MutableDep, MutableDeps, MutableVersions) import Hix.These (maybeThese) diffOriginal :: Diff d a -> Maybe a diffOriginal = \case DiffChanged original _ _ -> Just original _ -> Nothing changeOriginal :: Change d a -> Maybe a changeOriginal = \case Unchanged original -> original Changed d -> diffOriginal d reifyChangeWith :: b -> (a -> b) -> Change d a -> b reifyChangeWith absent f = \case Unchanged Nothing -> absent Unchanged (Just a) -> f a Changed (DiffAdded a) -> f a Changed (DiffChanged _ a _) -> f a reifyChange :: a -> Change d a -> a reifyChange absent = reifyChangeWith absent id reifyChangeMaybe :: Change d a -> Maybe a reifyChangeMaybe = reifyChangeWith Nothing Just reifyBoundsChangeMaybe :: BoundsChange -> Maybe VersionBounds reifyBoundsChangeMaybe = reifyChangeMaybe reifyBoundsChange :: BoundsChange -> VersionBounds reifyBoundsChange = reifyChange anyBounds reifyBoundsChanges :: MutableDeps BoundsChange -> MutableBounds reifyBoundsChanges = nMap reifyBoundsChange reifyVersionChange :: VersionChange -> Maybe Version reifyVersionChange = reifyChangeMaybe reifyVersionChanges :: MutableDeps VersionChange -> MutableVersions reifyVersionChanges = nMap reifyVersionChange applyVersionChange :: VersionChange -> Maybe Version -> Maybe Version applyVersionChange d _ = reifyVersionChange d applyBoundsChange :: BoundsChange -> VersionBounds -> VersionBounds applyBoundsChange d old = fromMaybe old (reifyBoundsChangeMaybe d) diff :: (a -> a -> Maybe d) -> a -> a -> Change d a diff mkDetail original new = case mkDetail original new of Just detail -> Changed (DiffChanged original new detail) Nothing -> Unchanged (Just original) diffMaybe :: (a -> a -> Maybe d) -> Maybe a -> Maybe a -> Change d a diffMaybe mkDetail original new = case (original, new) of (Just o, Just n) -> diff mkDetail o n (Just o, Nothing) -> Unchanged (Just o) (Nothing, Just n) -> Changed (DiffAdded n) (Nothing, Nothing) -> Unchanged Nothing versionDiffDetail :: Version -> Version -> Maybe () versionDiffDetail original new | original == new = Nothing | otherwise = Just () versionChange :: Maybe Version -> Maybe Version -> VersionChange versionChange = diffMaybe versionDiffDetail versionDiff :: Maybe Version -> Maybe Version -> Maybe (Diff () Version) versionDiff original new = case versionChange original new of Changed d -> Just d Unchanged _ -> Nothing boundsDiffDetail :: VersionBounds -> VersionBounds -> Maybe BoundsDiffDetail boundsDiffDetail original new = BoundsDiffDetail <$> maybeThese diffL diffU where diffL = versionDiff original.lower combined.lower diffU = versionDiff original.upper combined.upper combined = new <> original boundsChange :: VersionBounds -> VersionBounds -> BoundsChange boundsChange = diff boundsDiffDetail updateVersionChange :: Version -> VersionChange -> VersionChange updateVersionChange new d = diffMaybe versionDiffDetail (changeOriginal d) (Just new) -- | We never want to remove any bounds, but mutations only return the bound they have targeted, so we need to fall back -- to the original bounds when updating. updateBoundsChange :: VersionBounds -> BoundsChange -> BoundsChange updateBoundsChange new d = diffMaybe boundsDiffDetail original (Just combined) where (original, combined) = case changeOriginal d of Just o -> (Just o, new <> o) Nothing -> (Nothing, new) updateVersionChanges :: NMap vmap MutableDep (Maybe Version) s1 => NMap map MutableDep VersionChange s2 => vmap -> map -> map updateVersionChanges = nAmend (maybe id updateVersionChange) updateBoundsChanges :: NMap vmap MutableDep VersionBounds s1 => NMap map MutableDep BoundsChange s2 => vmap -> map -> map updateBoundsChanges = nAmend updateBoundsChange initChanges :: NMap map1 k (Maybe v1) s1 => NMap map2 k (Change d v1) s2 => map1 -> map2 initChanges = nMap Unchanged