module Hix.Managed.Lower.Candidates where

import qualified Data.Set as Set
import qualified Data.Text as Text
import Distribution.Pretty (pretty)
import Distribution.Version (Version)
import Exon (exon)

import Hix.Class.Map ((!!))
import Hix.Data.Error (Error (Client))
import Hix.Data.Monad (M)
import Hix.Data.PackageName (PackageName)
import Hix.Data.Version (Major)
import qualified Hix.Data.VersionBounds
import Hix.Data.VersionBounds (VersionBounds)
import qualified Hix.Log as Log
import qualified Hix.Managed.Data.Lower
import Hix.Managed.Data.Lower (Lower (Lower))
import Hix.Managed.Data.Mutable (MutableDep, MutableVersions, depName)
import qualified Hix.Managed.Data.Mutation
import Hix.Managed.Data.Mutation (DepMutation (DepMutation))
import qualified Hix.Managed.Data.QueryDep
import Hix.Managed.Data.QueryDep (QueryDep)
import Hix.Monad (throwM)
import Hix.Pretty (showP)
import Hix.Version (allMajors, majorParts, majorsBefore, versionsBetween, versionsFrom)

logNoVersions ::
  MutableDep ->
  [Version] ->
  Maybe a ->
  M (Maybe a)
logNoVersions :: forall a. MutableDep -> [Version] -> Maybe a -> M (Maybe a)
logNoVersions MutableDep
package [Version]
allVersions Maybe a
mutation = do
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
mutation) do
    Text -> M ()
Log.debug [exon|Available versions: #{Text.intercalate ", " (show . pretty <$> allVersions)}|]
    Text -> M ()
Log.warn [exon|No suitable version found for '##{package}'.|]
  pure Maybe a
mutation

specifiedLower :: VersionBounds -> Maybe (Int, Int)
specifiedLower :: VersionBounds -> Maybe (Int, Int)
specifiedLower = Version -> Maybe (Int, Int)
majorParts (Version -> Maybe (Int, Int))
-> (VersionBounds -> Maybe Version)
-> VersionBounds
-> Maybe (Int, Int)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (.lower)

specifiedUpper :: VersionBounds -> Maybe (Int, Int)
specifiedUpper :: VersionBounds -> Maybe (Int, Int)
specifiedUpper = Version -> Maybe (Int, Int)
majorParts (Version -> Maybe (Int, Int))
-> (VersionBounds -> Maybe Version)
-> VersionBounds
-> Maybe (Int, Int)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (.upper)

prefix :: Int -> Int -> Text
prefix :: Int -> Int -> Text
prefix Int
s Int
m = [exon|#{show s}.#{show m}|]

candidates ::
  (PackageName -> M [Version]) ->
  QueryDep ->
  Bool ->
  ([Version] -> Maybe (NonEmpty Major)) ->
  M (Maybe (DepMutation Lower))
candidates :: (PackageName -> M [Version])
-> QueryDep
-> Bool
-> ([Version] -> Maybe (NonEmpty Major))
-> M (Maybe (DepMutation Lower))
candidates PackageName -> M [Version]
fetchVersions QueryDep
dep Bool
retract [Version] -> Maybe (NonEmpty Major)
selection = do
  [Version]
allVersions <- PackageName -> M [Version]
fetchVersions (MutableDep -> PackageName
depName MutableDep
package)
  let
    result :: Maybe (DepMutation Lower)
result = do
      NonEmpty Major
majors <- [Version] -> Maybe (NonEmpty Major)
selection ([Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort [Version]
allVersions)
      pure DepMutation {MutableDep
package :: MutableDep
package :: MutableDep
package, Bool
retract :: Bool
retract :: Bool
retract, mutation :: Lower
mutation = Lower {NonEmpty Major
majors :: NonEmpty Major
majors :: NonEmpty Major
majors}}
  MutableDep
-> [Version]
-> Maybe (DepMutation Lower)
-> M (Maybe (DepMutation Lower))
forall a. MutableDep -> [Version] -> Maybe a -> M (Maybe a)
logNoVersions MutableDep
package [Version]
allVersions Maybe (DepMutation Lower)
result
  pure Maybe (DepMutation Lower)
result
  where
    package :: MutableDep
package = QueryDep
dep.package

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

initConfig :: VersionBounds -> InitConfig
initConfig :: VersionBounds -> InitConfig
initConfig VersionBounds
version =
  case VersionBounds -> Maybe (Int, Int)
specifiedUpper VersionBounds
version of
    Just (Int
s, Int
m) -> Int -> Int -> InitConfig
InitBeforeUpper Int
s Int
m
    Maybe (Int, Int)
_ -> InitConfig
InitAll

logInitConfig :: MutableDep -> InitConfig -> M ()
logInitConfig :: MutableDep -> InitConfig -> M ()
logInitConfig MutableDep
package InitConfig
conf =
  Text -> M ()
Log.verbose [exon|Choosing versions for '##{package}' from #{msg conf}.|]
  where
    msg :: InitConfig -> Text
msg = \case
      InitBeforeUpper Int
s Int
m ->
        [exon|all majors before the specified upper bound #{prefix s m}|]
      InitConfig
InitAll ->
        Text
"all majors"

selectionInit :: InitConfig -> [Version] -> Maybe (NonEmpty Major)
selectionInit :: InitConfig -> [Version] -> Maybe (NonEmpty Major)
selectionInit = \case
  InitBeforeUpper Int
s Int
m ->
    [Major] -> Maybe (NonEmpty Major)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Major] -> Maybe (NonEmpty Major))
-> ([Version] -> [Major]) -> [Version] -> Maybe (NonEmpty Major)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Major] -> [Major]
forall a. [a] -> [a]
reverse ([Major] -> [Major])
-> ([Version] -> [Major]) -> [Version] -> [Major]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [Version] -> [Major]
majorsBefore Int
s Int
m
  InitConfig
InitAll ->
    [Major] -> Maybe (NonEmpty Major)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Major] -> Maybe (NonEmpty Major))
-> ([Version] -> [Major]) -> [Version] -> Maybe (NonEmpty Major)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Major] -> [Major]
forall a. [a] -> [a]
reverse ([Major] -> [Major])
-> ([Version] -> [Major]) -> [Version] -> [Major]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Major]
allMajors

candidatesInit ::
  (PackageName -> M [Version]) ->
  Set MutableDep ->
  QueryDep ->
  M (Maybe (DepMutation Lower))
candidatesInit :: (PackageName -> M [Version])
-> Set MutableDep -> QueryDep -> M (Maybe (DepMutation Lower))
candidatesInit PackageName -> M [Version]
fetchVersions Set MutableDep
pre QueryDep
dep
  | MutableDep -> Set MutableDep -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member QueryDep
dep.package Set MutableDep
pre
  = Maybe (DepMutation Lower) -> M (Maybe (DepMutation Lower))
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (DepMutation Lower)
forall a. Maybe a
Nothing
  | Bool
otherwise
  = do
    MutableDep -> InitConfig -> M ()
logInitConfig QueryDep
dep.package InitConfig
conf
    (PackageName -> M [Version])
-> QueryDep
-> Bool
-> ([Version] -> Maybe (NonEmpty Major))
-> M (Maybe (DepMutation Lower))
candidates PackageName -> M [Version]
fetchVersions QueryDep
dep Bool
False (InitConfig -> [Version] -> Maybe (NonEmpty Major)
selectionInit InitConfig
conf)
  where
    conf :: InitConfig
conf = VersionBounds -> InitConfig
initConfig QueryDep
dep.bounds

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

optimizeConfig ::
  Maybe Version ->
  VersionBounds ->
  OptimizeConfig
optimizeConfig :: Maybe Version -> VersionBounds -> OptimizeConfig
optimizeConfig Maybe Version
initial VersionBounds
version =
  case Version -> Maybe (Int, Int)
majorParts (Version -> Maybe (Int, Int)) -> Maybe Version -> Maybe (Int, Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (VersionBounds
version.lower Maybe Version -> Maybe Version -> Maybe Version
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Version
initial) of
    Just (Int
s, Int
m) -> Int -> Int -> OptimizeConfig
OptimizeMajorsBefore Int
s Int
m
    Maybe (Int, Int)
Nothing -> OptimizeConfig
OptimizeNoBound

logOptimizeConfig ::
  MutableDep ->
  OptimizeConfig ->
  M ()
logOptimizeConfig :: MutableDep -> OptimizeConfig -> M ()
logOptimizeConfig MutableDep
package = \case
  OptimizeMajorsBefore Int
s Int
m ->
    Text -> M ()
Log.verbose [exon|Choosing versions for '##{package}' from all majors before #{prefix s m}.|]
  OptimizeConfig
OptimizeNoBound ->
    Error -> M ()
forall a. Error -> M a
throwM (Text -> Error
Client [exon|'##{package}' has no initial lower bound. Please run '.#lower.init' first.|])

selectionOptimize :: OptimizeConfig -> [Version] -> Maybe (NonEmpty Major)
selectionOptimize :: OptimizeConfig -> [Version] -> Maybe (NonEmpty Major)
selectionOptimize = \case
  OptimizeMajorsBefore Int
s Int
m -> do
    [Major] -> Maybe (NonEmpty Major)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Major] -> Maybe (NonEmpty Major))
-> ([Version] -> [Major]) -> [Version] -> Maybe (NonEmpty Major)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Major] -> [Major]
forall a. [a] -> [a]
reverse ([Major] -> [Major])
-> ([Version] -> [Major]) -> [Version] -> [Major]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [Version] -> [Major]
majorsBefore Int
s Int
m
  OptimizeConfig
OptimizeNoBound ->
    Maybe (NonEmpty Major) -> [Version] -> Maybe (NonEmpty Major)
forall a b. a -> b -> a
const Maybe (NonEmpty Major)
forall a. Maybe a
Nothing

candidatesOptimize ::
  (PackageName -> M [Version]) ->
  MutableVersions ->
  QueryDep ->
  M (Maybe (DepMutation Lower))
candidatesOptimize :: (PackageName -> M [Version])
-> MutableVersions -> QueryDep -> M (Maybe (DepMutation Lower))
candidatesOptimize PackageName -> M [Version]
fetchVersions MutableVersions
initial QueryDep
dep = do
  MutableDep -> OptimizeConfig -> M ()
logOptimizeConfig QueryDep
dep.package OptimizeConfig
conf
  (PackageName -> M [Version])
-> QueryDep
-> Bool
-> ([Version] -> Maybe (NonEmpty Major))
-> M (Maybe (DepMutation Lower))
candidates PackageName -> M [Version]
fetchVersions QueryDep
dep Bool
False (OptimizeConfig -> [Version] -> Maybe (NonEmpty Major)
selectionOptimize OptimizeConfig
conf)
  where
    conf :: OptimizeConfig
conf = Maybe Version -> VersionBounds -> OptimizeConfig
optimizeConfig (Maybe (Maybe Version) -> Maybe Version
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (MutableVersions
initial MutableVersions -> MutableDep -> Maybe (Maybe Version)
forall map k v sort l.
(NMap map k v sort, NLookup sort k v l) =>
map -> k -> l
!! QueryDep
dep.package)) QueryDep
dep.bounds

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

stabilizeConfig :: VersionBounds -> Maybe Version -> StabilizeConfig
stabilizeConfig :: VersionBounds -> Maybe Version -> StabilizeConfig
stabilizeConfig VersionBounds
version Maybe Version
initialBound =
  case VersionBounds
version.lower of
    Just Version
v -> Version -> Maybe Version -> StabilizeConfig
StabilizeFromVersion Version
v (Maybe Version
initialBound Maybe Version -> Maybe Version -> Maybe Version
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VersionBounds
version.upper)
    Maybe Version
Nothing | Just Version
v <- Maybe Version
initialBound -> Version -> Maybe Version -> StabilizeConfig
StabilizeFromVersion Version
v (Maybe Version
initialBound Maybe Version -> Maybe Version -> Maybe Version
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VersionBounds
version.upper)
    Maybe Version
Nothing -> InitConfig -> StabilizeConfig
StabilizeNoBound (VersionBounds -> InitConfig
initConfig VersionBounds
version)

logStabilizeConfig :: MutableDep -> StabilizeConfig -> M ()
logStabilizeConfig :: MutableDep -> StabilizeConfig -> M ()
logStabilizeConfig MutableDep
package = \case
  StabilizeFromVersion Version
v Maybe Version
Nothing ->
    Text -> M ()
Log.verbose [exon|Choosing versions for '##{package}' after the current version #{showP v}.|]
  StabilizeFromVersion Version
l (Just Version
u) ->
    Text -> M ()
Log.verbose [exon|Choosing versions for '##{package}' between the current version #{showP l} and the initial version #{showP u}.|]
  StabilizeNoBound InitConfig
conf ->
    MutableDep -> InitConfig -> M ()
logInitConfig MutableDep
package InitConfig
conf

selectionStabilize :: StabilizeConfig -> [Version] -> Maybe (NonEmpty Major)
selectionStabilize :: StabilizeConfig -> [Version] -> Maybe (NonEmpty Major)
selectionStabilize = \case
  StabilizeFromVersion Version
l Maybe Version
Nothing ->
    [Major] -> Maybe (NonEmpty Major)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Major] -> Maybe (NonEmpty Major))
-> ([Version] -> [Major]) -> [Version] -> Maybe (NonEmpty Major)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Version] -> [Major]
versionsFrom Version
l
  StabilizeFromVersion Version
l (Just Version
u) ->
    [Major] -> Maybe (NonEmpty Major)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Major] -> Maybe (NonEmpty Major))
-> ([Version] -> [Major]) -> [Version] -> Maybe (NonEmpty Major)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Version -> [Version] -> [Major]
versionsBetween Version
l Version
u
  StabilizeNoBound InitConfig
conf ->
    InitConfig -> [Version] -> Maybe (NonEmpty Major)
selectionInit InitConfig
conf

candidatesStabilize ::
  (PackageName -> M [Version]) ->
  QueryDep ->
  Maybe Version ->
  M (Maybe (DepMutation Lower))
candidatesStabilize :: (PackageName -> M [Version])
-> QueryDep -> Maybe Version -> M (Maybe (DepMutation Lower))
candidatesStabilize PackageName -> M [Version]
fetchVersions QueryDep
dep Maybe Version
initialBound = do
  MutableDep -> StabilizeConfig -> M ()
logStabilizeConfig QueryDep
dep.package StabilizeConfig
conf
  (PackageName -> M [Version])
-> QueryDep
-> Bool
-> ([Version] -> Maybe (NonEmpty Major))
-> M (Maybe (DepMutation Lower))
candidates PackageName -> M [Version]
fetchVersions QueryDep
dep (StabilizeConfig -> Bool
isRetract StabilizeConfig
conf) (StabilizeConfig -> [Version] -> Maybe (NonEmpty Major)
selectionStabilize StabilizeConfig
conf)
  where
    conf :: StabilizeConfig
conf = VersionBounds -> Maybe Version -> StabilizeConfig
stabilizeConfig QueryDep
dep.bounds Maybe Version
initialBound

    isRetract :: StabilizeConfig -> Bool
isRetract = \case
      StabilizeFromVersion Version
_ Maybe Version
_ -> Bool
True
      StabilizeNoBound InitConfig
_ -> Bool
False