Commit 7e296257 authored by Oleg Grenrus's avatar Oleg Grenrus

Trim end-of-line whitespace

parent 6458e7af
...@@ -16,7 +16,7 @@ import qualified Distribution.Simple.Setup as Setup ...@@ -16,7 +16,7 @@ import qualified Distribution.Simple.Setup as Setup
import Distribution.Simple.Command import Distribution.Simple.Command
import Distribution.Simple.Utils import Distribution.Simple.Utils
( wrapText ) ( wrapText )
import Distribution.Verbosity import Distribution.Verbosity
( Verbosity, normal ) ( Verbosity, normal )
import Control.Exception import Control.Exception
...@@ -50,7 +50,7 @@ wrapperAction command verbosityFlag distPrefFlag = ...@@ -50,7 +50,7 @@ wrapperAction command verbosityFlag distPrefFlag =
-- --
class HasVerbosity a where class HasVerbosity a where
verbosity :: a -> Verbosity verbosity :: a -> Verbosity
instance HasVerbosity (Setup.Flag Verbosity) where instance HasVerbosity (Setup.Flag Verbosity) where
...@@ -140,7 +140,7 @@ newCmd origUi@CommandUI{..} action = [cmd defaultUi, cmd newUi, cmd origUi] ...@@ -140,7 +140,7 @@ newCmd origUi@CommandUI{..} action = [cmd defaultUi, cmd newUi, cmd origUi]
cmd ui = CommandSpec ui (flip commandAddAction action) NormalCommand cmd ui = CommandSpec ui (flip commandAddAction action) NormalCommand
newMsg = T.unpack . T.replace "v2-" "new-" . T.pack newMsg = T.unpack . T.replace "v2-" "new-" . T.pack
newUi = origUi newUi = origUi
{ commandName = newMsg commandName { commandName = newMsg commandName
, commandUsage = newMsg . commandUsage , commandUsage = newMsg . commandUsage
, commandDescription = (newMsg .) <$> commandDescription , commandDescription = (newMsg .) <$> commandDescription
...@@ -148,7 +148,7 @@ newCmd origUi@CommandUI{..} action = [cmd defaultUi, cmd newUi, cmd origUi] ...@@ -148,7 +148,7 @@ newCmd origUi@CommandUI{..} action = [cmd defaultUi, cmd newUi, cmd origUi]
} }
defaultMsg = T.unpack . T.replace "v2-" "" . T.pack defaultMsg = T.unpack . T.replace "v2-" "" . T.pack
defaultUi = origUi defaultUi = origUi
{ commandName = defaultMsg commandName { commandName = defaultMsg commandName
, commandUsage = defaultMsg . commandUsage , commandUsage = defaultMsg . commandUsage
, commandDescription = (defaultMsg .) <$> commandDescription , commandDescription = (defaultMsg .) <$> commandDescription
......
...@@ -31,7 +31,7 @@ import Distribution.Client.ProjectConfig ...@@ -31,7 +31,7 @@ import Distribution.Client.ProjectConfig
( ProjectConfig(..), withProjectOrGlobalConfigIgn ( ProjectConfig(..), withProjectOrGlobalConfigIgn
, projectConfigConfigFile ) , projectConfigConfigFile )
import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning import Distribution.Client.ProjectPlanning
( ElaboratedSharedConfig(..), ElaboratedInstallPlan ) ( ElaboratedSharedConfig(..), ElaboratedInstallPlan )
import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ProjectPlanning.Types
( elabOrderExeDependencies ) ( elabOrderExeDependencies )
...@@ -109,7 +109,7 @@ import System.FilePath ...@@ -109,7 +109,7 @@ import System.FilePath
type ReplFlags = [String] type ReplFlags = [String]
data EnvFlags = EnvFlags data EnvFlags = EnvFlags
{ envPackages :: [Dependency] { envPackages :: [Dependency]
, envIncludeTransitive :: Flag Bool , envIncludeTransitive :: Flag Bool
, envIgnoreProject :: Flag Bool , envIgnoreProject :: Flag Bool
...@@ -234,7 +234,7 @@ replAction ( configFlags, configExFlags, installFlags ...@@ -234,7 +234,7 @@ replAction ( configFlags, configExFlags, installFlags
ignoreProject = fromFlagOrDefault False (envIgnoreProject envFlags) ignoreProject = fromFlagOrDefault False (envIgnoreProject envFlags)
with = withProject cliConfig verbosity targetStrings with = withProject cliConfig verbosity targetStrings
without config = withoutProject (config <> cliConfig) verbosity targetStrings without config = withoutProject (config <> cliConfig) verbosity targetStrings
(baseCtx, targetSelectors, finalizer, replType) <- (baseCtx, targetSelectors, finalizer, replType) <-
withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag with without withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag with without
...@@ -252,38 +252,38 @@ replAction ( configFlags, configExFlags, installFlags ...@@ -252,38 +252,38 @@ replAction ( configFlags, configExFlags, installFlags
withInstallPlan (lessVerbose verbosity) baseCtx $ \elaboratedPlan _ -> do withInstallPlan (lessVerbose verbosity) baseCtx $ \elaboratedPlan _ -> do
-- targets should be non-empty map, but there's no NonEmptyMap yet. -- targets should be non-empty map, but there's no NonEmptyMap yet.
targets <- validatedTargets elaboratedPlan targetSelectors targets <- validatedTargets elaboratedPlan targetSelectors
let let
(unitId, _) = fromMaybe (error "panic: targets should be non-empty") $ safeHead $ Map.toList targets (unitId, _) = fromMaybe (error "panic: targets should be non-empty") $ safeHead $ Map.toList targets
originalDeps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan unitId originalDeps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan unitId
oci = OriginalComponentInfo unitId originalDeps oci = OriginalComponentInfo unitId originalDeps
pkgId = fromMaybe (error $ "cannot find " ++ prettyShow unitId) $ packageId <$> InstallPlan.lookup elaboratedPlan unitId pkgId = fromMaybe (error $ "cannot find " ++ prettyShow unitId) $ packageId <$> InstallPlan.lookup elaboratedPlan unitId
baseCtx' = addDepsToProjectTarget (envPackages envFlags) pkgId baseCtx baseCtx' = addDepsToProjectTarget (envPackages envFlags) pkgId baseCtx
return (Just oci, baseCtx') return (Just oci, baseCtx')
-- Now, we run the solver again with the added packages. While the graph -- Now, we run the solver again with the added packages. While the graph
-- won't actually reflect the addition of transitive dependencies, -- won't actually reflect the addition of transitive dependencies,
-- they're going to be available already and will be offered to the REPL -- they're going to be available already and will be offered to the REPL
-- and that's good enough. -- and that's good enough.
-- --
-- In addition, to avoid a *third* trip through the solver, we are -- In addition, to avoid a *third* trip through the solver, we are
-- replicating the second half of 'runProjectPreBuildPhase' by hand -- replicating the second half of 'runProjectPreBuildPhase' by hand
-- here. -- here.
(buildCtx, replFlags'') <- withInstallPlan verbosity baseCtx' $ (buildCtx, replFlags'') <- withInstallPlan verbosity baseCtx' $
\elaboratedPlan elaboratedShared' -> do \elaboratedPlan elaboratedShared' -> do
let ProjectBaseContext{..} = baseCtx' let ProjectBaseContext{..} = baseCtx'
-- Recalculate with updated project. -- Recalculate with updated project.
targets <- validatedTargets elaboratedPlan targetSelectors targets <- validatedTargets elaboratedPlan targetSelectors
let let
elaboratedPlan' = pruneInstallPlanToTargets elaboratedPlan' = pruneInstallPlanToTargets
TargetActionRepl TargetActionRepl
targets targets
elaboratedPlan elaboratedPlan
includeTransitive = fromFlagOrDefault True (envIncludeTransitive envFlags) includeTransitive = fromFlagOrDefault True (envIncludeTransitive envFlags)
pkgsBuildStatus <- rebuildTargetsDryRun distDirLayout elaboratedShared' pkgsBuildStatus <- rebuildTargetsDryRun distDirLayout elaboratedShared'
elaboratedPlan' elaboratedPlan'
...@@ -291,26 +291,26 @@ replAction ( configFlags, configExFlags, installFlags ...@@ -291,26 +291,26 @@ replAction ( configFlags, configExFlags, installFlags
pkgsBuildStatus elaboratedPlan' pkgsBuildStatus elaboratedPlan'
debugNoWrap verbosity (InstallPlan.showInstallPlan elaboratedPlan'') debugNoWrap verbosity (InstallPlan.showInstallPlan elaboratedPlan'')
let let
buildCtx = ProjectBuildContext buildCtx = ProjectBuildContext
{ elaboratedPlanOriginal = elaboratedPlan { elaboratedPlanOriginal = elaboratedPlan
, elaboratedPlanToExecute = elaboratedPlan'' , elaboratedPlanToExecute = elaboratedPlan''
, elaboratedShared = elaboratedShared' , elaboratedShared = elaboratedShared'
, pkgsBuildStatus , pkgsBuildStatus
, targetsMap = targets , targetsMap = targets
} }
ElaboratedSharedConfig { pkgConfigCompiler = compiler } = elaboratedShared' ElaboratedSharedConfig { pkgConfigCompiler = compiler } = elaboratedShared'
-- First version of GHC where GHCi supported the flag we need. -- First version of GHC where GHCi supported the flag we need.
-- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html -- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html
minGhciScriptVersion = mkVersion [7, 6] minGhciScriptVersion = mkVersion [7, 6]
replFlags' = case originalComponent of replFlags' = case originalComponent of
Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci
Nothing -> [] Nothing -> []
replFlags'' = case replType of replFlags'' = case replType of
GlobalRepl scriptPath GlobalRepl scriptPath
| Just version <- compilerCompatVersion GHC compiler | Just version <- compilerCompatVersion GHC compiler
, version >= minGhciScriptVersion -> ("-ghci-script" ++ scriptPath) : replFlags' , version >= minGhciScriptVersion -> ("-ghci-script" ++ scriptPath) : replFlags'
_ -> replFlags' _ -> replFlags'
...@@ -334,7 +334,7 @@ replAction ( configFlags, configExFlags, installFlags ...@@ -334,7 +334,7 @@ replAction ( configFlags, configExFlags, installFlags
mempty -- ClientInstallFlags, not needed here mempty -- ClientInstallFlags, not needed here
haddockFlags testFlags benchmarkFlags haddockFlags testFlags benchmarkFlags
globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
validatedTargets elaboratedPlan targetSelectors = do validatedTargets elaboratedPlan targetSelectors = do
-- Interpret the targets on the command line as repl targets -- Interpret the targets on the command line as repl targets
-- (as opposed to say build or haddock targets). -- (as opposed to say build or haddock targets).
...@@ -363,7 +363,7 @@ data OriginalComponentInfo = OriginalComponentInfo ...@@ -363,7 +363,7 @@ data OriginalComponentInfo = OriginalComponentInfo
deriving (Show) deriving (Show)
-- | Tracks what type of GHCi instance we're creating. -- | Tracks what type of GHCi instance we're creating.
data ReplType = ProjectRepl data ReplType = ProjectRepl
| GlobalRepl FilePath -- ^ The 'FilePath' argument is path to a GHCi | GlobalRepl FilePath -- ^ The 'FilePath' argument is path to a GHCi
-- script responsible for changing to the -- script responsible for changing to the
-- correct directory. Only works on GHC geq -- correct directory. Only works on GHC geq
...@@ -397,7 +397,7 @@ withoutProject config verbosity extraArgs = do ...@@ -397,7 +397,7 @@ withoutProject config verbosity extraArgs = do
, packageSource = LocalUnpackedPackage tempDir , packageSource = LocalUnpackedPackage tempDir
, packageDescrOverride = Nothing , packageDescrOverride = Nothing
} }
genericPackageDescription = emptyGenericPackageDescription genericPackageDescription = emptyGenericPackageDescription
& L.packageDescription .~ packageDescription & L.packageDescription .~ packageDescription
& L.condLibrary .~ Just (CondNode library [baseDep] []) & L.condLibrary .~ Just (CondNode library [baseDep] [])
packageDescription = emptyPackageDescription packageDescription = emptyPackageDescription
...@@ -414,13 +414,13 @@ withoutProject config verbosity extraArgs = do ...@@ -414,13 +414,13 @@ withoutProject config verbosity extraArgs = do
pkgId = fakePackageId pkgId = fakePackageId
writeGenericPackageDescription (tempDir </> "fake-package.cabal") genericPackageDescription writeGenericPackageDescription (tempDir </> "fake-package.cabal") genericPackageDescription
let ghciScriptPath = tempDir </> "setcwd.ghci" let ghciScriptPath = tempDir </> "setcwd.ghci"
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
writeFile ghciScriptPath (":cd " ++ cwd) writeFile ghciScriptPath (":cd " ++ cwd)
distDirLayout <- establishDummyDistDirLayout verbosity config tempDir distDirLayout <- establishDummyDistDirLayout verbosity config tempDir
baseCtx <- baseCtx <-
establishDummyProjectBaseContext establishDummyProjectBaseContext
verbosity verbosity
config config
...@@ -438,7 +438,7 @@ addDepsToProjectTarget :: [Dependency] ...@@ -438,7 +438,7 @@ addDepsToProjectTarget :: [Dependency]
-> PackageId -> PackageId
-> ProjectBaseContext -> ProjectBaseContext
-> ProjectBaseContext -> ProjectBaseContext
addDepsToProjectTarget deps pkgId ctx = addDepsToProjectTarget deps pkgId ctx =
(\p -> ctx { localPackages = p }) . fmap addDeps . localPackages $ ctx (\p -> ctx { localPackages = p }) . fmap addDeps . localPackages $ ctx
where where
addDeps :: PackageSpecifier UnresolvedSourcePackage addDeps :: PackageSpecifier UnresolvedSourcePackage
...@@ -446,7 +446,7 @@ addDepsToProjectTarget deps pkgId ctx = ...@@ -446,7 +446,7 @@ addDepsToProjectTarget deps pkgId ctx =
addDeps (SpecificSourcePackage pkg) addDeps (SpecificSourcePackage pkg)
| packageId pkg /= pkgId = SpecificSourcePackage pkg | packageId pkg /= pkgId = SpecificSourcePackage pkg
| SourcePackage{..} <- pkg = | SourcePackage{..} <- pkg =
SpecificSourcePackage $ pkg { packageDescription = SpecificSourcePackage $ pkg { packageDescription =
packageDescription & (\f -> L.allCondTrees $ traverseCondTreeC f) packageDescription & (\f -> L.allCondTrees $ traverseCondTreeC f)
%~ (deps ++) %~ (deps ++)
} }
...@@ -456,8 +456,8 @@ generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> R ...@@ -456,8 +456,8 @@ generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> R
generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo{..} = flags generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo{..} = flags
where where
exeDeps :: [UnitId] exeDeps :: [UnitId]
exeDeps = exeDeps =
foldMap foldMap
(InstallPlan.foldPlanPackage (const []) elabOrderExeDependencies) (InstallPlan.foldPlanPackage (const []) elabOrderExeDependencies)
(InstallPlan.dependencyClosure elaboratedPlan [ociUnitId]) (InstallPlan.dependencyClosure elaboratedPlan [ociUnitId])
......
...@@ -84,7 +84,7 @@ isFetched loc = case loc of ...@@ -84,7 +84,7 @@ isFetched loc = case loc of
RemoteTarballPackage _uri local -> return (isJust local) RemoteTarballPackage _uri local -> return (isJust local)
RepoTarballPackage repo pkgid _ -> doesFileExist (packageFile repo pkgid) RepoTarballPackage repo pkgid _ -> doesFileExist (packageFile repo pkgid)
RemoteSourceRepoPackage _ local -> return (isJust local) RemoteSourceRepoPackage _ local -> return (isJust local)
-- | Checks if the package has already been fetched (or does not need -- | Checks if the package has already been fetched (or does not need
-- fetching) and if so returns evidence in the form of a 'PackageLocation' -- fetching) and if so returns evidence in the form of a 'PackageLocation'
......
...@@ -2981,9 +2981,9 @@ newtype CannotPruneDependencies = ...@@ -2981,9 +2981,9 @@ newtype CannotPruneDependencies =
-- less than 1.23. -- less than 1.23.
-- --
-- In cases 1 and 2 we obviously have to build an external Setup.hs script, -- In cases 1 and 2 we obviously have to build an external Setup.hs script,
-- while in case 4 we can use the internal library API. -- while in case 4 we can use the internal library API.
-- --
-- TODO:In case 3 we should fail. We don't know how to talk to -- TODO:In case 3 we should fail. We don't know how to talk to
-- newer ./Setup.hs -- newer ./Setup.hs
-- --
-- data SetupScriptStyle = ... -- see ProjectPlanning.Types -- data SetupScriptStyle = ... -- see ProjectPlanning.Types
......
...@@ -87,7 +87,7 @@ import qualified Data.Map.Lazy as Map.Lazy ...@@ -87,7 +87,7 @@ import qualified Data.Map.Lazy as Map.Lazy
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Control.Arrow ((&&&)) import Control.Arrow ((&&&))
import Control.Monad import Control.Monad
hiding ( mfilter ) hiding ( mfilter )
import qualified Distribution.Deprecated.ReadP as Parse import qualified Distribution.Deprecated.ReadP as Parse
import Distribution.Deprecated.ReadP import Distribution.Deprecated.ReadP
......
...@@ -515,7 +515,7 @@ readPackageTarget verbosity = traverse modifyLocation ...@@ -515,7 +515,7 @@ readPackageTarget verbosity = traverse modifyLocation
_ -> False _ -> False
parsePackageDescription' :: BS.ByteString -> Maybe GenericPackageDescription parsePackageDescription' :: BS.ByteString -> Maybe GenericPackageDescription
parsePackageDescription' bs = parsePackageDescription' bs =
parseGenericPackageDescriptionMaybe (BS.toStrict bs) parseGenericPackageDescriptionMaybe (BS.toStrict bs)
-- ------------------------------------------------------------ -- ------------------------------------------------------------
...@@ -703,7 +703,7 @@ fromUserConstraintScope (UserAnyQualifier pn) = ScopeAnyQualifier pn ...@@ -703,7 +703,7 @@ fromUserConstraintScope (UserAnyQualifier pn) = ScopeAnyQualifier pn
data UserConstraint = data UserConstraint =
UserConstraint UserConstraintScope PackageProperty UserConstraint UserConstraintScope PackageProperty
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic)
instance Binary UserConstraint instance Binary UserConstraint
instance Structured UserConstraint instance Structured UserConstraint
...@@ -732,7 +732,7 @@ readUserConstraint str = ...@@ -732,7 +732,7 @@ readUserConstraint str =
instance Text UserConstraint where instance Text UserConstraint where
disp (UserConstraint scope prop) = disp (UserConstraint scope prop) =
dispPackageConstraint $ PackageConstraint (fromUserConstraintScope scope) prop dispPackageConstraint $ PackageConstraint (fromUserConstraintScope scope) prop
parse = parse =
let parseConstraintScope :: Parse.ReadP a UserConstraintScope let parseConstraintScope :: Parse.ReadP a UserConstraintScope
parseConstraintScope = parseConstraintScope =
...@@ -765,7 +765,7 @@ instance Text UserConstraint where ...@@ -765,7 +765,7 @@ instance Text UserConstraint where
-- return (UserQualExe pn pn2, pn3) -- return (UserQualExe pn pn2, pn3)
in do in do
scope <- parseConstraintScope scope <- parseConstraintScope
-- Package property -- Package property
let keyword str x = Parse.skipSpaces1 >> Parse.string str >> return x let keyword str x = Parse.skipSpaces1 >> Parse.string str >> return x
prop <- ((parse >>= return . PackagePropertyVersion) prop <- ((parse >>= return . PackagePropertyVersion)
...@@ -783,6 +783,6 @@ instance Text UserConstraint where ...@@ -783,6 +783,6 @@ instance Text UserConstraint where
<++ <++
(Parse.skipSpaces1 >> parseFlagAssignment (Parse.skipSpaces1 >> parseFlagAssignment
>>= return . PackagePropertyFlags) >>= return . PackagePropertyFlags)
-- Result -- Result
return (UserConstraint scope prop) return (UserConstraint scope prop)
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module Distribution.Solver.Types.InstSolverPackage module Distribution.Solver.Types.InstSolverPackage
( InstSolverPackage(..) ( InstSolverPackage(..)
) where ) where
......
...@@ -145,7 +145,7 @@ showPackageConstraint pc@(PackageConstraint scope prop) = ...@@ -145,7 +145,7 @@ showPackageConstraint pc@(PackageConstraint scope prop) =
packageConstraintToDependency :: PackageConstraint -> Maybe Dependency packageConstraintToDependency :: PackageConstraint -> Maybe Dependency
packageConstraintToDependency (PackageConstraint scope prop) = toDep prop packageConstraintToDependency (PackageConstraint scope prop) = toDep prop
where where
toDep (PackagePropertyVersion vr) = toDep (PackagePropertyVersion vr) =
Just $ Dependency (scopeToPackageName scope) vr (Set.singleton LMainLibName) Just $ Dependency (scopeToPackageName scope) vr (Set.singleton LMainLibName)
toDep (PackagePropertyInstalled) = Nothing toDep (PackagePropertyInstalled) = Nothing
toDep (PackagePropertySource) = Nothing toDep (PackagePropertySource) = Nothing
......
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