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 (BoundsModification -> BoundsModification -> Bool
(BoundsModification -> BoundsModification -> Bool)
-> (BoundsModification -> BoundsModification -> Bool)
-> Eq BoundsModification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoundsModification -> BoundsModification -> Bool
== :: BoundsModification -> BoundsModification -> Bool
$c/= :: BoundsModification -> BoundsModification -> Bool
/= :: BoundsModification -> BoundsModification -> Bool
Eq, Int -> BoundsModification -> ShowS
[BoundsModification] -> ShowS
BoundsModification -> String
(Int -> BoundsModification -> ShowS)
-> (BoundsModification -> String)
-> ([BoundsModification] -> ShowS)
-> Show BoundsModification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundsModification -> ShowS
showsPrec :: Int -> BoundsModification -> ShowS
$cshow :: BoundsModification -> String
show :: BoundsModification -> String
$cshowList :: [BoundsModification] -> ShowS
showList :: [BoundsModification] -> ShowS
Show, (forall x. BoundsModification -> Rep BoundsModification x)
-> (forall x. Rep BoundsModification x -> BoundsModification)
-> Generic BoundsModification
forall x. Rep BoundsModification x -> BoundsModification
forall x. BoundsModification -> Rep BoundsModification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BoundsModification -> Rep BoundsModification x
from :: forall x. BoundsModification -> Rep BoundsModification x
$cto :: forall x. Rep BoundsModification x -> BoundsModification
to :: forall x. Rep BoundsModification x -> BoundsModification
Generic)

data DepModification =
  DepAdded (Maybe BoundsModification)
  |
  DepUpdated (These Version BoundsModification)
  deriving stock (DepModification -> DepModification -> Bool
(DepModification -> DepModification -> Bool)
-> (DepModification -> DepModification -> Bool)
-> Eq DepModification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepModification -> DepModification -> Bool
== :: DepModification -> DepModification -> Bool
$c/= :: DepModification -> DepModification -> Bool
/= :: DepModification -> DepModification -> Bool
Eq, Int -> DepModification -> ShowS
[DepModification] -> ShowS
DepModification -> String
(Int -> DepModification -> ShowS)
-> (DepModification -> String)
-> ([DepModification] -> ShowS)
-> Show DepModification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepModification -> ShowS
showsPrec :: Int -> DepModification -> ShowS
$cshow :: DepModification -> String
show :: DepModification -> String
$cshowList :: [DepModification] -> ShowS
showList :: [DepModification] -> ShowS
Show, (forall x. DepModification -> Rep DepModification x)
-> (forall x. Rep DepModification x -> DepModification)
-> Generic DepModification
forall x. Rep DepModification x -> DepModification
forall x. DepModification -> Rep DepModification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DepModification -> Rep DepModification x
from :: forall x. DepModification -> Rep DepModification x
$cto :: forall x. Rep DepModification x -> DepModification
to :: forall x. Rep DepModification x -> DepModification
Generic)

data DepResultDetail =
  DepModified DepModification
  |
  DepUnmodified
  deriving stock (DepResultDetail -> DepResultDetail -> Bool
(DepResultDetail -> DepResultDetail -> Bool)
-> (DepResultDetail -> DepResultDetail -> Bool)
-> Eq DepResultDetail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepResultDetail -> DepResultDetail -> Bool
== :: DepResultDetail -> DepResultDetail -> Bool
$c/= :: DepResultDetail -> DepResultDetail -> Bool
/= :: DepResultDetail -> DepResultDetail -> Bool
Eq, Int -> DepResultDetail -> ShowS
[DepResultDetail] -> ShowS
DepResultDetail -> String
(Int -> DepResultDetail -> ShowS)
-> (DepResultDetail -> String)
-> ([DepResultDetail] -> ShowS)
-> Show DepResultDetail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepResultDetail -> ShowS
showsPrec :: Int -> DepResultDetail -> ShowS
$cshow :: DepResultDetail -> String
show :: DepResultDetail -> String
$cshowList :: [DepResultDetail] -> ShowS
showList :: [DepResultDetail] -> ShowS
Show, (forall x. DepResultDetail -> Rep DepResultDetail x)
-> (forall x. Rep DepResultDetail x -> DepResultDetail)
-> Generic DepResultDetail
forall x. Rep DepResultDetail x -> DepResultDetail
forall x. DepResultDetail -> Rep DepResultDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DepResultDetail -> Rep DepResultDetail x
from :: forall x. DepResultDetail -> Rep DepResultDetail x
$cto :: forall x. Rep DepResultDetail x -> DepResultDetail
to :: forall x. Rep DepResultDetail x -> DepResultDetail
Generic)

data DepResult =
  DepResult {
    DepResult -> MutableDep
package :: MutableDep,
    DepResult -> Version
version :: Version,
    DepResult -> VersionBounds
bounds :: VersionBounds,
    DepResult -> DepResultDetail
detail :: DepResultDetail
  }
  deriving stock (DepResult -> DepResult -> Bool
(DepResult -> DepResult -> Bool)
-> (DepResult -> DepResult -> Bool) -> Eq DepResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepResult -> DepResult -> Bool
== :: DepResult -> DepResult -> Bool
$c/= :: DepResult -> DepResult -> Bool
/= :: DepResult -> DepResult -> Bool
Eq, Int -> DepResult -> ShowS
[DepResult] -> ShowS
DepResult -> String
(Int -> DepResult -> ShowS)
-> (DepResult -> String)
-> ([DepResult] -> ShowS)
-> Show DepResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepResult -> ShowS
showsPrec :: Int -> DepResult -> ShowS
$cshow :: DepResult -> String
show :: DepResult -> String
$cshowList :: [DepResult] -> ShowS
showList :: [DepResult] -> ShowS
Show, (forall x. DepResult -> Rep DepResult x)
-> (forall x. Rep DepResult x -> DepResult) -> Generic DepResult
forall x. Rep DepResult x -> DepResult
forall x. DepResult -> Rep DepResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DepResult -> Rep DepResult x
from :: forall x. DepResult -> Rep DepResult x
$cto :: forall x. Rep DepResult x -> DepResult
to :: forall x. Rep DepResult x -> DepResult
Generic)

depResultId :: DepResult -> MutableId
depResultId :: DepResult -> MutableId
depResultId DepResult {MutableDep
$sel:package:DepResult :: DepResult -> MutableDep
package :: MutableDep
package, Version
$sel:version:DepResult :: DepResult -> Version
version :: Version
version} =
  MutableId {$sel:name:MutableId :: MutableDep
name = MutableDep
package, Version
version :: Version
$sel:version:MutableId :: Version
version}

depResult :: MutableDep -> VersionChange -> BoundsChange -> Maybe DepResult
depResult :: MutableDep -> VersionChange -> BoundsChange -> Maybe DepResult
depResult MutableDep
package VersionChange
versionChange BoundsChange
boundsChange = do
  Version
version <- VersionChange -> Maybe Version
reifyVersionChange VersionChange
versionChange
  pure DepResult {
    MutableDep
$sel:package:DepResult :: MutableDep
package :: MutableDep
package,
    Version
$sel:version:DepResult :: Version
version :: Version
version,
    $sel:bounds:DepResult :: VersionBounds
bounds = BoundsChange -> VersionBounds
reifyBoundsChange BoundsChange
boundsChange,
    DepResultDetail
$sel:detail:DepResult :: DepResultDetail
detail :: DepResultDetail
detail
  }
  where
    detail :: DepResultDetail
detail = case VersionChange
versionChange of
      Changed (DiffAdded Version
_) -> DepModification -> DepResultDetail
DepModified (Maybe BoundsModification -> DepModification
DepAdded Maybe BoundsModification
boundsUpdate)
      Changed (DiffChanged Version
original Version
_ ()
_) ->
        DepModification -> DepResultDetail
DepModified (These Version BoundsModification -> DepModification
DepUpdated ((Version -> These Version BoundsModification)
-> (BoundsModification
    -> Version -> These Version BoundsModification)
-> Maybe BoundsModification
-> Version
-> These Version BoundsModification
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Version -> These Version BoundsModification
forall a b. a -> These a b
This ((Version -> BoundsModification -> These Version BoundsModification)
-> BoundsModification
-> Version
-> These Version BoundsModification
forall a b c. (a -> b -> c) -> b -> a -> c
flip Version -> BoundsModification -> These Version BoundsModification
forall a b. a -> b -> These a b
These) Maybe BoundsModification
boundsUpdate Version
original))
      Unchanged Maybe Version
_
        | Just BoundsModification
b <- Maybe BoundsModification
boundsUpdate
        -> DepModification -> DepResultDetail
DepModified (These Version BoundsModification -> DepModification
DepUpdated (BoundsModification -> These Version BoundsModification
forall a b. b -> These a b
That BoundsModification
b))
      VersionChange
_ -> DepResultDetail
DepUnmodified

    boundsUpdate :: Maybe BoundsModification
boundsUpdate = case BoundsChange
boundsChange of
      Changed (DiffChanged VersionBounds
_ VersionBounds
_ (BoundsDiffDetail These (Diff () Version) (Diff () Version)
det)) ->
        These (Maybe Version) (Maybe Version) -> BoundsModification
BoundsModification (These (Maybe Version) (Maybe Version) -> BoundsModification)
-> Maybe (These (Maybe Version) (Maybe Version))
-> Maybe BoundsModification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Maybe Version)
-> Maybe (Maybe Version)
-> Maybe (These (Maybe Version) (Maybe Version))
forall a b. Maybe a -> Maybe b -> Maybe (These a b)
maybeThese (Diff () Version -> Maybe Version
forall d a. Diff d a -> Maybe a
diffOriginal (Diff () Version -> Maybe Version)
-> Maybe (Diff () Version) -> Maybe (Maybe Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> These (Diff () Version) (Diff () Version)
-> Maybe (Diff () Version)
forall a b. These a b -> Maybe a
justHere These (Diff () Version) (Diff () Version)
det) (Diff () Version -> Maybe Version
forall d a. Diff d a -> Maybe a
diffOriginal (Diff () Version -> Maybe Version)
-> Maybe (Diff () Version) -> Maybe (Maybe Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> These (Diff () Version) (Diff () Version)
-> Maybe (Diff () Version)
forall a b. These a b -> Maybe b
justThere These (Diff () Version) (Diff () Version)
det)
      BoundsChange
_ -> Maybe BoundsModification
forall a. Maybe a
Nothing

deps :: EnvResult -> [DepResult]
deps :: EnvResult -> [DepResult]
deps EnvResult {$sel:state:EnvResult :: EnvResult -> Maybe EnvState
state = Maybe EnvState
Nothing} =
  []
deps EnvResult {$sel:state:EnvResult :: EnvResult -> Maybe EnvState
state = Just EnvState
state} =
  [Maybe DepResult] -> [DepResult]
forall a. [Maybe a] -> [a]
catMaybes (MutableDeps (Maybe DepResult) -> [Maybe DepResult]
forall map k v s. NMap map k v s => map -> [v]
nElems MutableDeps (Maybe DepResult)
dv)
  where
    dv :: MutableDeps (Maybe DepResult)
    dv :: MutableDeps (Maybe DepResult)
dv = (MutableDep -> VersionChange -> BoundsChange -> Maybe DepResult)
-> MutableDeps VersionChange
-> MutableDeps BoundsChange
-> MutableDeps (Maybe DepResult)
forall map1 map2 map3 k v1 v2 v3 s1 s2 s3.
(NMap map1 k v1 s1, NMap map2 k v2 s2, NMap map3 k v3 s3) =>
(k -> v1 -> v2 -> v3) -> map1 -> map2 -> map3
nZipWithKey MutableDep -> VersionChange -> BoundsChange -> Maybe DepResult
depResult EnvState
state.versions EnvState
state.bounds

data DepResults =
  DepResults {
    DepResults -> [DepResult]
added :: [DepResult],
    DepResults -> [DepResult]
updated :: [DepResult],
    DepResults -> [DepResult]
unmodified :: [DepResult]
  }
  deriving stock (DepResults -> DepResults -> Bool
(DepResults -> DepResults -> Bool)
-> (DepResults -> DepResults -> Bool) -> Eq DepResults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepResults -> DepResults -> Bool
== :: DepResults -> DepResults -> Bool
$c/= :: DepResults -> DepResults -> Bool
/= :: DepResults -> DepResults -> Bool
Eq, Int -> DepResults -> ShowS
[DepResults] -> ShowS
DepResults -> String
(Int -> DepResults -> ShowS)
-> (DepResults -> String)
-> ([DepResults] -> ShowS)
-> Show DepResults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepResults -> ShowS
showsPrec :: Int -> DepResults -> ShowS
$cshow :: DepResults -> String
show :: DepResults -> String
$cshowList :: [DepResults] -> ShowS
showList :: [DepResults] -> ShowS
Show, (forall x. DepResults -> Rep DepResults x)
-> (forall x. Rep DepResults x -> DepResults) -> Generic DepResults
forall x. Rep DepResults x -> DepResults
forall x. DepResults -> Rep DepResults x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DepResults -> Rep DepResults x
from :: forall x. DepResults -> Rep DepResults x
$cto :: forall x. Rep DepResults x -> DepResults
to :: forall x. Rep DepResults x -> DepResults
Generic)
  deriving (NonEmpty DepResults -> DepResults
DepResults -> DepResults -> DepResults
(DepResults -> DepResults -> DepResults)
-> (NonEmpty DepResults -> DepResults)
-> (forall b. Integral b => b -> DepResults -> DepResults)
-> Semigroup DepResults
forall b. Integral b => b -> DepResults -> DepResults
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: DepResults -> DepResults -> DepResults
<> :: DepResults -> DepResults -> DepResults
$csconcat :: NonEmpty DepResults -> DepResults
sconcat :: NonEmpty DepResults -> DepResults
$cstimes :: forall b. Integral b => b -> DepResults -> DepResults
stimes :: forall b. Integral b => b -> DepResults -> DepResults
Semigroup, Semigroup DepResults
DepResults
Semigroup DepResults
-> DepResults
-> (DepResults -> DepResults -> DepResults)
-> ([DepResults] -> DepResults)
-> Monoid DepResults
[DepResults] -> DepResults
DepResults -> DepResults -> DepResults
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: DepResults
mempty :: DepResults
$cmappend :: DepResults -> DepResults -> DepResults
mappend :: DepResults -> DepResults -> DepResults
$cmconcat :: [DepResults] -> DepResults
mconcat :: [DepResults] -> DepResults
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
normalizeDepResults DepResults {[DepResult]
$sel:added:DepResults :: DepResults -> [DepResult]
$sel:updated:DepResults :: DepResults -> [DepResult]
$sel:unmodified:DepResults :: DepResults -> [DepResult]
added :: [DepResult]
updated :: [DepResult]
unmodified :: [DepResult]
..} =
  DepResults {$sel:added:DepResults :: [DepResult]
added = [DepResult] -> [DepResult]
normalize [DepResult]
added, $sel:updated:DepResults :: [DepResult]
updated = [DepResult] -> [DepResult]
normalize [DepResult]
updated, $sel:unmodified:DepResults :: [DepResult]
unmodified = [DepResult] -> [DepResult]
normalize [DepResult]
unmodified}
  where
    normalize :: [DepResult] -> [DepResult]
normalize = (DepResult -> MutableDep) -> [DepResult] -> [DepResult]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubSortOn (.package)

grouped :: EnvResult -> DepResults
grouped :: EnvResult -> DepResults
grouped EnvResult
result =
  DepResults -> DepResults
normalizeDepResults DepResults {[DepResult]
$sel:added:DepResults :: [DepResult]
$sel:updated:DepResults :: [DepResult]
$sel:unmodified:DepResults :: [DepResult]
added :: [DepResult]
updated :: [DepResult]
unmodified :: [DepResult]
..}
  where
    ([DepResult]
added, [DepResult]
updated, [DepResult]
unmodified) = (DepResult
 -> ([DepResult], [DepResult], [DepResult])
 -> ([DepResult], [DepResult], [DepResult]))
-> ([DepResult], [DepResult], [DepResult])
-> [DepResult]
-> ([DepResult], [DepResult], [DepResult])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((([DepResult], [DepResult], [DepResult])
 -> DepResult -> ([DepResult], [DepResult], [DepResult]))
-> DepResult
-> ([DepResult], [DepResult], [DepResult])
-> ([DepResult], [DepResult], [DepResult])
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([DepResult], [DepResult], [DepResult])
-> DepResult -> ([DepResult], [DepResult], [DepResult])
forall {a}.
HasField "detail" a DepResultDetail =>
([a], [a], [a]) -> a -> ([a], [a], [a])
step) ([DepResult], [DepResult], [DepResult])
forall a. Monoid a => a
mempty (EnvResult -> [DepResult]
deps EnvResult
result)

    step :: ([a], [a], [a]) -> a -> ([a], [a], [a])
step ([a]
a, [a]
up, [a]
un) a
dep =
      case a
dep.detail of
        DepModified DepAdded {} -> (a
dep a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
a, [a]
up, [a]
un)
        DepModified DepUpdated {} -> ([a]
a, a
dep a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
up, [a]
un)
        DepResultDetail
DepUnmodified -> ([a]
a, [a]
up, a
dep a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
un)

failures :: EnvResult -> [FailedMutation]
failures :: EnvResult -> [FailedMutation]
failures EnvResult {NonEmpty StageSummary
summaries :: NonEmpty StageSummary
$sel:summaries:EnvResult :: EnvResult -> NonEmpty StageSummary
summaries} =
  StageSummary -> [FailedMutation]
stageFailures (StageSummary -> [FailedMutation])
-> [StageSummary] -> [FailedMutation]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NonEmpty StageSummary -> [StageSummary]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty StageSummary
summaries