module Hix.Managed.Cabal.Targets where

import Distribution.Client.Dependency (
  PackagePreference (PackageInstalledPreference, PackageVersionPreference),
  PackageProperty (PackagePropertyVersion),
  PackageSpecifier (NamedPackage),
  )
import Distribution.Solver.Types.InstalledPreference (InstalledPreference (PreferInstalled, PreferOldest))
import Distribution.Version (orEarlierVersion, orLaterVersion)

import Hix.Class.Map (nToWith)
import qualified Hix.Data.PackageName as PackageName
import Hix.Data.PackageName (PackageName)
import Hix.Data.Version (VersionRange)
import Hix.Data.VersionBounds (Bound (BoundLower, BoundUpper), VersionBounds, maybeRange)
import Hix.Managed.Cabal.Data.SolveTarget (SolveTarget (..))
import qualified Hix.Managed.Data.Constraints
import Hix.Managed.Data.Constraints (EnvConstraints, MutationConstraints (MutationConstraints))

reifyBounds :: VersionBounds -> Maybe VersionRange
reifyBounds :: VersionBounds -> Maybe VersionRange
reifyBounds =
  (Bound -> Version -> VersionRange)
-> VersionBounds -> Maybe VersionRange
maybeRange \case
    Bound
BoundLower -> Version -> VersionRange
orLaterVersion
    Bound
BoundUpper -> Version -> VersionRange
orEarlierVersion

solveTarget ::
  PackageName ->
  MutationConstraints ->
  SolveTarget
solveTarget :: PackageName -> MutationConstraints -> SolveTarget
solveTarget PackageName
package MutationConstraints {VersionBounds
mutation :: VersionBounds
mutation :: MutationConstraints -> VersionBounds
mutation, Maybe Bool
oldest :: Maybe Bool
oldest :: MutationConstraints -> Maybe Bool
oldest, Maybe Bool
installed :: Maybe Bool
installed :: MutationConstraints -> Maybe Bool
installed, Maybe VersionRange
prefer :: Maybe VersionRange
prefer :: MutationConstraints -> Maybe VersionRange
prefer, Maybe VersionRange
force :: Maybe VersionRange
force :: MutationConstraints -> Maybe VersionRange
force} =
  SolveTarget {PackageSpecifier UnresolvedSourcePackage
dep :: PackageSpecifier UnresolvedSourcePackage
dep :: PackageSpecifier UnresolvedSourcePackage
dep, [PackagePreference]
prefs :: [PackagePreference]
prefs :: [PackagePreference]
prefs}
  where
    dep :: PackageSpecifier UnresolvedSourcePackage
dep = PackageName
-> [PackageProperty] -> PackageSpecifier UnresolvedSourcePackage
forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage PackageName
cabalName (VersionRange -> PackageProperty
PackagePropertyVersion (VersionRange -> PackageProperty)
-> [VersionRange] -> [PackageProperty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VersionRange]
ranges)

    ranges :: [VersionRange]
ranges = [Maybe VersionRange] -> [VersionRange]
forall a. [Maybe a] -> [a]
catMaybes [VersionBounds -> Maybe VersionRange
reifyBounds VersionBounds
mutation, Maybe VersionRange
Item [Maybe VersionRange]
force]

    prefs :: [PackagePreference]
prefs = [Maybe PackagePreference] -> [PackagePreference]
forall a. [Maybe a] -> [a]
catMaybes [VersionRange -> PackagePreference
prefVersion (VersionRange -> PackagePreference)
-> Maybe VersionRange -> Maybe PackagePreference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe VersionRange
prefer, PackagePreference -> Maybe Bool -> Maybe PackagePreference
forall {a}. a -> Maybe Bool -> Maybe a
flag PackagePreference
prefOldest Maybe Bool
oldest, PackagePreference -> Maybe Bool -> Maybe PackagePreference
forall {a}. a -> Maybe Bool -> Maybe a
flag PackagePreference
prefInstalled Maybe Bool
installed]

    flag :: a -> Maybe Bool -> Maybe a
flag a
v = \case
      Just Bool
True -> a -> Maybe a
forall a. a -> Maybe a
Just a
v
      Maybe Bool
_ -> Maybe a
forall a. Maybe a
Nothing

    prefVersion :: VersionRange -> PackagePreference
prefVersion = PackageName -> VersionRange -> PackagePreference
PackageVersionPreference PackageName
cabalName
    prefOldest :: PackagePreference
prefOldest = PackageName -> InstalledPreference -> PackagePreference
PackageInstalledPreference PackageName
cabalName InstalledPreference
PreferOldest
    prefInstalled :: PackagePreference
prefInstalled = PackageName -> InstalledPreference -> PackagePreference
PackageInstalledPreference PackageName
cabalName InstalledPreference
PreferInstalled

    cabalName :: PackageName
cabalName = PackageName -> PackageName
PackageName.toCabal PackageName
package

solveTargets :: EnvConstraints -> [SolveTarget]
solveTargets :: EnvConstraints -> [SolveTarget]
solveTargets = (PackageName -> MutationConstraints -> SolveTarget)
-> EnvConstraints -> [SolveTarget]
forall map k v sort a.
NMap map k v sort =>
(k -> v -> a) -> map -> [a]
nToWith PackageName -> MutationConstraints -> SolveTarget
solveTarget