Commit f785ddec authored by Duncan Coutts's avatar Duncan Coutts

Update for changes to finalizePackageDescription

parent 4081112c
...@@ -64,7 +64,7 @@ import Distribution.Version ...@@ -64,7 +64,7 @@ import Distribution.Version
import Distribution.Simple.Utils as Utils import Distribution.Simple.Utils as Utils
( notice, info, die ) ( notice, info, die )
import Distribution.System import Distribution.System
( Platform(Platform), buildPlatform ) ( Platform, buildPlatform )
import Distribution.Verbosity as Verbosity import Distribution.Verbosity as Verbosity
( Verbosity ) ( Verbosity )
...@@ -191,7 +191,7 @@ configurePackage :: Verbosity ...@@ -191,7 +191,7 @@ configurePackage :: Verbosity
-> ConfiguredPackage -> ConfiguredPackage
-> [String] -> [String]
-> IO () -> IO ()
configurePackage verbosity (Platform arch os) comp scriptOptions configFlags configurePackage verbosity platform comp scriptOptions configFlags
(ConfiguredPackage (AvailablePackage _ gpkg _) flags deps) extraArgs = (ConfiguredPackage (AvailablePackage _ gpkg _) flags deps) extraArgs =
setupWrapper verbosity setupWrapper verbosity
...@@ -205,7 +205,7 @@ configurePackage verbosity (Platform arch os) comp scriptOptions configFlags ...@@ -205,7 +205,7 @@ configurePackage verbosity (Platform arch os) comp scriptOptions configFlags
} }
pkg = case finalizePackageDescription flags pkg = case finalizePackageDescription flags
(Nothing :: Maybe (PackageIndex PackageDescription)) (const True)
os arch comp [] gpkg of platform comp [] gpkg of
Left _ -> error "finalizePackageDescription ConfiguredPackage failed" Left _ -> error "finalizePackageDescription ConfiguredPackage failed"
Right (desc, _) -> desc Right (desc, _) -> desc
...@@ -37,8 +37,6 @@ import Distribution.Simple.Utils ...@@ -37,8 +37,6 @@ import Distribution.Simple.Utils
( comparing ) ( comparing )
import Distribution.Text import Distribution.Text
( display ) ( display )
import Distribution.System
( Platform(Platform) )
import Data.List import Data.List
( maximumBy ) ( maximumBy )
...@@ -52,7 +50,7 @@ import qualified Data.Map as Map ...@@ -52,7 +50,7 @@ import qualified Data.Map as Map
-- We just pretend that everything is installed and hope for the best. -- We just pretend that everything is installed and hope for the best.
-- --
bogusResolver :: DependencyResolver bogusResolver :: DependencyResolver
bogusResolver (Platform arch os) comp _ available bogusResolver platform comp _ available
preferences constraints targets = preferences constraints targets =
resolveFromAvailable [] resolveFromAvailable []
(combineConstraints preferences constraints targets) (combineConstraints preferences constraints targets)
...@@ -62,7 +60,7 @@ bogusResolver (Platform arch os) comp _ available ...@@ -62,7 +60,7 @@ bogusResolver (Platform arch os) comp _ available
case latestAvailableSatisfying available name verConstraint verPref of case latestAvailableSatisfying available name verConstraint verPref of
Nothing -> Fail ("Unresolved dependency: " ++ display dep) Nothing -> Fail ("Unresolved dependency: " ++ display dep)
Just apkg@(AvailablePackage _ pkg _) -> Just apkg@(AvailablePackage _ pkg _) ->
case finalizePackageDescription flags none os arch comp [] pkg of case finalizePackageDescription flags none platform comp [] pkg of
Right (_, flags') -> Step msg (resolveFromAvailable chosen' deps) Right (_, flags') -> Step msg (resolveFromAvailable chosen' deps)
where where
msg = "selecting " ++ display (packageId pkg) msg = "selecting " ++ display (packageId pkg)
...@@ -70,8 +68,8 @@ bogusResolver (Platform arch os) comp _ available ...@@ -70,8 +68,8 @@ bogusResolver (Platform arch os) comp _ available
chosen' = InstallPlan.Configured cpkg : chosen chosen' = InstallPlan.Configured cpkg : chosen
_ -> error "bogusResolver: impossible happened" _ -> error "bogusResolver: impossible happened"
where where
none :: Maybe (PackageIndex PackageIdentifier) none :: Dependency -> Bool
none = Nothing none = const True
where where
dep = Dependency name verConstraint dep = Dependency name verConstraint
......
...@@ -46,7 +46,7 @@ import Distribution.Version ...@@ -46,7 +46,7 @@ import Distribution.Version
import Distribution.Compiler import Distribution.Compiler
( CompilerId ) ( CompilerId )
import Distribution.System import Distribution.System
( Platform(Platform) ) ( Platform )
import Distribution.Simple.Utils import Distribution.Simple.Utils
( equating, comparing ) ( equating, comparing )
import Distribution.Text import Distribution.Text
...@@ -291,18 +291,21 @@ addTopLevelConstraints (PackageInstalledConstraint pkg:deps) cs = ...@@ -291,18 +291,21 @@ addTopLevelConstraints (PackageInstalledConstraint pkg:deps) cs =
Fail (TopLevelInstallConstraintConflict pkg conflicts) Fail (TopLevelInstallConstraintConflict pkg conflicts)
configurePackage :: Platform -> CompilerId -> ConfigurePackage configurePackage :: Platform -> CompilerId -> ConfigurePackage
configurePackage (Platform arch os) comp available spkg = case spkg of configurePackage platform comp available spkg = case spkg of
InstalledOnly ipkg -> Right (InstalledOnly ipkg) InstalledOnly ipkg -> Right (InstalledOnly ipkg)
AvailableOnly apkg -> fmap AvailableOnly (configure apkg) AvailableOnly apkg -> fmap AvailableOnly (configure apkg)
InstalledAndAvailable ipkg apkg -> fmap (InstalledAndAvailable ipkg) InstalledAndAvailable ipkg apkg -> fmap (InstalledAndAvailable ipkg)
(configure apkg) (configure apkg)
where where
configure (UnconfiguredPackage apkg@(AvailablePackage _ p _) _ flags) = configure (UnconfiguredPackage apkg@(AvailablePackage _ p _) _ flags) =
case finalizePackageDescription flags (Just available) os arch comp [] p of case finalizePackageDescription flags dependencySatisfiable
platform comp [] p of
Left missing -> Left missing Left missing -> Left missing
Right (pkg, flags') -> Right $ Right (pkg, flags') -> Right $
SemiConfiguredPackage apkg flags' (buildDepends pkg) SemiConfiguredPackage apkg flags' (buildDepends pkg)
dependencySatisfiable = not . null . PackageIndex.lookupDependency available
-- | Annotate each installed packages with its set of transative dependencies -- | Annotate each installed packages with its set of transative dependencies
-- and its topological sort number. -- and its topological sort number.
-- --
......
...@@ -110,7 +110,7 @@ import Distribution.Simple.Utils as Utils ...@@ -110,7 +110,7 @@ import Distribution.Simple.Utils as Utils
import Distribution.Client.Utils import Distribution.Client.Utils
( inDir, mergeBy, MergeResult(..), withTempDirectory ) ( inDir, mergeBy, MergeResult(..), withTempDirectory )
import Distribution.System import Distribution.System
( Platform(Platform), buildPlatform, OS(Windows), buildOS ) ( Platform, buildPlatform, OS(Windows), buildOS )
import Distribution.Text import Distribution.Text
( display ) ( display )
import Distribution.Verbosity as Verbosity import Distribution.Verbosity as Verbosity
...@@ -584,7 +584,7 @@ installConfiguredPackage :: Platform -> CompilerId ...@@ -584,7 +584,7 @@ installConfiguredPackage :: Platform -> CompilerId
-> (ConfigFlags -> AvailablePackageSource -> (ConfigFlags -> AvailablePackageSource
-> PackageDescription -> a) -> PackageDescription -> a)
-> a -> a
installConfiguredPackage (Platform arch os) comp configFlags installConfiguredPackage platform comp configFlags
(ConfiguredPackage (AvailablePackage _ gpkg source) flags deps) (ConfiguredPackage (AvailablePackage _ gpkg source) flags deps)
installPkg = installPkg configFlags { installPkg = installPkg configFlags {
configConfigurationsFlags = flags, configConfigurationsFlags = flags,
...@@ -592,8 +592,8 @@ installConfiguredPackage (Platform arch os) comp configFlags ...@@ -592,8 +592,8 @@ installConfiguredPackage (Platform arch os) comp configFlags
} source pkg } source pkg
where where
pkg = case finalizePackageDescription flags pkg = case finalizePackageDescription flags
(Nothing :: Maybe (PackageIndex PackageDescription)) (const True)
os arch comp [] gpkg of platform comp [] gpkg of
Left _ -> error "finalizePackageDescription ConfiguredPackage failed" Left _ -> error "finalizePackageDescription ConfiguredPackage failed"
Right (desc, _) -> desc Right (desc, _) -> desc
......
...@@ -65,7 +65,7 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex ...@@ -65,7 +65,7 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Text import Distribution.Text
( display ) ( display )
import Distribution.System import Distribution.System
( Platform(Platform) ) ( Platform )
import Distribution.Compiler import Distribution.Compiler
( CompilerId(..) ) ( CompilerId(..) )
import Distribution.Client.Utils import Distribution.Client.Utils
...@@ -455,7 +455,7 @@ showPackageProblem (InvalidDep dep pkgid) = ...@@ -455,7 +455,7 @@ showPackageProblem (InvalidDep dep pkgid) =
configuredPackageProblems :: Platform -> CompilerId configuredPackageProblems :: Platform -> CompilerId
-> ConfiguredPackage -> [PackageProblem] -> ConfiguredPackage -> [PackageProblem]
configuredPackageProblems (Platform arch os) comp configuredPackageProblems platform comp
(ConfiguredPackage pkg specifiedFlags specifiedDeps) = (ConfiguredPackage pkg specifiedFlags specifiedDeps) =
[ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ] [ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ]
++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ] ++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ]
...@@ -487,7 +487,9 @@ configuredPackageProblems (Platform arch os) comp ...@@ -487,7 +487,9 @@ configuredPackageProblems (Platform arch os) comp
requiredDeps = requiredDeps =
--TODO: use something lower level than finalizePackageDescription --TODO: use something lower level than finalizePackageDescription
case finalizePackageDescription specifiedFlags case finalizePackageDescription specifiedFlags
(Nothing :: Maybe (PackageIndex PackageIdentifier)) os arch comp [] (const True)
platform comp
[]
(packageDescription pkg) of (packageDescription pkg) of
Right (resolvedPkg, _) -> buildDepends resolvedPkg Right (resolvedPkg, _) -> buildDepends resolvedPkg
Left _ -> error "configuredPackageInvalidDeps internal error" Left _ -> error "configuredPackageInvalidDeps internal error"
...@@ -58,9 +58,6 @@ import Distribution.PackageDescription.Configuration ...@@ -58,9 +58,6 @@ import Distribution.PackageDescription.Configuration
import Distribution.Simple.Setup import Distribution.Simple.Setup
( ConfigFlags(..), fromFlag, fromFlagOrDefault, flagToMaybe ) ( ConfigFlags(..), fromFlag, fromFlagOrDefault, flagToMaybe )
import qualified Distribution.Simple.InstallDirs as InstallDirs import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.PackageIndex (PackageIndex)
import Distribution.System
( Platform(Platform) )
import System.Posix.Files import System.Posix.Files
( getSymbolicLinkStatus, isSymbolicLink, createSymbolicLink ( getSymbolicLinkStatus, isSymbolicLink, createSymbolicLink
...@@ -135,8 +132,8 @@ symlinkBinaries configFlags installFlags plan = ...@@ -135,8 +132,8 @@ symlinkBinaries configFlags installFlags plan =
pkgDescription :: ConfiguredPackage -> PackageDescription pkgDescription :: ConfiguredPackage -> PackageDescription
pkgDescription (ConfiguredPackage (AvailablePackage _ pkg _) flags _) = pkgDescription (ConfiguredPackage (AvailablePackage _ pkg _) flags _) =
case finalizePackageDescription flags case finalizePackageDescription flags
(Nothing :: Maybe (PackageIndex PackageDescription)) (const True)
os arch compilerId [] pkg of platform compilerId [] pkg of
Left _ -> error "finalizePackageDescription ConfiguredPackage failed" Left _ -> error "finalizePackageDescription ConfiguredPackage failed"
Right (desc, _) -> desc Right (desc, _) -> desc
...@@ -162,7 +159,7 @@ symlinkBinaries configFlags installFlags plan = ...@@ -162,7 +159,7 @@ symlinkBinaries configFlags installFlags plan =
fromFlagTemplate = fromFlagOrDefault (InstallDirs.toPathTemplate "") fromFlagTemplate = fromFlagOrDefault (InstallDirs.toPathTemplate "")
prefixTemplate = fromFlagTemplate (configProgPrefix configFlags) prefixTemplate = fromFlagTemplate (configProgPrefix configFlags)
suffixTemplate = fromFlagTemplate (configProgSuffix configFlags) suffixTemplate = fromFlagTemplate (configProgSuffix configFlags)
(Platform arch os) = InstallPlan.planPlatform plan platform = InstallPlan.planPlatform plan
compilerId@(CompilerId compilerFlavor _) = InstallPlan.planCompiler plan compilerId@(CompilerId compilerFlavor _) = InstallPlan.planCompiler plan
symlinkBinary :: FilePath -- ^ The canonical path of the public bin dir symlinkBinary :: FilePath -- ^ The canonical path of the public bin dir
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment