module Hix.Managed.Data.ProcessState where

import Control.Lens ((%~))
import Data.Generics.Labels ()
import Distribution.Pretty (Pretty (pretty))
import Distribution.Version (removeLowerBound)
import Text.PrettyPrint (hang, ($+$))

import Hix.Class.Map (nAmend, nMap)
import Hix.Data.VersionBounds (majorRange)
import qualified Hix.Managed.Data.ManagedPackage
import Hix.Managed.Data.ManagedPackage (ManagedPackage (ManagedPackage))
import Hix.Managed.Data.Mutable (MutableBounds)
import Hix.Managed.Data.Packages (Packages)
import qualified Hix.Managed.Data.ProjectContext
import Hix.Managed.Data.ProjectContext (ProjectContext)
import qualified Hix.Managed.Data.ProjectState
import Hix.Managed.Data.ProjectState (ProjectState)

data ProcessState =
  ProcessState {
    ProcessState -> Packages ManagedPackage
packages :: Packages ManagedPackage,
    ProcessState -> ProjectState
state :: ProjectState
  }
  deriving stock (ProcessState -> ProcessState -> Bool
(ProcessState -> ProcessState -> Bool)
-> (ProcessState -> ProcessState -> Bool) -> Eq ProcessState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcessState -> ProcessState -> Bool
== :: ProcessState -> ProcessState -> Bool
$c/= :: ProcessState -> ProcessState -> Bool
/= :: ProcessState -> ProcessState -> Bool
Eq, Int -> ProcessState -> ShowS
[ProcessState] -> ShowS
ProcessState -> String
(Int -> ProcessState -> ShowS)
-> (ProcessState -> String)
-> ([ProcessState] -> ShowS)
-> Show ProcessState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessState -> ShowS
showsPrec :: Int -> ProcessState -> ShowS
$cshow :: ProcessState -> String
show :: ProcessState -> String
$cshowList :: [ProcessState] -> ShowS
showList :: [ProcessState] -> ShowS
Show, (forall x. ProcessState -> Rep ProcessState x)
-> (forall x. Rep ProcessState x -> ProcessState)
-> Generic ProcessState
forall x. Rep ProcessState x -> ProcessState
forall x. ProcessState -> Rep ProcessState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProcessState -> Rep ProcessState x
from :: forall x. ProcessState -> Rep ProcessState x
$cto :: forall x. Rep ProcessState x -> ProcessState
to :: forall x. Rep ProcessState x -> ProcessState
Generic)

instance Pretty ProcessState where
  pretty :: ProcessState -> Doc
pretty ProcessState {Packages ManagedPackage
ProjectState
packages :: ProcessState -> Packages ManagedPackage
state :: ProcessState -> ProjectState
packages :: Packages ManagedPackage
state :: ProjectState
..} =
    Doc -> Int -> Doc -> Doc
hang Doc
"packages:" Int
2 (Packages ManagedPackage -> Doc
forall a. Pretty a => a -> Doc
pretty Packages ManagedPackage
packages) Doc -> Doc -> Doc
$+$ Doc -> Int -> Doc -> Doc
hang Doc
"state:" Int
2 (ProjectState -> Doc
forall a. Pretty a => a -> Doc
pretty ProjectState
state)

-- TODO Check that this is sound.
-- We simply replace the deps in the packages with the updated bounds.
-- These are used only for the installed-package-db, so the solver can propagate bounds from local deps.
-- However, before conversion from ManagedPackageProto, these deps are completely unrelated, and supposed to be used as
-- additional solver bounds.
-- So we have to extract those into a separate bin at that point, and wipe the bounds when constructing ManagedPackage,
-- and then replacing them by the managed bounds if they already exist.
updateManagedPackages :: Packages MutableBounds -> Packages ManagedPackage -> Packages ManagedPackage
updateManagedPackages :: Packages MutableBounds
-> Packages ManagedPackage -> Packages ManagedPackage
updateManagedPackages =
  (MutableBounds -> ManagedPackage -> ManagedPackage)
-> Packages MutableBounds
-> Packages ManagedPackage
-> Packages ManagedPackage
forall map1 map2 k v1 v2 s1 s2.
(NMap map1 k v1 s1, NMap map2 k v2 s2) =>
(v1 -> v2 -> v2) -> map1 -> map2 -> map2
nAmend \ MutableBounds
bounds ManagedPackage {Version
LocalPackage
LocalRanges
MutableRanges
package :: LocalPackage
version :: Version
local :: LocalRanges
mutable :: MutableRanges
mutable :: ManagedPackage -> MutableRanges
local :: ManagedPackage -> LocalRanges
version :: ManagedPackage -> Version
package :: ManagedPackage -> LocalPackage
..} -> ManagedPackage {mutable :: MutableRanges
mutable = (VersionBounds -> VersionRange) -> MutableBounds -> MutableRanges
forall map1 k v1 sort1 map2 v2 sort2.
(NMap map1 k v1 sort1, NMap map2 k v2 sort2) =>
(v1 -> v2) -> map1 -> map2
nMap VersionBounds -> VersionRange
majorRange MutableBounds
bounds, Version
LocalPackage
LocalRanges
package :: LocalPackage
version :: Version
local :: LocalRanges
local :: LocalRanges
version :: Version
package :: LocalPackage
..}

removeLowerBounds :: ManagedPackage -> ManagedPackage
removeLowerBounds :: ManagedPackage -> ManagedPackage
removeLowerBounds =
  #mutable %~ nMap removeLowerBound

-- | We remove lower bounds because they are likely to interfere with LowerInit, but upper bounds are useful.
initProcessState :: ProjectContext -> ProcessState
initProcessState :: ProjectContext -> ProcessState
initProcessState ProjectContext
context =
  ProcessState {
    packages :: Packages ManagedPackage
packages = Packages MutableBounds
-> Packages ManagedPackage -> Packages ManagedPackage
updateManagedPackages ProjectContext
context.state.bounds ((ManagedPackage -> ManagedPackage)
-> Packages ManagedPackage -> Packages ManagedPackage
forall map1 k v1 sort1 map2 v2 sort2.
(NMap map1 k v1 sort1, NMap map2 k v2 sort2) =>
(v1 -> v2) -> map1 -> map2
nMap ManagedPackage -> ManagedPackage
removeLowerBounds ProjectContext
context.packages),
    state :: ProjectState
state = ProjectContext
context.state
  }