module Distribution.Solver.Modular.ConfiguredConversion
    ( convCP
    ) where

import Data.Maybe
import Prelude hiding (pi)
import Data.Either (partitionEithers)

import Distribution.Package (UnitId, packageId)

import qualified Distribution.Simple.PackageIndex as SI

import Distribution.Solver.Modular.Configured
import Distribution.Solver.Modular.Package

import           Distribution.Solver.Types.ComponentDeps (ComponentDeps)
import qualified Distribution.Solver.Types.PackageIndex as CI
import           Distribution.Solver.Types.PackagePath
import           Distribution.Solver.Types.ResolverPackage
import           Distribution.Solver.Types.SolverId
import           Distribution.Solver.Types.SolverPackage
import           Distribution.Solver.Types.InstSolverPackage
import           Distribution.Solver.Types.SourcePackage

-- | Converts from the solver specific result @CP QPN@ into
-- a 'ResolverPackage', which can then be converted into
-- the install plan.
convCP :: SI.InstalledPackageIndex ->
          CI.PackageIndex (SourcePackage loc) ->
          CP QPN -> ResolverPackage loc
convCP :: forall loc.
InstalledPackageIndex
-> PackageIndex (SourcePackage loc)
-> CP QPN
-> ResolverPackage loc
convCP InstalledPackageIndex
iidx PackageIndex (SourcePackage loc)
sidx (CP PI QPN
qpi FlagAssignment
fa OptionalStanzaSet
es ComponentDeps [PI QPN]
ds) =
  case PI QPN -> Either UnitId PackageId
convPI PI QPN
qpi of
    Left  UnitId
pi -> InstSolverPackage -> ResolverPackage loc
forall loc. InstSolverPackage -> ResolverPackage loc
PreExisting (InstSolverPackage -> ResolverPackage loc)
-> InstSolverPackage -> ResolverPackage loc
forall a b. (a -> b) -> a -> b
$
                  InstSolverPackage {
                    instSolverPkgIPI :: InstalledPackageInfo
instSolverPkgIPI = Maybe InstalledPackageInfo -> InstalledPackageInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe InstalledPackageInfo -> InstalledPackageInfo)
-> Maybe InstalledPackageInfo -> InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex -> UnitId -> Maybe InstalledPackageInfo
forall a. PackageIndex a -> UnitId -> Maybe a
SI.lookupUnitId InstalledPackageIndex
iidx UnitId
pi,
                    instSolverPkgLibDeps :: ComponentDeps [SolverId]
instSolverPkgLibDeps = (([SolverId], [SolverId]) -> [SolverId])
-> ComponentDeps ([SolverId], [SolverId])
-> ComponentDeps [SolverId]
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SolverId], [SolverId]) -> [SolverId]
forall a b. (a, b) -> a
fst ComponentDeps ([SolverId], [SolverId])
ds',
                    instSolverPkgExeDeps :: ComponentDeps [SolverId]
instSolverPkgExeDeps = (([SolverId], [SolverId]) -> [SolverId])
-> ComponentDeps ([SolverId], [SolverId])
-> ComponentDeps [SolverId]
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SolverId], [SolverId]) -> [SolverId]
forall a b. (a, b) -> b
snd ComponentDeps ([SolverId], [SolverId])
ds'
                  }
    Right PackageId
pi -> SolverPackage loc -> ResolverPackage loc
forall loc. SolverPackage loc -> ResolverPackage loc
Configured (SolverPackage loc -> ResolverPackage loc)
-> SolverPackage loc -> ResolverPackage loc
forall a b. (a -> b) -> a -> b
$
                  SolverPackage {
                      solverPkgSource :: SourcePackage loc
solverPkgSource = SourcePackage loc
srcpkg,
                      solverPkgFlags :: FlagAssignment
solverPkgFlags = FlagAssignment
fa,
                      solverPkgStanzas :: OptionalStanzaSet
solverPkgStanzas = OptionalStanzaSet
es,
                      solverPkgLibDeps :: ComponentDeps [SolverId]
solverPkgLibDeps = (([SolverId], [SolverId]) -> [SolverId])
-> ComponentDeps ([SolverId], [SolverId])
-> ComponentDeps [SolverId]
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SolverId], [SolverId]) -> [SolverId]
forall a b. (a, b) -> a
fst ComponentDeps ([SolverId], [SolverId])
ds',
                      solverPkgExeDeps :: ComponentDeps [SolverId]
solverPkgExeDeps = (([SolverId], [SolverId]) -> [SolverId])
-> ComponentDeps ([SolverId], [SolverId])
-> ComponentDeps [SolverId]
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SolverId], [SolverId]) -> [SolverId]
forall a b. (a, b) -> b
snd ComponentDeps ([SolverId], [SolverId])
ds'
                    }
      where
        srcpkg :: SourcePackage loc
srcpkg = SourcePackage loc -> Maybe (SourcePackage loc) -> SourcePackage loc
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> SourcePackage loc
forall a. HasCallStack => [Char] -> a
error [Char]
"convCP: lookupPackageId failed") (Maybe (SourcePackage loc) -> SourcePackage loc)
-> Maybe (SourcePackage loc) -> SourcePackage loc
forall a b. (a -> b) -> a -> b
$ PackageIndex (SourcePackage loc)
-> PackageId -> Maybe (SourcePackage loc)
forall pkg.
Package pkg =>
PackageIndex pkg -> PackageId -> Maybe pkg
CI.lookupPackageId PackageIndex (SourcePackage loc)
sidx PackageId
pi
  where
    ds' :: ComponentDeps ([SolverId] {- lib -}, [SolverId] {- exe -})
    ds' :: ComponentDeps ([SolverId], [SolverId])
ds' = ([PI QPN] -> ([SolverId], [SolverId]))
-> ComponentDeps [PI QPN] -> ComponentDeps ([SolverId], [SolverId])
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Either SolverId SolverId] -> ([SolverId], [SolverId])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either SolverId SolverId] -> ([SolverId], [SolverId]))
-> ([PI QPN] -> [Either SolverId SolverId])
-> [PI QPN]
-> ([SolverId], [SolverId])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PI QPN -> Either SolverId SolverId)
-> [PI QPN] -> [Either SolverId SolverId]
forall a b. (a -> b) -> [a] -> [b]
map PI QPN -> Either SolverId SolverId
convConfId) ComponentDeps [PI QPN]
ds

convPI :: PI QPN -> Either UnitId PackageId
convPI :: PI QPN -> Either UnitId PackageId
convPI (PI QPN
_ (I Ver
_ (Inst UnitId
pi))) = UnitId -> Either UnitId PackageId
forall a b. a -> Either a b
Left UnitId
pi
convPI PI QPN
pi                     = PackageId -> Either UnitId PackageId
forall a b. b -> Either a b
Right (SolverId -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ((SolverId -> SolverId)
-> (SolverId -> SolverId) -> Either SolverId SolverId -> SolverId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SolverId -> SolverId
forall a. a -> a
id SolverId -> SolverId
forall a. a -> a
id (PI QPN -> Either SolverId SolverId
convConfId PI QPN
pi)))

convConfId :: PI QPN -> Either SolverId {- is lib -} SolverId {- is exe -}
convConfId :: PI QPN -> Either SolverId SolverId
convConfId (PI (Q (PackagePath Namespace
_ Qualifier
q) PackageName
pn) (I Ver
v Loc
loc)) =
    case Loc
loc of
        Inst UnitId
pi -> SolverId -> Either SolverId SolverId
forall a b. a -> Either a b
Left (PackageId -> UnitId -> SolverId
PreExistingId PackageId
sourceId UnitId
pi)
        Loc
_otherwise
          | QualExe PackageName
_ PackageName
pn' <- Qualifier
q
          -- NB: the dependencies of the executable are also
          -- qualified.  So the way to tell if this is an executable
          -- dependency is to make sure the qualifier is pointing
          -- at the actual thing.  Fortunately for us, I was
          -- silly and didn't allow arbitrarily nested build-tools
          -- dependencies, so a shallow check works.
          , PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
pn' -> SolverId -> Either SolverId SolverId
forall a b. b -> Either a b
Right (PackageId -> SolverId
PlannedId PackageId
sourceId)
          | Bool
otherwise    -> SolverId -> Either SolverId SolverId
forall a b. a -> Either a b
Left  (PackageId -> SolverId
PlannedId PackageId
sourceId)
  where
    sourceId :: PackageId
sourceId    = PackageName -> Ver -> PackageId
PackageIdentifier PackageName
pn Ver
v