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 -> forall loc. InstSolverPackage -> ResolverPackage loc
PreExisting forall a b. (a -> b) -> a -> b
$
                  InstSolverPackage {
                    instSolverPkgIPI :: InstalledPackageInfo
instSolverPkgIPI = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. PackageIndex a -> UnitId -> Maybe a
SI.lookupUnitId InstalledPackageIndex
iidx UnitId
pi,
                    instSolverPkgLibDeps :: ComponentDeps [SolverId]
instSolverPkgLibDeps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst ComponentDeps ([SolverId], [SolverId])
ds',
                    instSolverPkgExeDeps :: ComponentDeps [SolverId]
instSolverPkgExeDeps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd ComponentDeps ([SolverId], [SolverId])
ds'
                  }
    Right PackageId
pi -> forall loc. SolverPackage loc -> ResolverPackage loc
Configured 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst ComponentDeps ([SolverId], [SolverId])
ds',
                      solverPkgExeDeps :: ComponentDeps [SolverId]
solverPkgExeDeps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd ComponentDeps ([SolverId], [SolverId])
ds'
                    }
      where
        srcpkg :: SourcePackage loc
srcpkg = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"convCP: lookupPackageId failed") forall a b. (a -> b) -> a -> b
$ 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' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. [Either a b] -> ([a], [b])
partitionEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))) = forall a b. a -> Either a b
Left UnitId
pi
convPI PI QPN
pi                     = forall a b. b -> Either a b
Right (forall pkg. Package pkg => pkg -> PackageId
packageId (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id 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 -> 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 forall a. Eq a => a -> a -> Bool
== PackageName
pn' -> forall a b. b -> Either a b
Right (PackageId -> SolverId
PlannedId PackageId
sourceId)
          | Bool
otherwise    -> 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