module Hix.Managed.Constraints where

import Distribution.Version (thisVersion)

import Hix.Class.Map (nGenWith, nMap, nTransform)
import Hix.Data.Bounds (Ranges)
import Hix.Data.PackageName (PackageName)
import Hix.Data.Version (Version, Versions)
import Hix.Data.VersionBounds (VersionBounds, anyBounds)
import Hix.Managed.Data.Constraints (EnvConstraints, MutationConstraints (..))
import Hix.Managed.Data.Mutable (MutableDep (MutableDep), MutableVersions)

noBounds :: MutationConstraints
noBounds :: MutationConstraints
noBounds = MutationConstraints
forall a. Monoid a => a
mempty {mutation = anyBounds}

forDeps :: (PackageName -> MutationConstraints) -> Set MutableDep -> EnvConstraints
forDeps :: (PackageName -> MutationConstraints)
-> Set MutableDep -> EnvConstraints
forDeps PackageName -> MutationConstraints
f =
  (MutableDep -> (PackageName, MutationConstraints))
-> Set MutableDep -> EnvConstraints
forall (t :: * -> *) map k v sort a.
(Foldable t, NMap map k v sort) =>
(a -> (k, v)) -> t a -> map
nGenWith \ (MutableDep PackageName
package) -> (PackageName
package, PackageName -> MutationConstraints
f PackageName
package)

fromVersions :: (Version -> VersionBounds) -> MutableVersions -> EnvConstraints
fromVersions :: (Version -> VersionBounds) -> MutableVersions -> EnvConstraints
fromVersions Version -> VersionBounds
bound =
  (MutableDep -> Maybe Version -> (PackageName, MutationConstraints))
-> MutableVersions -> EnvConstraints
forall map1 k1 v1 sort1 map2 k2 v2 sort2.
(NMap map1 k1 v1 sort1, NMap map2 k2 v2 sort2) =>
(k1 -> v1 -> (k2, v2)) -> map1 -> map2
nTransform \ (MutableDep PackageName
package) Maybe Version
v -> (PackageName
package, MutationConstraints
forall a. Monoid a => a
mempty {mutation = foldMap bound v})

preferRanges :: Ranges -> EnvConstraints
preferRanges :: Ranges -> EnvConstraints
preferRanges =
  (VersionRange -> MutationConstraints) -> Ranges -> EnvConstraints
forall map1 k v1 sort1 map2 v2 sort2.
(NMap map1 k v1 sort1, NMap map2 k v2 sort2) =>
(v1 -> v2) -> map1 -> map2
nMap \ VersionRange
range -> MutationConstraints
forall a. Monoid a => a
mempty {mutation = mempty, prefer = Just range}

preferVersions :: Versions -> EnvConstraints
preferVersions :: Versions -> EnvConstraints
preferVersions = Ranges -> EnvConstraints
preferRanges (Ranges -> EnvConstraints)
-> (Versions -> Ranges) -> Versions -> EnvConstraints
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> VersionRange) -> Versions -> Ranges
forall map1 k v1 sort1 map2 v2 sort2.
(NMap map1 k v1 sort1, NMap map2 k v2 sort2) =>
(v1 -> v2) -> map1 -> map2
nMap Version -> VersionRange
thisVersion

preferInstalled :: Set MutableDep -> EnvConstraints
preferInstalled :: Set MutableDep -> EnvConstraints
preferInstalled =
  (PackageName -> MutationConstraints)
-> Set MutableDep -> EnvConstraints
forDeps \ PackageName
_ -> MutationConstraints
forall a. Monoid a => a
mempty {mutation = mempty, installed = Just True}

explicitBounds :: Ranges -> EnvConstraints
explicitBounds :: Ranges -> EnvConstraints
explicitBounds =
  (VersionRange -> MutationConstraints) -> Ranges -> EnvConstraints
forall map1 k v1 sort1 map2 v2 sort2.
(NMap map1 k v1 sort1, NMap map2 k v2 sort2) =>
(v1 -> v2) -> map1 -> map2
nMap \ VersionRange
range -> MutationConstraints
forall a. Monoid a => a
mempty {mutation = mempty, force = Just range}