module Hix.Managed.ProjectStateProto where

import Data.Map.Merge.Strict (mapMissing, traverseMaybeMissing, traverseMissing, zipWithAMatched, zipWithMatched)
import Exon (exon)

import Hix.Class.Map (NMap, nBy, nElems, nFromKeys, nMap, nMergeA, nTransform)
import Hix.Data.Bounds (Bounds)
import Hix.Data.EnvName (EnvName)
import Hix.Data.Monad (M)
import qualified Hix.Data.Options
import Hix.Data.Options (ProjectOptions)
import Hix.Data.PackageName (LocalPackage, PackageName)
import Hix.Data.Version (Version, VersionRange, Versions)
import Hix.Data.VersionBounds (anyBounds, withUpper)
import qualified Hix.Log as Log
import qualified Hix.Managed.Data.EnvContext
import Hix.Managed.Data.EnvContext (EnvDeps (EnvDeps))
import Hix.Managed.Data.Envs (Envs)
import qualified Hix.Managed.Data.ManagedPackage
import Hix.Managed.Data.ManagedPackage (ManagedPackage (ManagedPackage))
import Hix.Managed.Data.Mutable (MutableBounds, MutableDep, MutableRanges, depName)
import Hix.Managed.Data.Packages (Deps, Packages)
import qualified Hix.Managed.Data.ProjectState
import Hix.Managed.Data.ProjectState (ProjectState (ProjectState))
import qualified Hix.Managed.Data.ProjectStateProto
import Hix.Managed.Data.ProjectStateProto (ProjectStateProto)
import Hix.Version (upperVersion)

invalidDep ::
  ∀ a b .
  LocalPackage ->
  PackageName ->
  a ->
  M (Maybe b)
invalidDep :: forall a b. LocalPackage -> PackageName -> a -> M (Maybe b)
invalidDep LocalPackage
package PackageName
dep a
_ =
  Maybe b
forall a. Maybe a
Nothing Maybe b -> M () -> M (Maybe b)
forall a b. a -> M b -> M a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> M ()
Log.warn [exon|Discarding bound for invalid dep '##{dep}' of package '##{package}'|]

packageDepsForMerge :: MutableRanges -> Deps (MutableDep, VersionRange)
packageDepsForMerge :: MutableRanges -> Deps (MutableDep, VersionRange)
packageDepsForMerge =
  (MutableDep
 -> VersionRange -> (PackageName, (MutableDep, VersionRange)))
-> MutableRanges -> Deps (MutableDep, VersionRange)
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
name VersionRange
range -> (MutableDep -> PackageName
depName MutableDep
name, (MutableDep
name, VersionRange
range))

envDepsForMerge :: Envs EnvDeps -> Envs (Deps MutableDep)
envDepsForMerge :: Envs EnvDeps -> Envs (Deps MutableDep)
envDepsForMerge =
  (EnvDeps -> Deps MutableDep)
-> Envs EnvDeps -> Envs (Deps MutableDep)
forall map1 k v1 sort1 map2 v2 sort2.
(NMap map1 k v1 sort1, NMap map2 k v2 sort2) =>
(v1 -> v2) -> map1 -> map2
nMap \ EnvDeps {Set MutableDep
mutable :: Set MutableDep
mutable :: EnvDeps -> Set MutableDep
mutable} -> Set MutableDep -> (MutableDep -> PackageName) -> Deps MutableDep
forall (t :: * -> *) map k v sort.
(Foldable t, NMap map k v sort) =>
t v -> (v -> k) -> map
nBy Set MutableDep
mutable MutableDep -> PackageName
depName

toMutable ::
  NMap map MutableDep a sort =>
  Deps (MutableDep, a) ->
  map
toMutable :: forall map a sort.
NMap map MutableDep a sort =>
Deps (MutableDep, a) -> map
toMutable = (PackageName -> (MutableDep, a) -> (MutableDep, a))
-> Deps (MutableDep, a) -> map
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 \ PackageName
_ -> (MutableDep, a) -> (MutableDep, a)
forall a. a -> a
id

validateBounds ::
  Bool ->
  LocalPackage ->
  ManagedPackage ->
  Bounds ->
  M MutableBounds
validateBounds :: Bool -> LocalPackage -> ManagedPackage -> Bounds -> M MutableBounds
validateBounds Bool
readUpper LocalPackage
package ManagedPackage {MutableRanges
mutable :: MutableRanges
mutable :: ManagedPackage -> MutableRanges
mutable} Bounds
bounds =
  Deps (MutableDep, VersionBounds) -> MutableBounds
forall map a sort.
NMap map MutableDep a sort =>
Deps (MutableDep, a) -> map
toMutable (Deps (MutableDep, VersionBounds) -> MutableBounds)
-> M (Deps (MutableDep, VersionBounds)) -> M MutableBounds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing
  M
  PackageName
  (MutableDep, VersionRange)
  (MutableDep, VersionBounds)
-> WhenMissing
     M PackageName VersionBounds (MutableDep, VersionBounds)
-> WhenMatched
     M
     PackageName
     (MutableDep, VersionRange)
     VersionBounds
     (MutableDep, VersionBounds)
-> Deps (MutableDep, VersionRange)
-> Bounds
-> M (Deps (MutableDep, VersionBounds))
forall map1 map2 map3 k v1 v2 v3 s1 s2 s3 (m :: * -> *).
(Applicative m, NMap map1 k v1 s1, NMap map2 k v2 s2,
 NMap map3 k v3 s3) =>
WhenMissing m k v1 v3
-> WhenMissing m k v2 v3
-> WhenMatched m k v1 v2 v3
-> map1
-> map2
-> m map3
nMergeA WhenMissing
  M
  PackageName
  (MutableDep, VersionRange)
  (MutableDep, VersionBounds)
stateMissing WhenMissing M PackageName VersionBounds (MutableDep, VersionBounds)
depMissing WhenMatched
  M
  PackageName
  (MutableDep, VersionRange)
  VersionBounds
  (MutableDep, VersionBounds)
convertBound Deps (MutableDep, VersionRange)
deps Bounds
bounds
  where
    deps :: Deps (MutableDep, VersionRange)
deps = MutableRanges -> Deps (MutableDep, VersionRange)
packageDepsForMerge MutableRanges
mutable

    stateMissing :: WhenMissing
  M
  PackageName
  (MutableDep, VersionRange)
  (MutableDep, VersionBounds)
stateMissing = (PackageName
 -> (MutableDep, VersionRange) -> (MutableDep, VersionBounds))
-> WhenMissing
     M
     PackageName
     (MutableDep, VersionRange)
     (MutableDep, VersionBounds)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing \ PackageName
_ (MutableDep
name, VersionRange
range) -> (MutableDep
name, VersionRange -> VersionBounds -> VersionBounds
handleUpper VersionRange
range VersionBounds
anyBounds)

    depMissing :: WhenMissing M PackageName VersionBounds (MutableDep, VersionBounds)
depMissing = (PackageName
 -> VersionBounds -> M (Maybe (MutableDep, VersionBounds)))
-> WhenMissing
     M PackageName VersionBounds (MutableDep, VersionBounds)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing (LocalPackage
-> PackageName
-> VersionBounds
-> M (Maybe (MutableDep, VersionBounds))
forall a b. LocalPackage -> PackageName -> a -> M (Maybe b)
invalidDep LocalPackage
package)

    convertBound :: WhenMatched
  M
  PackageName
  (MutableDep, VersionRange)
  VersionBounds
  (MutableDep, VersionBounds)
convertBound = (PackageName
 -> (MutableDep, VersionRange)
 -> VersionBounds
 -> (MutableDep, VersionBounds))
-> WhenMatched
     M
     PackageName
     (MutableDep, VersionRange)
     VersionBounds
     (MutableDep, VersionBounds)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched \ PackageName
_ (MutableDep
name, VersionRange
range) VersionBounds
bound -> (MutableDep
name, VersionRange -> VersionBounds -> VersionBounds
handleUpper VersionRange
range VersionBounds
bound)

    handleUpper :: VersionRange -> VersionBounds -> VersionBounds
handleUpper VersionRange
range | Bool
readUpper, Just Version
u <- VersionRange -> Maybe Version
upperVersion VersionRange
range = Version -> VersionBounds -> VersionBounds
withUpper Version
u
                      | Bool
otherwise = VersionBounds -> VersionBounds
forall a. a -> a
id

invalidBoundsPackage :: LocalPackage -> a -> M (Maybe b)
invalidBoundsPackage :: forall a b. LocalPackage -> a -> M (Maybe b)
invalidBoundsPackage LocalPackage
package a
_ =
  Maybe b
forall a. Maybe a
Nothing Maybe b -> M () -> M (Maybe b)
forall a b. a -> M b -> M a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> M ()
Log.warn [exon|Discarding bounds for unknown local package '##{package}'|]

validateProjectBounds ::
  Bool ->
  Packages ManagedPackage ->
  Packages Bounds ->
  M (Packages MutableBounds)
validateProjectBounds :: Bool
-> Packages ManagedPackage
-> Packages Bounds
-> M (Packages MutableBounds)
validateProjectBounds Bool
readUpper =
  WhenMissing M LocalPackage ManagedPackage MutableBounds
-> WhenMissing M LocalPackage Bounds MutableBounds
-> WhenMatched M LocalPackage ManagedPackage Bounds MutableBounds
-> Packages ManagedPackage
-> Packages Bounds
-> M (Packages MutableBounds)
forall map1 map2 map3 k v1 v2 v3 s1 s2 s3 (m :: * -> *).
(Applicative m, NMap map1 k v1 s1, NMap map2 k v2 s2,
 NMap map3 k v3 s3) =>
WhenMissing m k v1 v3
-> WhenMissing m k v2 v3
-> WhenMatched m k v1 v2 v3
-> map1
-> map2
-> m map3
nMergeA WhenMissing M LocalPackage ManagedPackage MutableBounds
boundsMissing ((LocalPackage -> Bounds -> M (Maybe MutableBounds))
-> WhenMissing M LocalPackage Bounds MutableBounds
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing LocalPackage -> Bounds -> M (Maybe MutableBounds)
forall a b. LocalPackage -> a -> M (Maybe b)
invalidBoundsPackage) ((LocalPackage -> ManagedPackage -> Bounds -> M MutableBounds)
-> WhenMatched M LocalPackage ManagedPackage Bounds MutableBounds
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
zipWithAMatched (Bool -> LocalPackage -> ManagedPackage -> Bounds -> M MutableBounds
validateBounds Bool
readUpper))
  where
    boundsMissing :: WhenMissing M LocalPackage ManagedPackage MutableBounds
boundsMissing = (LocalPackage -> ManagedPackage -> M MutableBounds)
-> WhenMissing M LocalPackage ManagedPackage MutableBounds
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing \ LocalPackage
name ManagedPackage
package -> Bool -> LocalPackage -> ManagedPackage -> Bounds -> M MutableBounds
validateBounds Bool
readUpper LocalPackage
name ManagedPackage
package Bounds
forall a. Monoid a => a
mempty

invalidStateDep :: Text -> EnvName -> PackageName -> a -> M (Maybe b)
invalidStateDep :: forall a b. Text -> EnvName -> PackageName -> a -> M (Maybe b)
invalidStateDep Text
desc EnvName
env PackageName
package a
_ =
  Maybe b
forall a. Maybe a
Nothing Maybe b -> M () -> M (Maybe b)
forall a b. a -> M b -> M a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> M ()
Log.warn [exon|Discarding #{desc} for unknown dep '##{package}' of env '##{env}'|]

validateVersions ::
  NMap map MutableDep (Maybe Version) sort =>
  Text ->
  EnvName ->
  Deps MutableDep ->
  Versions ->
  M map
validateVersions :: forall map sort.
NMap map MutableDep (Maybe Version) sort =>
Text -> EnvName -> Deps MutableDep -> Versions -> M map
validateVersions Text
desc EnvName
env Deps MutableDep
deps Versions
bounds =
  Deps (MutableDep, Maybe Version) -> map
forall map a sort.
NMap map MutableDep a sort =>
Deps (MutableDep, a) -> map
toMutable (Deps (MutableDep, Maybe Version) -> map)
-> M (Deps (MutableDep, Maybe Version)) -> M map
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing M PackageName MutableDep (MutableDep, Maybe Version)
-> WhenMissing M PackageName Version (MutableDep, Maybe Version)
-> WhenMatched
     M PackageName MutableDep Version (MutableDep, Maybe Version)
-> Deps MutableDep
-> Versions
-> M (Deps (MutableDep, Maybe Version))
forall map1 map2 map3 k v1 v2 v3 s1 s2 s3 (m :: * -> *).
(Applicative m, NMap map1 k v1 s1, NMap map2 k v2 s2,
 NMap map3 k v3 s3) =>
WhenMissing m k v1 v3
-> WhenMissing m k v2 v3
-> WhenMatched m k v1 v2 v3
-> map1
-> map2
-> m map3
nMergeA WhenMissing M PackageName MutableDep (MutableDep, Maybe Version)
forall {k} {a} {a}. WhenMissing M k a (a, Maybe a)
stateMissing WhenMissing M PackageName Version (MutableDep, Maybe Version)
envMissing WhenMatched
  M PackageName MutableDep Version (MutableDep, Maybe Version)
forall {k} {a} {a}. WhenMatched M k a a (a, Maybe a)
matching Deps MutableDep
deps Versions
bounds
  where
    stateMissing :: WhenMissing M k a (a, Maybe a)
stateMissing = (k -> a -> (a, Maybe a)) -> WhenMissing M k a (a, Maybe a)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing \ k
_ a
dep -> (a
dep, Maybe a
forall a. Maybe a
Nothing)
    envMissing :: WhenMissing M PackageName Version (MutableDep, Maybe Version)
envMissing = (PackageName -> Version -> M (Maybe (MutableDep, Maybe Version)))
-> WhenMissing M PackageName Version (MutableDep, Maybe Version)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing (Text
-> EnvName
-> PackageName
-> Version
-> M (Maybe (MutableDep, Maybe Version))
forall a b. Text -> EnvName -> PackageName -> a -> M (Maybe b)
invalidStateDep Text
desc EnvName
env)
    matching :: WhenMatched M k a a (a, Maybe a)
matching = (k -> a -> a -> (a, Maybe a)) -> WhenMatched M k a a (a, Maybe a)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched \ k
_ a
dep a
version -> (a
dep, a -> Maybe a
forall a. a -> Maybe a
Just a
version)

-- TODO ugly
emptyVersions ::
  NMap map MutableDep (Maybe Version) sort =>
  Deps MutableDep ->
  map
emptyVersions :: forall map sort.
NMap map MutableDep (Maybe Version) sort =>
Deps MutableDep -> map
emptyVersions Deps MutableDep
deps =
  [MutableDep] -> (MutableDep -> Maybe Version) -> map
forall (t :: * -> *) map k v sort.
(Foldable t, NMap map k v sort) =>
t k -> (k -> v) -> map
nFromKeys (Deps MutableDep -> [MutableDep]
forall map k v s. NMap map k v s => map -> [v]
nElems Deps MutableDep
deps) (Maybe Version -> MutableDep -> Maybe Version
forall a b. a -> b -> a
const Maybe Version
forall a. Maybe a
Nothing)

invalidVersions :: Text -> EnvName -> a -> M (Maybe b)
invalidVersions :: forall a b. Text -> EnvName -> a -> M (Maybe b)
invalidVersions Text
desc EnvName
env a
_ =
  Maybe b
forall a. Maybe a
Nothing Maybe b -> M () -> M (Maybe b)
forall a b. a -> M b -> M a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> M ()
Log.warn [exon|Discarding #{desc} for unknown env '##{env}'|]

validateProjectVersions ::
  NMap map MutableDep (Maybe Version) sort =>
  Text ->
  Envs (Deps MutableDep) ->
  Envs Versions ->
  M (Envs map)
validateProjectVersions :: forall map sort.
NMap map MutableDep (Maybe Version) sort =>
Text -> Envs (Deps MutableDep) -> Envs Versions -> M (Envs map)
validateProjectVersions Text
desc =
  WhenMissing M EnvName (Deps MutableDep) map
-> WhenMissing M EnvName Versions map
-> WhenMatched M EnvName (Deps MutableDep) Versions map
-> Envs (Deps MutableDep)
-> Envs Versions
-> M (Envs map)
forall map1 map2 map3 k v1 v2 v3 s1 s2 s3 (m :: * -> *).
(Applicative m, NMap map1 k v1 s1, NMap map2 k v2 s2,
 NMap map3 k v3 s3) =>
WhenMissing m k v1 v3
-> WhenMissing m k v2 v3
-> WhenMatched m k v1 v2 v3
-> map1
-> map2
-> m map3
nMergeA WhenMissing M EnvName (Deps MutableDep) map
forall {k}. WhenMissing M k (Deps MutableDep) map
stateMissing WhenMissing M EnvName Versions map
envMissing WhenMatched M EnvName (Deps MutableDep) Versions map
matching
  where
    stateMissing :: WhenMissing M k (Deps MutableDep) map
stateMissing = (k -> Deps MutableDep -> map)
-> WhenMissing M k (Deps MutableDep) map
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing ((Deps MutableDep -> map) -> k -> Deps MutableDep -> map
forall a b. a -> b -> a
const Deps MutableDep -> map
forall map sort.
NMap map MutableDep (Maybe Version) sort =>
Deps MutableDep -> map
emptyVersions)
    envMissing :: WhenMissing M EnvName Versions map
envMissing = (EnvName -> Versions -> M (Maybe map))
-> WhenMissing M EnvName Versions map
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing (Text -> EnvName -> Versions -> M (Maybe map)
forall a b. Text -> EnvName -> a -> M (Maybe b)
invalidVersions Text
desc)
    matching :: WhenMatched M EnvName (Deps MutableDep) Versions map
matching = (EnvName -> Deps MutableDep -> Versions -> M map)
-> WhenMatched M EnvName (Deps MutableDep) Versions map
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
zipWithAMatched (Text -> EnvName -> Deps MutableDep -> Versions -> M map
forall map sort.
NMap map MutableDep (Maybe Version) sort =>
Text -> EnvName -> Deps MutableDep -> Versions -> M map
validateVersions Text
desc)

validateProjectState ::
  ProjectOptions ->
  Packages ManagedPackage ->
  Envs EnvDeps ->
  ProjectStateProto ->
  M ProjectState
validateProjectState :: ProjectOptions
-> Packages ManagedPackage
-> Envs EnvDeps
-> ProjectStateProto
-> M ProjectState
validateProjectState ProjectOptions
opts Packages ManagedPackage
packages Envs EnvDeps
envDeps ProjectStateProto
proto = do
  Packages MutableBounds
bounds <- Bool
-> Packages ManagedPackage
-> Packages Bounds
-> M (Packages MutableBounds)
validateProjectBounds ProjectOptions
opts.readUpperBounds Packages ManagedPackage
packages ProjectStateProto
proto.bounds
  Envs MutableVersions
versions <- Text
-> Envs (Deps MutableDep)
-> Envs Versions
-> M (Envs MutableVersions)
forall map sort.
NMap map MutableDep (Maybe Version) sort =>
Text -> Envs (Deps MutableDep) -> Envs Versions -> M (Envs map)
validateProjectVersions Text
"bound versions" Envs (Deps MutableDep)
depSets ProjectStateProto
proto.versions
  Envs MutableVersions
initial <- Text
-> Envs (Deps MutableDep)
-> Envs Versions
-> M (Envs MutableVersions)
forall map sort.
NMap map MutableDep (Maybe Version) sort =>
Text -> Envs (Deps MutableDep) -> Envs Versions -> M (Envs map)
validateProjectVersions Text
"initial versions" Envs (Deps MutableDep)
depSets ProjectStateProto
proto.initial
  pure ProjectState {overrides :: Envs Overrides
overrides = ProjectStateProto
proto.overrides, resolving :: Bool
resolving = Bool
False, Packages MutableBounds
Envs MutableVersions
bounds :: Packages MutableBounds
versions :: Envs MutableVersions
initial :: Envs MutableVersions
initial :: Envs MutableVersions
versions :: Envs MutableVersions
bounds :: Packages MutableBounds
..}
  where
    depSets :: Envs (Deps MutableDep)
depSets = Envs EnvDeps -> Envs (Deps MutableDep)
envDepsForMerge Envs EnvDeps
envDeps