From 7b9058328e162a4cb707b5d5b25cd1d2df66680e Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Fri, 29 Mar 2024 15:19:27 +0100
Subject: [PATCH] Make Cabal agnostic about working directory
This commit makes the library functions in Cabal agnostic of the working
directory. In practice, this means that we distinguish `FilePath`s
from un-interpreted `SymbolicPath`s. The latter may be paths that are
relative to the working directory, and need to be interpreted with
respect to a passed-in argument specifying the working directory,
instead of using the working directory of the current process.
See Note [Symbolic paths] in Distribution.Utils.Path.
In particular, paths in the package description now use the SymbolicPath
abstraction, which allows specifying whether they are allowed to be
absolute, and, if they are relative, what they are relative to.
For example, source files are relative to a source search directory,
data files are relative to the data directory, and doc files are
relative to the package root.
Fixes #9702
---
Cabal-described/src/Distribution/Described.hs | 19 +-
Cabal-syntax/Cabal-syntax.cabal | 8 +-
.../src/Distribution/FieldGrammar/Newtypes.hs | 40 +
.../PackageDescription/Configuration.hs | 2 +-
.../PackageDescription/FieldGrammar.hs | 168 ++--
.../Distribution/Types/BenchmarkInterface.hs | 4 +-
.../src/Distribution/Types/BuildInfo.hs | 33 +-
.../src/Distribution/Types/BuildInfo/Lens.hs | 30 +-
.../src/Distribution/Types/Executable.hs | 14 +-
.../src/Distribution/Types/Executable/Lens.hs | 5 +-
.../src/Distribution/Types/ForeignLib.hs | 4 +-
.../src/Distribution/Types/ForeignLib/Lens.hs | 5 +-
.../Distribution/Types/PackageDescription.hs | 17 +-
.../Types/PackageDescription/Lens.hs | 15 +-
.../Distribution/Types/TestSuiteInterface.hs | 4 +-
Cabal-syntax/src/Distribution/Utils/Path.hs | 482 +++++++++--
Cabal-tests/Cabal-tests.cabal | 2 +-
Cabal-tests/lib/Test/Utils/TempTestDir.hs | 5 +-
Cabal-tests/tests/NoThunks.hs | 5 +-
.../ParserTests/regressions/Octree-0.5.expr | 7 +-
.../ParserTests/regressions/anynone.expr | 2 +-
.../ParserTests/regressions/big-version.expr | 2 +-
.../regressions/common-conditional.expr | 4 +-
.../tests/ParserTests/regressions/common.expr | 4 +-
.../ParserTests/regressions/common2.expr | 4 +-
.../ParserTests/regressions/common3.expr | 4 +-
.../regressions/denormalised-paths.cabal | 2 +-
.../regressions/denormalised-paths.check | 8 +-
.../tests/ParserTests/regressions/elif.expr | 379 +++++----
.../tests/ParserTests/regressions/elif2.expr | 790 +++++++++---------
.../ParserTests/regressions/encoding-0.8.expr | 274 +++---
.../ParserTests/regressions/generics-sop.expr | 8 +-
.../ParserTests/regressions/hasktorch.expr | 16 +-
.../regressions/hidden-main-lib.expr | 227 ++---
.../ParserTests/regressions/indentation.expr | 229 ++---
.../ParserTests/regressions/indentation2.expr | 212 ++---
.../ParserTests/regressions/indentation3.expr | 219 ++---
.../ParserTests/regressions/issue-5055.expr | 7 +-
.../ParserTests/regressions/issue-5846.expr | 2 +-
.../ParserTests/regressions/issue-6083-a.expr | 8 +-
.../ParserTests/regressions/issue-6083-b.expr | 8 +-
.../ParserTests/regressions/issue-6083-c.expr | 2 +-
.../regressions/issue-6083-pkg-pkg.expr | 2 +-
.../ParserTests/regressions/issue-774.expr | 233 +++---
.../regressions/jaeger-flamegraph.expr | 7 +-
.../regressions/leading-comma-2.expr | 336 ++++----
.../regressions/leading-comma.expr | 322 ++++---
.../tests/ParserTests/regressions/libpq1.expr | 13 +-
.../tests/ParserTests/regressions/libpq2.expr | 13 +-
.../ParserTests/regressions/mixin-1.expr | 312 +++----
.../ParserTests/regressions/mixin-2.expr | 312 +++----
.../ParserTests/regressions/mixin-3.expr | 280 ++++---
.../ParserTests/regressions/monad-param.expr | 2 +-
.../regressions/multiple-libs-2.expr | 374 +++++----
.../ParserTests/regressions/noVersion.expr | 227 ++---
.../regressions/nothing-unicode.expr | 370 ++++----
.../tests/ParserTests/regressions/shake.expr | 109 ++-
.../tests/ParserTests/regressions/spdx-1.expr | 207 ++---
.../tests/ParserTests/regressions/spdx-2.expr | 212 ++---
.../tests/ParserTests/regressions/spdx-3.expr | 212 ++---
.../regressions/th-lift-instances.expr | 16 +-
.../ParserTests/regressions/version-sets.expr | 549 ++++++------
.../regressions/wl-pprint-indef.expr | 464 +++++-----
.../Distribution/Utils/Structured.hs | 8 +-
.../tests/custom-setup/CabalDoctestSetup.hs | 92 +-
Cabal-tests/tests/custom-setup/IdrisSetup.hs | 56 +-
.../src/Data/TreeDiff/Instances/Cabal.hs | 4 +-
Cabal/Cabal.cabal | 8 +-
.../Distribution/Compat/Internal/TempFile.hs | 5 +-
Cabal/src/Distribution/Compat/Time.hs | 7 +-
Cabal/src/Distribution/Make.hs | 50 +-
.../Distribution/PackageDescription/Check.hs | 34 +-
.../PackageDescription/Check/Target.hs | 53 +-
.../PackageDescription/Check/Warning.hs | 14 +-
Cabal/src/Distribution/Simple.hs | 489 ++++++-----
Cabal/src/Distribution/Simple/Bench.hs | 10 +-
Cabal/src/Distribution/Simple/Build.hs | 135 +--
Cabal/src/Distribution/Simple/Build/Inputs.hs | 6 +-
Cabal/src/Distribution/Simple/BuildPaths.hs | 111 ++-
Cabal/src/Distribution/Simple/BuildTarget.hs | 15 +-
Cabal/src/Distribution/Simple/Command.hs | 13 +
Cabal/src/Distribution/Simple/Compiler.hs | 33 +-
Cabal/src/Distribution/Simple/Configure.hs | 225 +++--
.../Distribution/Simple/ConfigureScript.hs | 25 +-
Cabal/src/Distribution/Simple/Errors.hs | 9 +-
Cabal/src/Distribution/Simple/GHC.hs | 123 ++-
Cabal/src/Distribution/Simple/GHC/Build.hs | 62 +-
.../Simple/GHC/Build/ExtraSources.hs | 89 +-
.../src/Distribution/Simple/GHC/Build/Link.hs | 132 ++-
.../Distribution/Simple/GHC/Build/Modules.hs | 46 +-
.../Distribution/Simple/GHC/Build/Utils.hs | 47 +-
Cabal/src/Distribution/Simple/GHC/Internal.hs | 156 ++--
Cabal/src/Distribution/Simple/GHCJS.hs | 194 +++--
Cabal/src/Distribution/Simple/Glob.hs | 95 ++-
Cabal/src/Distribution/Simple/Haddock.hs | 235 +++---
Cabal/src/Distribution/Simple/HaskellSuite.hs | 16 +-
Cabal/src/Distribution/Simple/Hpc.hs | 58 +-
Cabal/src/Distribution/Simple/Install.hs | 95 ++-
Cabal/src/Distribution/Simple/InstallDirs.hs | 2 +
.../src/Distribution/Simple/LocalBuildInfo.hs | 80 +-
.../Distribution/Simple/PackageDescription.hs | 40 +-
Cabal/src/Distribution/Simple/PreProcess.hs | 244 +++---
.../Distribution/Simple/PreProcess/Types.hs | 4 +-
Cabal/src/Distribution/Simple/Program.hs | 61 +-
Cabal/src/Distribution/Simple/Program/Ar.hs | 65 +-
Cabal/src/Distribution/Simple/Program/GHC.hs | 88 +-
.../src/Distribution/Simple/Program/HcPkg.hs | 144 +++-
Cabal/src/Distribution/Simple/Program/Hpc.hs | 64 +-
Cabal/src/Distribution/Simple/Program/Ld.hs | 74 +-
.../Simple/Program/ResponseFile.hs | 21 +-
Cabal/src/Distribution/Simple/Program/Run.hs | 28 +-
Cabal/src/Distribution/Simple/Register.hs | 154 ++--
Cabal/src/Distribution/Simple/Setup.hs | 39 +-
.../Distribution/Simple/Setup/Benchmark.hs | 119 ++-
Cabal/src/Distribution/Simple/Setup/Build.hs | 95 ++-
Cabal/src/Distribution/Simple/Setup/Clean.hs | 78 +-
Cabal/src/Distribution/Simple/Setup/Common.hs | 117 ++-
Cabal/src/Distribution/Simple/Setup/Config.hs | 175 ++--
Cabal/src/Distribution/Simple/Setup/Copy.hs | 127 +--
Cabal/src/Distribution/Simple/Setup/Global.hs | 11 +
.../src/Distribution/Simple/Setup/Haddock.hs | 393 +++++----
.../src/Distribution/Simple/Setup/Hscolour.hs | 178 ++--
.../src/Distribution/Simple/Setup/Install.hs | 87 +-
.../src/Distribution/Simple/Setup/Register.hs | 224 ++---
Cabal/src/Distribution/Simple/Setup/Repl.hs | 106 ++-
Cabal/src/Distribution/Simple/Setup/SDist.hs | 108 ++-
Cabal/src/Distribution/Simple/Setup/Test.hs | 267 +++---
.../src/Distribution/Simple/ShowBuildInfo.hs | 23 +-
Cabal/src/Distribution/Simple/SrcDist.hs | 157 ++--
Cabal/src/Distribution/Simple/Test.hs | 32 +-
Cabal/src/Distribution/Simple/Test/ExeV10.hs | 37 +-
Cabal/src/Distribution/Simple/Test/LibV09.hs | 44 +-
Cabal/src/Distribution/Simple/UHC.hs | 30 +-
Cabal/src/Distribution/Simple/Utils.hs | 477 +++++++----
.../Distribution/Types/LocalBuildConfig.hs | 6 +-
.../src/Distribution/Types/LocalBuildInfo.hs | 41 +-
cabal-install/cabal-install.cabal | 8 +-
.../src/Distribution/Client/Check.hs | 8 +-
.../src/Distribution/Client/CmdBench.hs | 3 +-
.../src/Distribution/Client/CmdBuild.hs | 5 +-
.../src/Distribution/Client/CmdClean.hs | 11 +-
.../src/Distribution/Client/CmdConfigure.hs | 5 +-
.../src/Distribution/Client/CmdExec.hs | 10 +-
.../src/Distribution/Client/CmdFreeze.hs | 7 +-
.../src/Distribution/Client/CmdHaddock.hs | 5 +-
.../Distribution/Client/CmdHaddockProject.hs | 17 +-
.../src/Distribution/Client/CmdInstall.hs | 5 +-
.../src/Distribution/Client/CmdLegacy.hs | 52 +-
.../src/Distribution/Client/CmdListBin.hs | 4 +-
.../src/Distribution/Client/CmdOutdated.hs | 6 +-
.../src/Distribution/Client/CmdRepl.hs | 3 +-
.../src/Distribution/Client/CmdRun.hs | 5 +-
.../src/Distribution/Client/CmdSdist.hs | 58 +-
.../src/Distribution/Client/CmdTest.hs | 3 +-
.../src/Distribution/Client/CmdUpdate.hs | 5 +-
.../src/Distribution/Client/Config.hs | 89 +-
.../src/Distribution/Client/Configure.hs | 40 +-
.../src/Distribution/Client/DistDirLayout.hs | 5 +-
.../src/Distribution/Client/GenBounds.hs | 9 +-
.../src/Distribution/Client/IndexUtils.hs | 11 +-
.../src/Distribution/Client/Init/Format.hs | 10 +-
.../src/Distribution/Client/Init/Utils.hs | 2 +-
.../src/Distribution/Client/Install.hs | 179 ++--
.../src/Distribution/Client/InstallSymlink.hs | 3 +-
cabal-install/src/Distribution/Client/Main.hs | 290 +++++--
.../Distribution/Client/NixStyleOptions.hs | 32 +-
.../Distribution/Client/ProjectBuilding.hs | 44 +-
.../Client/ProjectBuilding/UnpackedPackage.hs | 98 ++-
.../src/Distribution/Client/ProjectConfig.hs | 11 +-
.../Client/ProjectConfig/Legacy.hs | 106 +--
.../Client/ProjectOrchestration.hs | 11 +-
.../Distribution/Client/ProjectPlanOutput.hs | 9 +-
.../Distribution/Client/ProjectPlanning.hs | 119 ++-
.../Client/ProjectPlanning/Types.hs | 26 +-
.../src/Distribution/Client/RebuildMonad.hs | 1 +
.../src/Distribution/Client/Reconfigure.hs | 50 +-
cabal-install/src/Distribution/Client/Run.hs | 25 +-
.../src/Distribution/Client/Sandbox.hs | 21 +-
.../Client/Sandbox/PackageEnvironment.hs | 1 +
.../src/Distribution/Client/ScriptUtils.hs | 19 +-
.../src/Distribution/Client/Setup.hs | 81 +-
.../src/Distribution/Client/SetupWrapper.hs | 136 +--
.../src/Distribution/Client/SourceFiles.hs | 29 +-
.../src/Distribution/Client/SrcDist.hs | 36 +-
.../src/Distribution/Client/Store.hs | 2 +-
.../src/Distribution/Client/TargetSelector.hs | 52 +-
.../src/Distribution/Client/Targets.hs | 12 +-
.../src/Distribution/Client/Utils.hs | 104 ++-
cabal-install/tests/IntegrationTests2.hs | 4 +-
.../Distribution/Client/Configure.hs | 18 +-
.../Distribution/Solver/Modular/DSL.hs | 12 +-
.../AutoconfBadPaths/cabal.test.hs | 2 +-
.../AutogenModules/SrcDist/setup.test.hs | 4 +-
.../BenchmarkStanza/setup.test.hs | 7 +-
.../CCompilerOverride/custom-cc-clang.bat | 2 +-
.../Paths/InvalidWin/cabal.out | 2 +-
.../PackageTests/CustomPreProcess/Setup.hs | 10 +-
.../PackageTests/CustomTestCoverage/cabal.out | 6 +-
.../ExternalCommand/cabal.test.hs | 2 +-
.../ExternalCommandEnv/cabal.test.hs | 4 +-
.../ExternalCommandHelp/cabal.test.hs | 2 +-
.../PackageTests/ExtraProgPath/setup.out | 4 +-
.../GhcPkgGuess/SameDirectory/setup.cabal.out | 2 +-
.../GhcPkgGuess/SameDirectory/setup.out | 2 +-
.../SameDirectoryGhcVersion/setup.cabal.out | 2 +-
.../SameDirectoryGhcVersion/setup.out | 2 +-
.../SameDirectoryVersion/setup.cabal.out | 2 +-
.../SameDirectoryVersion/setup.out | 2 +-
.../GhcPkgGuess/Symlink/setup.cabal.out | 2 +-
.../GhcPkgGuess/Symlink/setup.out | 2 +-
.../SymlinkGhcVersion/setup.cabal.out | 2 +-
.../GhcPkgGuess/SymlinkGhcVersion/setup.out | 2 +-
.../SymlinkVersion/setup.cabal.out | 2 +-
.../GhcPkgGuess/SymlinkVersion/setup.out | 2 +-
.../PackageTests/HaddockArgs/hoogle.out | 4 +-
.../PackageTests/HaddockArgs/quickjump.out | 4 +-
.../HaddockBuildDepends/cabal.out | 2 +-
.../HaddockProject/haddock-project.out | 2 +-
.../Executable/setup-static.test.hs | 13 +-
.../NewBuild/CmdRun/Terminate/cabal.test.hs | 2 +-
.../NewHaddock/ImplyDependencies/cabal.out | 2 +-
.../ShowBuildInfo/Complex/single.out | 10 +-
.../PackageTests/TestStanza/setup.test.hs | 7 +-
.../ExeV10/setup-no-markup.test.hs | 24 +-
.../ExeV10/setup-no-tix.test.hs | 21 +-
cabal-testsuite/Setup.hs | 1 +
cabal-testsuite/cabal-testsuite.cabal | 6 +-
cabal-testsuite/main/cabal-tests.hs | 4 +-
cabal-testsuite/src/Test/Cabal/Monad.hs | 7 +-
.../src/Test/Cabal/OutputNormalizer.hs | 8 +-
cabal-testsuite/src/Test/Cabal/Prelude.hs | 17 +-
cabal-testsuite/src/Test/Cabal/Run.hs | 1 +
cabal-testsuite/src/Test/Cabal/Script.hs | 14 +-
cabal-testsuite/src/Test/Cabal/Server.hs | 17 +-
cabal-testsuite/src/Test/Cabal/Workdir.hs | 30 +-
changelog.d/issue-9702 | 39 +
236 files changed, 9798 insertions(+), 7065 deletions(-)
create mode 100644 changelog.d/issue-9702
diff --git a/Cabal-described/src/Distribution/Described.hs b/Cabal-described/src/Distribution/Described.hs
index 3bfd8c2e3a..8c1c501cf9 100644
--- a/Cabal-described/src/Distribution/Described.hs
+++ b/Cabal-described/src/Distribution/Described.hs
@@ -68,7 +68,7 @@ import Distribution.Utils.GrammarRegex
-- Types
import Distribution.Compat.Newtype
import Distribution.Compiler (CompilerFlavor, CompilerId, knownCompilerFlavors)
-import Distribution.PackageDescription.FieldGrammar (CompatFilePath, CompatLicenseFile)
+import Distribution.PackageDescription.FieldGrammar (CompatLicenseFile, CompatDataDir)
import Distribution.FieldGrammar.Newtypes
import Distribution.ModuleName (ModuleName)
import Distribution.System (Arch, OS, knownArches, knownOSs)
@@ -99,7 +99,7 @@ import Distribution.Types.SourceRepo (RepoType)
import Distribution.Types.TestType (TestType)
import Distribution.Types.UnitId (UnitId)
import Distribution.Types.UnqualComponentName (UnqualComponentName)
-import Distribution.Utils.Path (LicenseFile, PackageDir, SourceDir, SymbolicPath)
+import Distribution.Utils.Path (SymbolicPath, RelativePath)
import Distribution.Verbosity (Verbosity)
import Distribution.Version (Version, VersionRange)
import Language.Haskell.Extension (Extension, Language, knownLanguages)
@@ -578,17 +578,24 @@ instance Described SpecLicense where
instance Described TestedWith where
describe _ = RETodo
-instance Described FilePathNT where
+
+instance Described (SymbolicPath from to) where
+ describe _ = describe ([] :: [Token])
+
+instance Described (RelativePath from to) where
describe _ = describe ([] :: [Token])
-instance Described (SymbolicPath PackageDir SourceDir) where
+instance Described (SymbolicPathNT from to) where
describe _ = describe ([] :: [Token])
-instance Described (SymbolicPath PackageDir LicenseFile) where
+instance Described (RelativePathNT from to) where
describe _ = describe ([] :: [Token])
instance Described CompatLicenseFile where
describe _ = describe ([] :: [Token])
-instance Described CompatFilePath where
+instance Described CompatDataDir where
+ describe _ = describe ([] :: [Token])
+
+instance Described FilePathNT where
describe _ = describe ([] :: [Token])
diff --git a/Cabal-syntax/Cabal-syntax.cabal b/Cabal-syntax/Cabal-syntax.cabal
index 73fb7c1bb1..46c4ce4fc2 100644
--- a/Cabal-syntax/Cabal-syntax.cabal
+++ b/Cabal-syntax/Cabal-syntax.cabal
@@ -45,7 +45,13 @@ library
-- See also https://github.com/ekmett/transformers-compat/issues/35
transformers (>= 0.3 && < 0.4) || (>=0.4.1.0 && <0.7)
- ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates
+ ghc-options:
+ -Wall
+ -fno-ignore-asserts
+ -fwarn-tabs
+ -fwarn-incomplete-uni-patterns
+ -fwarn-incomplete-record-updates
+ -fno-warn-unticked-promoted-constructors
if impl(ghc >= 8.0)
ghc-options: -Wcompat -Wnoncanonical-monad-instances
diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Newtypes.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Newtypes.hs
index f823d3d63e..d39e77ebbe 100644
--- a/Cabal-syntax/src/Distribution/FieldGrammar/Newtypes.hs
+++ b/Cabal-syntax/src/Distribution/FieldGrammar/Newtypes.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -42,6 +44,8 @@ module Distribution.FieldGrammar.Newtypes
, Token' (..)
, MQuoted (..)
, FilePathNT (..)
+ , SymbolicPathNT (..)
+ , RelativePathNT (..)
) where
import Distribution.Compat.Newtype
@@ -53,6 +57,7 @@ import Distribution.Compiler (CompilerFlavor)
import Distribution.License (License)
import Distribution.Parsec
import Distribution.Pretty
+import Distribution.Utils.Path
import Distribution.Version
( LowerBound (..)
, Version
@@ -277,6 +282,41 @@ instance Parsec FilePathNT where
instance Pretty FilePathNT where
pretty = showFilePath . unpack
+-- | Newtype for 'SymbolicPath', with a different 'Parsec' instance
+-- to disallow empty paths.
+newtype SymbolicPathNT from to = SymbolicPathNT {getSymbolicPathNT :: SymbolicPath from to}
+
+instance Newtype (SymbolicPath from to) (SymbolicPathNT from to)
+
+instance Parsec (SymbolicPathNT from to) where
+ parsec = do
+ token <- parsecToken
+ if null token
+ then P.unexpected "empty FilePath"
+ else return (SymbolicPathNT $ makeSymbolicPath token)
+
+instance Pretty (SymbolicPathNT from to) where
+ pretty = showFilePath . getSymbolicPath . getSymbolicPathNT
+
+-- | Newtype for 'RelativePath', with a different 'Parsec' instance
+-- to disallow empty paths but allow non-relative paths (which get rejected
+-- later with a different error message, see 'Distribution.PackageDescription.Check.Paths.checkPath')
+newtype RelativePathNT from to = RelativePathNT {getRelativePathNT :: RelativePath from to}
+
+instance Newtype (RelativePath from to) (RelativePathNT from to)
+
+-- NB: we don't reject non-relative paths here; we allow them here and reject
+-- later (see 'Distribution.PackageDescription.Check.Paths.checkPath').
+instance Parsec (RelativePathNT from to) where
+ parsec = do
+ token <- parsecToken
+ if null token
+ then P.unexpected "empty FilePath"
+ else return (RelativePathNT $ unsafeMakeSymbolicPath token)
+
+instance Pretty (RelativePathNT from to) where
+ pretty = showFilePath . getSymbolicPath . getRelativePathNT
+
-------------------------------------------------------------------------------
-- SpecVersion
-------------------------------------------------------------------------------
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs
index 9a9ba2d750..e811c36122 100644
--- a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs
+++ b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs
@@ -58,7 +58,7 @@ import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.DependencyMap
import Distribution.Types.PackageVersionConstraint
import Distribution.Utils.Generic
-import Distribution.Utils.Path
+import Distribution.Utils.Path (sameDirectory)
import Distribution.Version
import qualified Data.Map.Lazy as Map
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
index c60040f8e3..db6b7f7607 100644
--- a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
@@ -1,13 +1,15 @@
{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuantifiedConstraints #-}
-- | 'GenericPackageDescription' Field descriptions
module Distribution.PackageDescription.FieldGrammar
( -- * Package description
packageDescriptionFieldGrammar
- , CompatFilePath (..)
+ , CompatDataDir (..)
, CompatLicenseFile (..)
-- * Library
@@ -99,16 +101,11 @@ packageDescriptionFieldGrammar
, c (Identity BuildType)
, c (Identity PackageName)
, c (Identity Version)
- , c (List FSep FilePathNT String)
- , c (List FSep CompatFilePath String)
- , c (List FSep (Identity (SymbolicPath PackageDir LicenseFile)) (SymbolicPath PackageDir LicenseFile))
+ , forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
+ , forall from to. c (List VCat (RelativePathNT from to) (RelativePath from to))
, c (List FSep TestedWith (CompilerFlavor, VersionRange))
- , c (List VCat FilePathNT String)
- , c FilePathNT
, c CompatLicenseFile
- , c CompatFilePath
- , c SpecLicense
- , c SpecVersion
+ , c CompatDataDir
)
=> g PackageDescription PackageDescription
packageDescriptionFieldGrammar =
@@ -140,12 +137,12 @@ packageDescriptionFieldGrammar =
<*> pure [] -- test suites
<*> pure [] -- benchmarks
-- * Files
- <*> monoidalFieldAla "data-files" (alaList' VCat FilePathNT) L.dataFiles
- <*> optionalFieldDefAla "data-dir" CompatFilePath L.dataDir "."
- ^^^ fmap (\x -> if null x then "." else x) -- map empty directories to "."
+ <*> monoidalFieldAla "data-files" (alaList' VCat RelativePathNT) L.dataFiles
+ <*> optionalFieldDefAla "data-dir" CompatDataDir L.dataDir sameDirectory
+ ^^^ fmap (\x -> if null (getSymbolicPath x) then sameDirectory else x) -- map empty directories to "."
<*> monoidalFieldAla "extra-source-files" formatExtraSourceFiles L.extraSrcFiles
- <*> monoidalFieldAla "extra-tmp-files" (alaList' VCat FilePathNT) L.extraTmpFiles
- <*> monoidalFieldAla "extra-doc-files" (alaList' VCat FilePathNT) L.extraDocFiles
+ <*> monoidalFieldAla "extra-tmp-files" (alaList' VCat RelativePathNT) L.extraTmpFiles
+ <*> monoidalFieldAla "extra-doc-files" formatExtraSourceFiles L.extraDocFiles
where
packageIdentifierGrammar =
PackageIdentifier
@@ -158,7 +155,7 @@ packageDescriptionFieldGrammar =
-- should we pretty print license-file if there's single license file
-- and license-files when more
<$> monoidalFieldAla "license-file" CompatLicenseFile L.licenseFiles
- <*> monoidalFieldAla "license-files" (alaList FSep) L.licenseFiles
+ <*> monoidalFieldAla "license-files" (alaList' FSep RelativePathNT) L.licenseFiles
^^^ hiddenField
-------------------------------------------------------------------------------
@@ -178,12 +175,12 @@ libraryFieldGrammar
, c (List CommaVCat (Identity ModuleReexport) ModuleReexport)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
- , c (List FSep FilePathNT String)
, c (List FSep Token String)
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
- , c (List VCat FilePathNT String)
- , c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
+ , forall from to. c (List FSep (SymbolicPathNT from to) (SymbolicPath from to))
+ , forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
+ , forall from to. c (List VCat (SymbolicPathNT from to) (SymbolicPath from to))
, c (List VCat Token String)
, c (MQuoted Language)
)
@@ -228,12 +225,12 @@ foreignLibFieldGrammar
, c (List FSep (Identity ForeignLibOption) ForeignLibOption)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
- , c (List FSep FilePathNT String)
, c (List FSep Token String)
- , c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
+ , forall from to. c (List FSep (SymbolicPathNT from to) (SymbolicPath from to))
+ , forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
+ , forall from to. c (List VCat (SymbolicPathNT from to) (SymbolicPath from to))
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
- , c (List VCat FilePathNT String)
, c (List VCat Token String)
, c (MQuoted Language)
)
@@ -246,7 +243,7 @@ foreignLibFieldGrammar n =
<*> blurFieldGrammar L.foreignLibBuildInfo buildInfoFieldGrammar
<*> optionalField "lib-version-info" L.foreignLibVersionInfo
<*> optionalField "lib-version-linux" L.foreignLibVersionLinux
- <*> monoidalFieldAla "mod-def-file" (alaList' FSep FilePathNT) L.foreignLibModDefFile
+ <*> monoidalFieldAla "mod-def-file" (alaList' FSep RelativePathNT) L.foreignLibModDefFile
{-# SPECIALIZE foreignLibFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' ForeignLib #-}
{-# SPECIALIZE foreignLibFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' ForeignLib #-}
@@ -266,12 +263,16 @@ executableFieldGrammar
, c (List CommaVCat (Identity Mixin) Mixin)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
- , c (List FSep FilePathNT String)
, c (List FSep Token String)
- , c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
+ , forall from to. c (List FSep (SymbolicPathNT from to) (SymbolicPath from to))
+ , forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
+ , forall from to. c (List FSep (SymbolicPathNT from to) (SymbolicPath from to))
+ , forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
+ , forall from to. c (List VCat (SymbolicPathNT from to) (SymbolicPath from to))
+ , forall from to. c (SymbolicPathNT from to)
+ , forall from to. c (RelativePathNT from to)
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
- , c (List VCat FilePathNT String)
, c (List VCat Token String)
, c (MQuoted Language)
)
@@ -280,7 +281,7 @@ executableFieldGrammar
executableFieldGrammar n =
Executable n
-- main-is is optional as conditional blocks don't have it
- <$> optionalFieldDefAla "main-is" FilePathNT L.modulePath ""
+ <$> optionalFieldDefAla "main-is" RelativePathNT L.modulePath (modulePath mempty)
<*> optionalFieldDef "scope" L.exeScope ExecutablePublic
^^^ availableSince CabalSpecV2_0 ExecutablePublic
<*> blurFieldGrammar L.buildInfo buildInfoFieldGrammar
@@ -295,7 +296,7 @@ executableFieldGrammar n =
-- After validation it is converted into the proper 'TestSuite' type.
data TestSuiteStanza = TestSuiteStanza
{ _testStanzaTestType :: Maybe TestType
- , _testStanzaMainIs :: Maybe FilePath
+ , _testStanzaMainIs :: Maybe (RelativePath Source File)
, _testStanzaTestModule :: Maybe ModuleName
, _testStanzaBuildInfo :: BuildInfo
, _testStanzaCodeGenerators :: [String]
@@ -308,7 +309,7 @@ testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType)
testStanzaTestType f s = fmap (\x -> s{_testStanzaTestType = x}) (f (_testStanzaTestType s))
{-# INLINE testStanzaTestType #-}
-testStanzaMainIs :: Lens' TestSuiteStanza (Maybe FilePath)
+testStanzaMainIs :: Lens' TestSuiteStanza (Maybe (RelativePath Source File))
testStanzaMainIs f s = fmap (\x -> s{_testStanzaMainIs = x}) (f (_testStanzaMainIs s))
{-# INLINE testStanzaMainIs #-}
@@ -338,12 +339,13 @@ testSuiteFieldGrammar
, c (List CommaVCat (Identity Mixin) Mixin)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
- , c (List FSep FilePathNT String)
, c (List FSep Token String)
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
- , c (List VCat FilePathNT String)
- , c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
+ , forall from to. c (List FSep (SymbolicPathNT from to) (SymbolicPath from to))
+ , forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
+ , forall from to. c (List VCat (SymbolicPathNT from to) (SymbolicPath from to))
+ , forall from to. c (RelativePathNT from to)
, c (List VCat Token String)
, c (MQuoted Language)
)
@@ -351,7 +353,7 @@ testSuiteFieldGrammar
testSuiteFieldGrammar =
TestSuiteStanza
<$> optionalField "type" testStanzaTestType
- <*> optionalFieldAla "main-is" FilePathNT testStanzaMainIs
+ <*> optionalFieldAla "main-is" RelativePathNT testStanzaMainIs
<*> optionalField "test-module" testStanzaTestModule
<*> blurFieldGrammar testStanzaBuildInfo buildInfoFieldGrammar
<*> monoidalFieldAla "code-generators" (alaList' CommaFSep Token) testStanzaCodeGenerators
@@ -444,7 +446,7 @@ unvalidateTestSuite t =
-- After validation it is converted into the proper 'Benchmark' type.
data BenchmarkStanza = BenchmarkStanza
{ _benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
- , _benchmarkStanzaMainIs :: Maybe FilePath
+ , _benchmarkStanzaMainIs :: Maybe (RelativePath Source File)
, _benchmarkStanzaBenchmarkModule :: Maybe ModuleName
, _benchmarkStanzaBuildInfo :: BuildInfo
}
@@ -456,7 +458,7 @@ benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType)
benchmarkStanzaBenchmarkType f s = fmap (\x -> s{_benchmarkStanzaBenchmarkType = x}) (f (_benchmarkStanzaBenchmarkType s))
{-# INLINE benchmarkStanzaBenchmarkType #-}
-benchmarkStanzaMainIs :: Lens' BenchmarkStanza (Maybe FilePath)
+benchmarkStanzaMainIs :: Lens' BenchmarkStanza (Maybe (RelativePath Source File))
benchmarkStanzaMainIs f s = fmap (\x -> s{_benchmarkStanzaMainIs = x}) (f (_benchmarkStanzaMainIs s))
{-# INLINE benchmarkStanzaMainIs #-}
@@ -481,12 +483,13 @@ benchmarkFieldGrammar
, c (List CommaVCat (Identity Mixin) Mixin)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
- , c (List FSep FilePathNT String)
, c (List FSep Token String)
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
- , c (List VCat FilePathNT String)
- , c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
+ , forall from to. c (List FSep (SymbolicPathNT from to) (SymbolicPath from to))
+ , forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
+ , forall from to. c (List VCat (SymbolicPathNT from to) (SymbolicPath from to))
+ , forall from to. c (RelativePathNT from to)
, c (List VCat Token String)
, c (MQuoted Language)
)
@@ -494,7 +497,7 @@ benchmarkFieldGrammar
benchmarkFieldGrammar =
BenchmarkStanza
<$> optionalField "type" benchmarkStanzaBenchmarkType
- <*> optionalFieldAla "main-is" FilePathNT benchmarkStanzaMainIs
+ <*> optionalFieldAla "main-is" RelativePathNT benchmarkStanzaMainIs
<*> optionalField "benchmark-module" benchmarkStanzaBenchmarkModule
<*> blurFieldGrammar benchmarkStanzaBuildInfo buildInfoFieldGrammar
@@ -561,8 +564,11 @@ unvalidateBenchmark b =
}
where
(ty, ma, mo) = case benchmarkInterface b of
- BenchmarkExeV10 ver "" -> (Just $ BenchmarkTypeExe ver, Nothing, Nothing)
- BenchmarkExeV10 ver ma' -> (Just $ BenchmarkTypeExe ver, Just ma', Nothing)
+ BenchmarkExeV10 ver ma'
+ | getSymbolicPath ma' == "" ->
+ (Just $ BenchmarkTypeExe ver, Nothing, Nothing)
+ | otherwise ->
+ (Just $ BenchmarkTypeExe ver, Just ma', Nothing)
_ -> (Nothing, Nothing, Nothing)
-------------------------------------------------------------------------------
@@ -579,12 +585,12 @@ buildInfoFieldGrammar
, c (List CommaVCat (Identity Mixin) Mixin)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
- , c (List FSep FilePathNT String)
, c (List FSep Token String)
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
- , c (List VCat FilePathNT String)
- , c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
+ , forall from to. c (List FSep (SymbolicPathNT from to) (SymbolicPath from to))
+ , forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
+ , forall from to. c (List VCat (SymbolicPathNT from to) (SymbolicPath from to))
, c (List VCat Token String)
, c (MQuoted Language)
)
@@ -617,16 +623,16 @@ buildInfoFieldGrammar =
<*> monoidalFieldAla "hsc2hs-options" (alaList' NoCommaFSep Token') L.hsc2hsOptions
^^^ availableSince CabalSpecV3_6 []
<*> monoidalFieldAla "pkgconfig-depends" (alaList CommaFSep) L.pkgconfigDepends
- <*> monoidalFieldAla "frameworks" (alaList' FSep Token) L.frameworks
- <*> monoidalFieldAla "extra-framework-dirs" (alaList' FSep FilePathNT) L.extraFrameworkDirs
- <*> monoidalFieldAla "asm-sources" (alaList' VCat FilePathNT) L.asmSources
+ <*> monoidalFieldAla "frameworks" (alaList' FSep RelativePathNT) L.frameworks
+ <*> monoidalFieldAla "extra-framework-dirs" (alaList' FSep SymbolicPathNT) L.extraFrameworkDirs
+ <*> monoidalFieldAla "asm-sources" (alaList' VCat SymbolicPathNT) L.asmSources
^^^ availableSince CabalSpecV3_0 []
- <*> monoidalFieldAla "cmm-sources" (alaList' VCat FilePathNT) L.cmmSources
+ <*> monoidalFieldAla "cmm-sources" (alaList' VCat SymbolicPathNT) L.cmmSources
^^^ availableSince CabalSpecV3_0 []
- <*> monoidalFieldAla "c-sources" (alaList' VCat FilePathNT) L.cSources
- <*> monoidalFieldAla "cxx-sources" (alaList' VCat FilePathNT) L.cxxSources
+ <*> monoidalFieldAla "c-sources" (alaList' VCat SymbolicPathNT) L.cSources
+ <*> monoidalFieldAla "cxx-sources" (alaList' VCat SymbolicPathNT) L.cxxSources
^^^ availableSince CabalSpecV2_2 []
- <*> monoidalFieldAla "js-sources" (alaList' VCat FilePathNT) L.jsSources
+ <*> monoidalFieldAla "js-sources" (alaList' VCat SymbolicPathNT) L.jsSources
<*> hsSourceDirsGrammar
<*> monoidalFieldAla "other-modules" formatOtherModules L.otherModules
<*> monoidalFieldAla "virtual-modules" (alaList' VCat MQuoted) L.virtualModules
@@ -656,14 +662,14 @@ buildInfoFieldGrammar =
<*> monoidalFieldAla "extra-library-flavours" (alaList' VCat Token) L.extraLibFlavours
<*> monoidalFieldAla "extra-dynamic-library-flavours" (alaList' VCat Token) L.extraDynLibFlavours
^^^ availableSince CabalSpecV3_0 []
- <*> monoidalFieldAla "extra-lib-dirs" (alaList' FSep FilePathNT) L.extraLibDirs
- <*> monoidalFieldAla "extra-lib-dirs-static" (alaList' FSep FilePathNT) L.extraLibDirsStatic
+ <*> monoidalFieldAla "extra-lib-dirs" (alaList' FSep SymbolicPathNT) L.extraLibDirs
+ <*> monoidalFieldAla "extra-lib-dirs-static" (alaList' FSep SymbolicPathNT) L.extraLibDirsStatic
^^^ availableSince CabalSpecV3_8 []
- <*> monoidalFieldAla "include-dirs" (alaList' FSep FilePathNT) L.includeDirs
- <*> monoidalFieldAla "includes" (alaList' FSep FilePathNT) L.includes
- <*> monoidalFieldAla "autogen-includes" (alaList' FSep FilePathNT) L.autogenIncludes
+ <*> monoidalFieldAla "include-dirs" (alaList' FSep SymbolicPathNT) L.includeDirs
+ <*> monoidalFieldAla "includes" (alaList' FSep SymbolicPathNT) L.includes
+ <*> monoidalFieldAla "autogen-includes" (alaList' FSep RelativePathNT) L.autogenIncludes
^^^ availableSince CabalSpecV3_0 []
- <*> monoidalFieldAla "install-includes" (alaList' FSep FilePathNT) L.installIncludes
+ <*> monoidalFieldAla "install-includes" (alaList' FSep RelativePathNT) L.installIncludes
<*> optionsFieldGrammar
<*> profOptionsFieldGrammar
<*> sharedOptionsFieldGrammar
@@ -678,19 +684,19 @@ buildInfoFieldGrammar =
hsSourceDirsGrammar
:: ( FieldGrammar c g
, Applicative (g BuildInfo)
- , c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
+ , forall from to. c (List FSep (SymbolicPathNT from to) (SymbolicPath from to))
)
- => g BuildInfo [SymbolicPath PackageDir SourceDir]
+ => g BuildInfo [SymbolicPath Pkg (Dir Source)]
hsSourceDirsGrammar =
(++)
<$> monoidalFieldAla "hs-source-dirs" formatHsSourceDirs L.hsSourceDirs
- <*> monoidalFieldAla "hs-source-dir" (alaList FSep) wrongLens
+ <*> monoidalFieldAla "hs-source-dir" (alaList' FSep SymbolicPathNT) wrongLens
--- https://github.com/haskell/cabal/commit/49e3cdae3bdf21b017ccd42e66670ca402e22b44
^^^ deprecatedSince CabalSpecV1_2 "Please use 'hs-source-dirs'"
^^^ removedIn CabalSpecV3_0 "Please use 'hs-source-dirs' field."
where
-- TODO: make pretty printer aware of CabalSpecVersion
- wrongLens :: Functor f => LensLike' f BuildInfo [SymbolicPath PackageDir SourceDir]
+ wrongLens :: Functor f => LensLike' f BuildInfo [SymbolicPath Pkg (Dir Source)]
wrongLens f bi = (\fps -> set L.hsSourceDirs fps bi) <$> f []
optionsFieldGrammar
@@ -797,14 +803,14 @@ formatDependencyList = alaList CommaVCat
formatMixinList :: [Mixin] -> List CommaVCat (Identity Mixin) Mixin
formatMixinList = alaList CommaVCat
-formatExtraSourceFiles :: [FilePath] -> List VCat FilePathNT FilePath
-formatExtraSourceFiles = alaList' VCat FilePathNT
+formatExtraSourceFiles :: [RelativePath Pkg File] -> List VCat (RelativePathNT Pkg File) (RelativePath Pkg File)
+formatExtraSourceFiles = alaList' VCat RelativePathNT
formatExposedModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatExposedModules = alaList' VCat MQuoted
-formatHsSourceDirs :: [SymbolicPath PackageDir SourceDir] -> List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir)
-formatHsSourceDirs = alaList FSep
+formatHsSourceDirs :: [SymbolicPath Pkg (Dir Source)] -> List FSep (SymbolicPathNT Pkg (Dir Source)) (SymbolicPath Pkg (Dir Source))
+formatHsSourceDirs = alaList' FSep SymbolicPathNT
formatOtherExtensions :: [Extension] -> List FSep (MQuoted Extension) Extension
formatOtherExtensions = alaList' FSep MQuoted
@@ -816,16 +822,10 @@ formatOtherModules = alaList' VCat MQuoted
-- newtypes
-------------------------------------------------------------------------------
--- | Compat FilePath accepts empty file path,
--- but issues a warning.
+-- | Newtype for data directory (absolute or relative).
--
--- There are simply too many (~1200) package definition files
---
--- @
--- license-file: ""
--- @
---
--- and
+-- Accepts empty file path, but issues a warning;
+-- there are simply too many (~1200) package definition files
--
-- @
-- data-dir: ""
@@ -833,25 +833,23 @@ formatOtherModules = alaList' VCat MQuoted
--
-- across Hackage to outrule them completely.
-- I suspect some of them are generated (e.g. formatted) by machine.
-newtype CompatFilePath = CompatFilePath {getCompatFilePath :: FilePath} -- TODO: Change to use SymPath
+newtype CompatDataDir = CompatDataDir {getCompatDataDir :: SymbolicPath Pkg (Dir DataDir)}
-instance Newtype String CompatFilePath
+instance Newtype (SymbolicPath Pkg (Dir DataDir)) CompatDataDir
-instance Parsec CompatFilePath where
+instance Parsec CompatDataDir where
parsec = do
token <- parsecToken
- if null token
- then do
- parsecWarning PWTEmptyFilePath "empty FilePath"
- return (CompatFilePath "")
- else return (CompatFilePath token)
+ when (null token) $
+ parsecWarning PWTEmptyFilePath "empty FilePath"
+ return (CompatDataDir $ makeSymbolicPath token)
-instance Pretty CompatFilePath where
- pretty = showToken . getCompatFilePath
+instance Pretty CompatDataDir where
+ pretty = showToken . getSymbolicPath . getCompatDataDir
-newtype CompatLicenseFile = CompatLicenseFile {getCompatLicenseFile :: [SymbolicPath PackageDir LicenseFile]}
+newtype CompatLicenseFile = CompatLicenseFile {getCompatLicenseFile :: [RelativePath Pkg File]}
-instance Newtype [SymbolicPath PackageDir LicenseFile] CompatLicenseFile
+instance Newtype [RelativePath Pkg File] CompatLicenseFile
-- TODO
instance Parsec CompatLicenseFile where
diff --git a/Cabal-syntax/src/Distribution/Types/BenchmarkInterface.hs b/Cabal-syntax/src/Distribution/Types/BenchmarkInterface.hs
index b894e71b79..02b2086447 100644
--- a/Cabal-syntax/src/Distribution/Types/BenchmarkInterface.hs
+++ b/Cabal-syntax/src/Distribution/Types/BenchmarkInterface.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -9,6 +10,7 @@ import Distribution.Compat.Prelude
import Prelude ()
import Distribution.Types.BenchmarkType
+import Distribution.Utils.Path
import Distribution.Version
-- | The benchmark interfaces that are currently defined.
@@ -21,7 +23,7 @@ data BenchmarkInterface
-- for success, non-zero for failure. The stdout and stderr
-- channels may be logged. Test tooling may pass command line
-- arguments and/or connect the stdin channel to the test.
- BenchmarkExeV10 Version FilePath
+ BenchmarkExeV10 Version (RelativePath Source File)
| -- | A benchmark that does not conform to one of the above
-- interfaces for the given reason (e.g. unknown benchmark type).
BenchmarkUnsupported BenchmarkType
diff --git a/Cabal-syntax/src/Distribution/Types/BuildInfo.hs b/Cabal-syntax/src/Distribution/Types/BuildInfo.hs
index 67efb90955..da1f8aea88 100644
--- a/Cabal-syntax/src/Distribution/Types/BuildInfo.hs
+++ b/Cabal-syntax/src/Distribution/Types/BuildInfo.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -65,20 +66,22 @@ data BuildInfo = BuildInfo
-- ^ options for hsc2hs
, pkgconfigDepends :: [PkgconfigDependency]
-- ^ pkg-config packages that are used
- , frameworks :: [String]
+ , frameworks :: [RelativePath Framework File]
-- ^ support frameworks for Mac OS X
- , extraFrameworkDirs :: [String]
+ , extraFrameworkDirs :: [SymbolicPath Pkg (Dir Framework)]
-- ^ extra locations to find frameworks.
- , asmSources :: [FilePath]
+ , asmSources :: [SymbolicPath Pkg File]
-- ^ Assembly files.
- , cmmSources :: [FilePath]
+ , cmmSources :: [SymbolicPath Pkg File]
-- ^ C-- files.
- , cSources :: [FilePath]
- , cxxSources :: [FilePath]
- , jsSources :: [FilePath]
- , hsSourceDirs :: [SymbolicPath PackageDir SourceDir]
+ , cSources :: [SymbolicPath Pkg File]
+ , cxxSources :: [SymbolicPath Pkg File]
+ , jsSources :: [SymbolicPath Pkg File]
+ , hsSourceDirs :: [SymbolicPath Pkg (Dir Source)]
-- ^ where to look for the Haskell module hierarchy
- , otherModules :: [ModuleName]
+ , -- NB: these are symbolic paths are not relative paths,
+ -- because autogenerated modules might end up in an absolute path
+ otherModules :: [ModuleName]
-- ^ non-exposed or non-main modules
, virtualModules :: [ModuleName]
-- ^ exposed modules that do not have a source file (e.g. @GHC.Prim@ from @ghc-prim@ package)
@@ -117,15 +120,15 @@ data BuildInfo = BuildInfo
-- ^ Hidden Flag. This set of strings will be appended to all /dynamic/
-- libraries when copying. This is particularly useful with the `rts` package,
-- where we want different dynamic flavours of the RTS library to be installed.
- , extraLibDirs :: [String]
- , extraLibDirsStatic :: [String]
- , includeDirs :: [FilePath]
+ , extraLibDirs :: [SymbolicPath Pkg (Dir Lib)]
+ , extraLibDirsStatic :: [SymbolicPath Pkg (Dir Lib)]
+ , includeDirs :: [SymbolicPath Pkg (Dir Include)]
-- ^ directories to find .h files
- , includes :: [FilePath]
+ , includes :: [SymbolicPath Include File]
-- ^ The .h files to be found in includeDirs
- , autogenIncludes :: [FilePath]
+ , autogenIncludes :: [RelativePath Include File]
-- ^ The .h files to be generated (e.g. by @autoconf@)
- , installIncludes :: [FilePath]
+ , installIncludes :: [RelativePath Include File]
-- ^ .h files to install with the package
, options :: PerCompilerFlavor [String]
, profOptions :: PerCompilerFlavor [String]
diff --git a/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs b/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs
index 63cfba526a..19453a671b 100644
--- a/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+
module Distribution.Types.BuildInfo.Lens
( BuildInfo
, HasBuildInfo (..)
@@ -69,35 +71,35 @@ class HasBuildInfo a where
pkgconfigDepends = buildInfo . pkgconfigDepends
{-# INLINE pkgconfigDepends #-}
- frameworks :: Lens' a [String]
+ frameworks :: Lens' a [RelativePath Framework File]
frameworks = buildInfo . frameworks
{-# INLINE frameworks #-}
- extraFrameworkDirs :: Lens' a [String]
+ extraFrameworkDirs :: Lens' a [SymbolicPath Pkg (Dir Framework)]
extraFrameworkDirs = buildInfo . extraFrameworkDirs
{-# INLINE extraFrameworkDirs #-}
- asmSources :: Lens' a [FilePath]
+ asmSources :: Lens' a [SymbolicPath Pkg File]
asmSources = buildInfo . asmSources
{-# INLINE asmSources #-}
- cmmSources :: Lens' a [FilePath]
+ cmmSources :: Lens' a [SymbolicPath Pkg File]
cmmSources = buildInfo . cmmSources
{-# INLINE cmmSources #-}
- cSources :: Lens' a [FilePath]
+ cSources :: Lens' a [SymbolicPath Pkg File]
cSources = buildInfo . cSources
{-# INLINE cSources #-}
- cxxSources :: Lens' a [FilePath]
+ cxxSources :: Lens' a [SymbolicPath Pkg File]
cxxSources = buildInfo . cxxSources
{-# INLINE cxxSources #-}
- jsSources :: Lens' a [FilePath]
+ jsSources :: Lens' a [SymbolicPath Pkg File]
jsSources = buildInfo . jsSources
{-# INLINE jsSources #-}
- hsSourceDirs :: Lens' a [SymbolicPath PackageDir SourceDir]
+ hsSourceDirs :: Lens' a [SymbolicPath Pkg (Dir Source)]
hsSourceDirs = buildInfo . hsSourceDirs
{-# INLINE hsSourceDirs #-}
@@ -157,27 +159,27 @@ class HasBuildInfo a where
extraDynLibFlavours = buildInfo . extraDynLibFlavours
{-# INLINE extraDynLibFlavours #-}
- extraLibDirs :: Lens' a [String]
+ extraLibDirs :: Lens' a [SymbolicPath Pkg (Dir Lib)]
extraLibDirs = buildInfo . extraLibDirs
{-# INLINE extraLibDirs #-}
- extraLibDirsStatic :: Lens' a [String]
+ extraLibDirsStatic :: Lens' a [SymbolicPath Pkg (Dir Lib)]
extraLibDirsStatic = buildInfo . extraLibDirsStatic
{-# INLINE extraLibDirsStatic #-}
- includeDirs :: Lens' a [FilePath]
+ includeDirs :: Lens' a [SymbolicPath Pkg (Dir Include)]
includeDirs = buildInfo . includeDirs
{-# INLINE includeDirs #-}
- includes :: Lens' a [FilePath]
+ includes :: Lens' a [SymbolicPath Include File]
includes = buildInfo . includes
{-# INLINE includes #-}
- autogenIncludes :: Lens' a [FilePath]
+ autogenIncludes :: Lens' a [RelativePath Include File]
autogenIncludes = buildInfo . autogenIncludes
{-# INLINE autogenIncludes #-}
- installIncludes :: Lens' a [FilePath]
+ installIncludes :: Lens' a [RelativePath Include File]
installIncludes = buildInfo . installIncludes
{-# INLINE installIncludes #-}
diff --git a/Cabal-syntax/src/Distribution/Types/Executable.hs b/Cabal-syntax/src/Distribution/Types/Executable.hs
index bf70702f41..a2140e074a 100644
--- a/Cabal-syntax/src/Distribution/Types/Executable.hs
+++ b/Cabal-syntax/src/Distribution/Types/Executable.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -15,12 +16,13 @@ import Distribution.ModuleName
import Distribution.Types.BuildInfo
import Distribution.Types.ExecutableScope
import Distribution.Types.UnqualComponentName
+import Distribution.Utils.Path
import qualified Distribution.Types.BuildInfo.Lens as L
data Executable = Executable
{ exeName :: UnqualComponentName
- , modulePath :: FilePath
+ , modulePath :: RelativePath Source File
, exeScope :: ExecutableScope
, buildInfo :: BuildInfo
}
@@ -34,14 +36,20 @@ instance Structured Executable
instance NFData Executable where rnf = genericRnf
instance Monoid Executable where
- mempty = gmempty
+ mempty =
+ Executable
+ { exeName = mempty
+ , modulePath = unsafeMakeSymbolicPath ""
+ , exeScope = mempty
+ , buildInfo = mempty
+ }
mappend = (<>)
instance Semigroup Executable where
a <> b =
Executable
{ exeName = combineNames a b exeName "executable"
- , modulePath = combineNames a b modulePath "modulePath"
+ , modulePath = unsafeMakeSymbolicPath $ combineNames a b (getSymbolicPath . modulePath) "modulePath"
, exeScope = combine exeScope
, buildInfo = combine buildInfo
}
diff --git a/Cabal-syntax/src/Distribution/Types/Executable/Lens.hs b/Cabal-syntax/src/Distribution/Types/Executable/Lens.hs
index 73410519e9..3683522ac8 100644
--- a/Cabal-syntax/src/Distribution/Types/Executable/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/Executable/Lens.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+
module Distribution.Types.Executable.Lens
( Executable
, module Distribution.Types.Executable.Lens
@@ -11,6 +13,7 @@ import Distribution.Types.BuildInfo (BuildInfo)
import Distribution.Types.Executable (Executable)
import Distribution.Types.ExecutableScope (ExecutableScope)
import Distribution.Types.UnqualComponentName (UnqualComponentName)
+import Distribution.Utils.Path
import qualified Distribution.Types.Executable as T
@@ -18,7 +21,7 @@ exeName :: Lens' Executable UnqualComponentName
exeName f s = fmap (\x -> s{T.exeName = x}) (f (T.exeName s))
{-# INLINE exeName #-}
-modulePath :: Lens' Executable String
+modulePath :: Lens' Executable (RelativePath Source File)
modulePath f s = fmap (\x -> s{T.modulePath = x}) (f (T.modulePath s))
{-# INLINE modulePath #-}
diff --git a/Cabal-syntax/src/Distribution/Types/ForeignLib.hs b/Cabal-syntax/src/Distribution/Types/ForeignLib.hs
index 19336af203..0da75b06cc 100644
--- a/Cabal-syntax/src/Distribution/Types/ForeignLib.hs
+++ b/Cabal-syntax/src/Distribution/Types/ForeignLib.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -26,6 +27,7 @@ import Distribution.Types.BuildInfo
import Distribution.Types.ForeignLibOption
import Distribution.Types.ForeignLibType
import Distribution.Types.UnqualComponentName
+import Distribution.Utils.Path
import Distribution.Version
import Data.Monoid
@@ -53,7 +55,7 @@ data ForeignLib = ForeignLib
-- current:revision:age versioning scheme.
, foreignLibVersionLinux :: Maybe Version
-- ^ Linux library version
- , foreignLibModDefFile :: [FilePath]
+ , foreignLibModDefFile :: [RelativePath Source File]
-- ^ (Windows-specific) module definition files
--
-- This is a list rather than a maybe field so that we can flatten
diff --git a/Cabal-syntax/src/Distribution/Types/ForeignLib/Lens.hs b/Cabal-syntax/src/Distribution/Types/ForeignLib/Lens.hs
index a5905af2ff..b7f4fee319 100644
--- a/Cabal-syntax/src/Distribution/Types/ForeignLib/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/ForeignLib/Lens.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+
module Distribution.Types.ForeignLib.Lens
( ForeignLib
, module Distribution.Types.ForeignLib.Lens
@@ -12,6 +14,7 @@ import Distribution.Types.ForeignLib (ForeignLib, LibVersionInfo)
import Distribution.Types.ForeignLibOption (ForeignLibOption)
import Distribution.Types.ForeignLibType (ForeignLibType)
import Distribution.Types.UnqualComponentName (UnqualComponentName)
+import Distribution.Utils.Path
import Distribution.Version (Version)
import qualified Distribution.Types.ForeignLib as T
@@ -40,6 +43,6 @@ foreignLibVersionLinux :: Lens' ForeignLib (Maybe Version)
foreignLibVersionLinux f s = fmap (\x -> s{T.foreignLibVersionLinux = x}) (f (T.foreignLibVersionLinux s))
{-# INLINE foreignLibVersionLinux #-}
-foreignLibModDefFile :: Lens' ForeignLib [FilePath]
+foreignLibModDefFile :: Lens' ForeignLib [RelativePath Source File]
foreignLibModDefFile f s = fmap (\x -> s{T.foreignLibModDefFile = x}) (f (T.foreignLibModDefFile s))
{-# INLINE foreignLibModDefFile #-}
diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
index f8f84311ce..a3f1d0c33d 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -108,7 +109,7 @@ data PackageDescription = PackageDescription
-- ^ The version of the Cabal spec that this package description uses.
, package :: PackageIdentifier
, licenseRaw :: Either SPDX.License License
- , licenseFiles :: [SymbolicPath PackageDir LicenseFile]
+ , licenseFiles :: [RelativePath Pkg File]
, copyright :: !ShortText
, maintainer :: !ShortText
, author :: !ShortText
@@ -141,11 +142,13 @@ data PackageDescription = PackageDescription
, testSuites :: [TestSuite]
, benchmarks :: [Benchmark]
, -- files
- dataFiles :: [FilePath]
- , dataDir :: FilePath
- , extraSrcFiles :: [FilePath]
- , extraTmpFiles :: [FilePath]
- , extraDocFiles :: [FilePath]
+ dataFiles :: [RelativePath DataDir File]
+ -- ^ data file globs, relative to data directory
+ , dataDir :: SymbolicPath Pkg (Dir DataDir)
+ -- ^ data directory (may be absolute, or relative to package)
+ , extraSrcFiles :: [RelativePath Pkg File]
+ , extraTmpFiles :: [RelativePath Pkg File]
+ , extraDocFiles :: [RelativePath Pkg File]
}
deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
@@ -228,7 +231,7 @@ emptyPackageDescription =
, testSuites = []
, benchmarks = []
, dataFiles = []
- , dataDir = "."
+ , dataDir = sameDirectory
, extraSrcFiles = []
, extraTmpFiles = []
, extraDocFiles = []
diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs
index f2fdc7e57d..201b10d859 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
@@ -31,7 +32,7 @@ import Distribution.Types.SetupBuildInfo (SetupBuildInfo)
import Distribution.Types.SourceRepo (SourceRepo)
import Distribution.Types.TestSuite (TestSuite, testModules)
import Distribution.Types.TestSuite.Lens (testBuildInfo, testName)
-import Distribution.Utils.Path (LicenseFile, PackageDir, SymbolicPath)
+import Distribution.Utils.Path
import Distribution.Utils.ShortText (ShortText)
import Distribution.Version (VersionRange)
@@ -46,7 +47,7 @@ licenseRaw :: Lens' PackageDescription (Either SPDX.License License)
licenseRaw f s = fmap (\x -> s{T.licenseRaw = x}) (f (T.licenseRaw s))
{-# INLINE licenseRaw #-}
-licenseFiles :: Lens' PackageDescription [SymbolicPath PackageDir LicenseFile]
+licenseFiles :: Lens' PackageDescription [RelativePath Pkg File]
licenseFiles f s = fmap (\x -> s{T.licenseFiles = x}) (f (T.licenseFiles s))
{-# INLINE licenseFiles #-}
@@ -138,23 +139,23 @@ benchmarks :: Lens' PackageDescription [Benchmark]
benchmarks f s = fmap (\x -> s{T.benchmarks = x}) (f (T.benchmarks s))
{-# INLINE benchmarks #-}
-dataFiles :: Lens' PackageDescription [FilePath]
+dataFiles :: Lens' PackageDescription [RelativePath DataDir File]
dataFiles f s = fmap (\x -> s{T.dataFiles = x}) (f (T.dataFiles s))
{-# INLINE dataFiles #-}
-dataDir :: Lens' PackageDescription FilePath
+dataDir :: Lens' PackageDescription (SymbolicPath Pkg (Dir DataDir))
dataDir f s = fmap (\x -> s{T.dataDir = x}) (f (T.dataDir s))
{-# INLINE dataDir #-}
-extraSrcFiles :: Lens' PackageDescription [String]
+extraSrcFiles :: Lens' PackageDescription [RelativePath Pkg File]
extraSrcFiles f s = fmap (\x -> s{T.extraSrcFiles = x}) (f (T.extraSrcFiles s))
{-# INLINE extraSrcFiles #-}
-extraTmpFiles :: Lens' PackageDescription [String]
+extraTmpFiles :: Lens' PackageDescription [RelativePath Pkg File]
extraTmpFiles f s = fmap (\x -> s{T.extraTmpFiles = x}) (f (T.extraTmpFiles s))
{-# INLINE extraTmpFiles #-}
-extraDocFiles :: Lens' PackageDescription [String]
+extraDocFiles :: Lens' PackageDescription [RelativePath Pkg File]
extraDocFiles f s = fmap (\x -> s{T.extraDocFiles = x}) (f (T.extraDocFiles s))
{-# INLINE extraDocFiles #-}
diff --git a/Cabal-syntax/src/Distribution/Types/TestSuiteInterface.hs b/Cabal-syntax/src/Distribution/Types/TestSuiteInterface.hs
index a1a2879a92..37e87155e4 100644
--- a/Cabal-syntax/src/Distribution/Types/TestSuiteInterface.hs
+++ b/Cabal-syntax/src/Distribution/Types/TestSuiteInterface.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -10,6 +11,7 @@ import Prelude ()
import Distribution.ModuleName
import Distribution.Types.TestType
+import Distribution.Utils.Path
import Distribution.Version
-- | The test suite interfaces that are currently defined.
@@ -21,7 +23,7 @@ data TestSuiteInterface
-- of an executable. It returns a zero exit code for success, non-zero for
-- failure. The stdout and stderr channels may be logged. Test tooling may
-- pass command line arguments and/or connect the stdin channel to the test.
- TestSuiteExeV10 Version FilePath
+ TestSuiteExeV10 Version (RelativePath Source File)
| -- | Test interface \"detailed-0.9\". The test-suite takes the form of a
-- library containing a designated module that exports \"tests :: [Test]\".
TestSuiteLibV09 Version ModuleName
diff --git a/Cabal-syntax/src/Distribution/Utils/Path.hs b/Cabal-syntax/src/Distribution/Utils/Path.hs
index 9da89bdd7f..765b0ac614 100644
--- a/Cabal-syntax/src/Distribution/Utils/Path.hs
+++ b/Cabal-syntax/src/Distribution/Utils/Path.hs
@@ -1,31 +1,94 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
module Distribution.Utils.Path
- ( -- * Symbolic path
- SymbolicPath
+ ( -- * Symbolic path endpoints
+ FileOrDir (..)
+ , AllowAbsolute (..)
+
+ -- ** Abstract directory locations
+ , CWD
+ , Pkg
+ , Dist
+ , Source
+ , Include
+ , Lib
+ , Framework
+ , Build
+ , Artifacts
+ , PkgDB
+ , DataDir
+ , Mix
+ , Tix
+ , Tmp
+ , Response
+
+ -- * Symbolic paths
+ , RelativePath
+ , SymbolicPath
+ , SymbolicPathX -- NB: constructor not exposed, to retain type safety.
+
+ -- ** Symbolic path API
, getSymbolicPath
, sameDirectory
+ , makeRelativePathEx
+ , makeSymbolicPath
, unsafeMakeSymbolicPath
+ , coerceSymbolicPath
+ , unsafeCoerceSymbolicPath
+ , relativeSymbolicPath
+ , symbolicPathRelative_maybe
+ , interpretSymbolicPath
+
+ -- ** General filepath API
+ , (</>)
+ , (<.>)
+ , takeDirectorySymbolicPath
+ , dropExtensionsSymbolicPath
+ , replaceExtensionSymbolicPath
+ , normaliseSymbolicPath
- -- * Path ends
- , PackageDir
- , SourceDir
- , LicenseFile
- , IsDir
+ -- ** Working directory handling
+ , interpretSymbolicPathCWD
+ , absoluteWorkingDir
+ , tryMakeRelativeToWorkingDir
+
+ -- ** Module names
+ , moduleNameSymbolicPath
) where
import Distribution.Compat.Prelude
import Prelude ()
+import Data.Coerce
+
+import Distribution.ModuleName (ModuleName)
+import qualified Distribution.ModuleName as ModuleName
+ ( toFilePath
+ )
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Utils.Generic (isAbsoluteOnAnyPlatform)
import qualified Distribution.Compat.CharParsing as P
--- import qualified Text.PrettyPrint as Disp
+import qualified System.Directory as Directory
+import qualified System.FilePath as FilePath
+
+import Data.Kind
+ ( Type
+ )
+import GHC.Stack
+ ( HasCallStack
+ )
-------------------------------------------------------------------------------
@@ -33,30 +96,263 @@ import qualified Distribution.Compat.CharParsing as P
-------------------------------------------------------------------------------
--- | Symbolic paths.
+{- Note [Symbolic paths]
+~~~~~~~~~~~~~~~~~~~~~~~~
+We want functions within the Cabal library to support getting the working
+directory from their arguments, rather than retrieving it from the current
+directory, which depends on the the state of the current process
+(via getCurrentDirectory).
+
+With such a constraint, to ensure correctness we need to know, for each relative
+filepath, whether it is relative to the passed in working directory or to the
+current working directory. We achieve this with the following API:
+
+ - newtype SymbolicPath from to
+ - getSymbolicPath :: SymbolicPath from to -> FilePath
+ - interpretSymbolicPath
+ :: Maybe (SymbolicPath CWD (Dir from)) -> SymbolicPath from to -> FilePath
+
+Note that, in the type @SymbolicPath from to@, @from@ is the name of a directory,
+whereas @to@ is either @Dir toDir@ or @File@. For example, a source directory
+typically has the type @SymbolicPath Pkg (Dir Source)@, while a source
+file has a type such as @SymbolicPath "Source" File@.
+
+Here, a symbolic path refers to an **uninterpreted** file path, i.e. any
+passed in working directory **has not** been taken into account.
+Whenever we see a symbolic path, it is a sign we must take into account this
+working directory in some way.
+Thus, whenever we interact with the file system, we do the following:
+
+ - in a direct interaction (e.g. `doesFileExist`), we interpret the
+ path relative to a working directory argument, e.g.
+
+ doCheck :: Maybe (SymbolicPath CWD (Dir from))
+ -> SymbolicPath from File
+ -> Bool
+ doCheck mbWorkDir file = doesFileExist $ interpretSymbolicPath mbWorkDir file
+
+ - when invoking a sub-process (such as GHC), we ensure that the working directory
+ of the sub-process is the same as the passed-in working directory, in which
+ case we interpret the symbolic paths by using `interpretSymbolicPathCWD`:
+
+ callGhc :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath (Dir Pkg) File
+ -> IO ()
+ callGhc mbWorkDir inputFile =
+ runProgramInvocation $
+ programInvocationCwd mbWorkDir ghcProg [interpretSymbolicPathCWD inputFile]
+
+In practice, we often use:
+
+ -- Interpret a symbolic path with respect to the working directory argument
+ -- @'mbWorkDir' :: Maybe (SymbolicPath CWD (Dir Pkg))@.
+ i :: SymbolicPath Pkg to -> FilePath
+ i = interpretSymbolicPath mbWorkDir
+
+ -- Interpret a symbolic path, provided that the current working directory
+ -- is the package directory.
+ u :: SymbolicPath Pkg to -> FilePath
+ u = interpretSymbolicPathCWD
+
+Note [Symbolic relative paths]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+This module defines:
+
+ data kind AllowAbsolute = AllowAbsolute | OnlyRelative
+ data kind FileOrDir = File | Dir Symbol
+
+ type SymbolicPathX :: AllowAbsolute -> Symbol -> FileOrDir -> Type
+ newtype SymbolicPathX allowAbsolute from to = SymbolicPath FilePath
+
+ type RelativePath = SymbolicPathX 'OnlyRelative
+ type SymbolicPath = SymbolicPathX 'AllowAbsolute
+
+A 'SymbolicPath' is thus a symbolic path that is allowed to be absolute, whereas
+a 'RelativePath' is a symbolic path that is additionally required to be relative.
+
+This distinction allows us to keep track of which filepaths must be kept
+relative.
+-}
+
+-- | A type-level symbolic name, to an abstract file or directory
+-- (e.g. the Cabal package directory).
+data FileOrDir
+ = -- | A file (with no further information).
+ File
+ | -- | The abstract name of a directory or category of directories,
+ -- e.g. the package directory or a source directory.
+ Dir Type
+
+-- | Is this symbolic path allowed to be absolute, or must it be relative?
+data AllowAbsolute
+ = -- | The path may be absolute, or it may be relative.
+ AllowAbsolute
+ | -- | The path must be relative.
+ OnlyRelative
+
+-- | A symbolic path, possibly relative to an abstract location specified
+-- by the @from@ type parameter.
--
--- These paths are system independent and relative.
--- They are *symbolic* which means we cannot perform any 'IO'
--- until we interpret them.
-newtype SymbolicPath from to = SymbolicPath FilePath
+-- They are *symbolic*, which means we cannot perform any 'IO'
+-- until we interpret them (using e.g. 'interpretSymbolicPath').
+newtype SymbolicPathX (allowAbsolute :: AllowAbsolute) (from :: Type) (to :: FileOrDir)
+ = SymbolicPath FilePath
deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
-instance Binary (SymbolicPath from to)
-instance (Typeable from, Typeable to) => Structured (SymbolicPath from to)
-instance NFData (SymbolicPath from to) where rnf = genericRnf
+type role SymbolicPathX nominal nominal nominal
--- | Extract underlying 'FilePath'.
+-- | A symbolic relative path, relative to an abstract location specified
+-- by the @from@ type parameter.
--
--- Avoid using this in new code.
-getSymbolicPath :: SymbolicPath from to -> FilePath
+-- They are *symbolic*, which means we cannot perform any 'IO'
+-- until we interpret them (using e.g. 'interpretSymbolicPath').
+type RelativePath = SymbolicPathX 'OnlyRelative
+
+-- | A symbolic path which is allowed to be absolute.
+--
+-- They are *symbolic*, which means we cannot perform any 'IO'
+-- until we interpret them (using e.g. 'interpretSymbolicPath').
+type SymbolicPath = SymbolicPathX 'AllowAbsolute
+
+instance Binary (SymbolicPathX allowAbsolute from to)
+instance
+ (Typeable allowAbsolute, Typeable from, Typeable to)
+ => Structured (SymbolicPathX allowAbsolute from to)
+instance NFData (SymbolicPathX allowAbsolute from to) where rnf = genericRnf
+
+-- | Extract the 'FilePath' underlying a 'SymbolicPath' or 'RelativePath',
+-- without interpreting it.
+--
+-- Use this function e.g. to validate the underlying filepath.
+--
+-- When interacting with the file system, you should instead use
+-- 'interpretSymbolicPath' or 'interpretSymbolicPathCWD'.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+getSymbolicPath :: SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath (SymbolicPath p) = p
-sameDirectory :: (IsDir from, IsDir to) => SymbolicPath from to
+-- | A symbolic path from a directory to itself.
+sameDirectory :: SymbolicPathX allowAbsolute from (Dir to)
sameDirectory = SymbolicPath "."
--- | Make 'SymbolicPath' without performing any checks.
-unsafeMakeSymbolicPath :: FilePath -> SymbolicPath from to
-unsafeMakeSymbolicPath = SymbolicPath
+-- | Make a 'RelativePath', ensuring the path is not absolute,
+-- but performing no further checks.
+makeRelativePathEx :: HasCallStack => FilePath -> RelativePath from to
+makeRelativePathEx fp
+ | isAbsoluteOnAnyPlatform fp =
+ error $ "Cabal internal error: makeRelativePathEx: absolute path " ++ fp
+ | otherwise =
+ SymbolicPath fp
+
+-- | Make a 'SymbolicPath', which may be relative or absolute.
+makeSymbolicPath :: FilePath -> SymbolicPath from to
+makeSymbolicPath fp = SymbolicPath fp
+
+-- | Make a 'SymbolicPath' which may be relative or absolute,
+-- without performing any checks.
+--
+-- Avoid using this function in new code.
+unsafeMakeSymbolicPath :: FilePath -> SymbolicPathX allowAbs from to
+unsafeMakeSymbolicPath fp = SymbolicPath fp
+
+-- | Like 'System.FilePath.takeDirectory', for symbolic paths.
+takeDirectorySymbolicPath :: SymbolicPathX allowAbsolute from File -> SymbolicPathX allowAbsolute from (Dir to')
+takeDirectorySymbolicPath (SymbolicPath fp) = SymbolicPath (FilePath.takeDirectory fp)
+
+-- | Like 'System.FilePath.dropExtensions', for symbolic paths.
+dropExtensionsSymbolicPath :: SymbolicPathX allowAbsolute from File -> SymbolicPathX allowAbsolute from File
+dropExtensionsSymbolicPath (SymbolicPath fp) = SymbolicPath (FilePath.dropExtensions fp)
+
+-- | Like 'System.FilePath.replaceExtension', for symbolic paths.
+replaceExtensionSymbolicPath :: SymbolicPathX allowAbsolute from File -> String -> SymbolicPathX allowAbsolute from File
+replaceExtensionSymbolicPath (SymbolicPath fp) ext = SymbolicPath (FilePath.replaceExtension fp ext)
+
+-- | Like 'System.FilePath.normalise', for symbolic paths.
+normaliseSymbolicPath :: SymbolicPathX allowAbsolute from to -> SymbolicPathX allowAbsolute from to
+normaliseSymbolicPath (SymbolicPath fp) = SymbolicPath (FilePath.normalise fp)
+
+-- | Retrieve the relative symbolic path to a Haskell module.
+moduleNameSymbolicPath :: ModuleName -> SymbolicPathX allowAbsolute Source File
+moduleNameSymbolicPath modNm = SymbolicPath $ ModuleName.toFilePath modNm
+
+-- | Interpret a symbolic path with respect to the given directory.
+--
+-- Use this function before directly interacting with the file system in order
+-- to take into account a working directory argument.
+--
+-- NB: when invoking external programs (such as @GHC@), it is preferable to set
+-- the working directory of the process and use 'interpretSymbolicPathCWD'
+-- rather than calling this function, as this function will turn relative paths
+-- into absolute paths if the working directory is an absolute path.
+-- This can degrade error messages, or worse, break the behaviour entirely
+-- (because the program might expect certain paths to be relative).
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+interpretSymbolicPath :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPathX allowAbsolute Pkg to -> FilePath
+interpretSymbolicPath mbWorkDir (SymbolicPath p) =
+ -- Note that this properly handles an absolute symbolic path,
+ -- because if @q@ is absolute, then @p </> q = q@.
+ maybe p ((</> p) . getSymbolicPath) mbWorkDir
+
+-- | Interpret a symbolic path, **under the assumption that the working
+-- directory is the package directory**.
+--
+-- Use 'interpretSymbolicPath' instead if you need to take into account a
+-- working directory argument before directly interacting with the file system.
+--
+-- Use this function instead of 'interpretSymbolicPath' when invoking a child
+-- process: set the working directory of the sub-process, and use this function,
+-- e.g.:
+--
+-- > callGhc :: Maybe (SymbolicPath CWD (Dir Pkg))
+-- > -> SymbolicPath (Dir Pkg) File
+-- > -> IO ()
+-- > callGhc mbWorkDir inputFile =
+-- > runProgramInvocation $
+-- > programInvocationCwd mbWorkDir ghcProg [interpretSymbolicPathCWD inputFile]
+--
+-- In this example, 'programInvocationCwd' sets the working directory, so it is
+-- appropriate to use 'interpretSymbolicPathCWD' to provide its arguments.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+interpretSymbolicPathCWD :: SymbolicPathX allowAbsolute Pkg to -> FilePath
+interpretSymbolicPathCWD (SymbolicPath p) = p
+
+-- | Change what a symbolic path is pointing to.
+coerceSymbolicPath :: SymbolicPathX allowAbsolute from to1 -> SymbolicPathX allowAbsolute from to2
+coerceSymbolicPath = coerce
+
+-- | Change both what a symbolic path is pointing from and pointing to.
+--
+-- Avoid using this in new code.
+unsafeCoerceSymbolicPath :: SymbolicPathX allowAbsolute from1 to1 -> SymbolicPathX allowAbsolute from2 to2
+unsafeCoerceSymbolicPath = coerce
+
+-- | Weakening: convert a relative symbolic path to a symbolic path,
+-- \"forgetting\" that it is relative.
+relativeSymbolicPath :: RelativePath from to -> SymbolicPath from to
+relativeSymbolicPath (SymbolicPath fp) = SymbolicPath fp
+
+-- | Is this symbolic path a relative symbolic path?
+symbolicPathRelative_maybe :: SymbolicPath from to -> Maybe (RelativePath from to)
+symbolicPathRelative_maybe (SymbolicPath fp) =
+ if isAbsoluteOnAnyPlatform fp
+ then Nothing
+ else Just $ SymbolicPath fp
+
+-- | Absolute path to the current working directory.
+absoluteWorkingDir :: Maybe (SymbolicPath CWD to) -> IO FilePath
+absoluteWorkingDir Nothing = Directory.getCurrentDirectory
+absoluteWorkingDir (Just wd) = Directory.makeAbsolute $ getSymbolicPath wd
+
+-- | Try to make a path relative to the current working directory.
+--
+-- NB: this function may fail to make the path relative.
+tryMakeRelativeToWorkingDir :: Maybe (SymbolicPath CWD (Dir dir)) -> SymbolicPath dir to -> IO (SymbolicPath dir to)
+tryMakeRelativeToWorkingDir mbWorkDir (SymbolicPath fp) = do
+ wd <- absoluteWorkingDir mbWorkDir
+ return $ SymbolicPath (FilePath.makeRelative wd fp)
-------------------------------------------------------------------------------
@@ -64,7 +360,7 @@ unsafeMakeSymbolicPath = SymbolicPath
-------------------------------------------------------------------------------
-instance Parsec (SymbolicPath from to) where
+instance Parsec (SymbolicPathX 'OnlyRelative from to) where
parsec = do
token <- parsecToken
if null token
@@ -72,9 +368,16 @@ instance Parsec (SymbolicPath from to) where
else
if isAbsoluteOnAnyPlatform token
then P.unexpected "absolute FilePath"
- else return (SymbolicPath token) -- TODO: normalise
+ else return (SymbolicPath token)
-instance Pretty (SymbolicPath from to) where
+instance Parsec (SymbolicPathX 'AllowAbsolute from to) where
+ parsec = do
+ token <- parsecToken
+ if null token
+ then P.unexpected "empty FilePath"
+ else return (SymbolicPath token)
+
+instance Pretty (SymbolicPathX allowAbsolute from to) where
pretty = showFilePath . getSymbolicPath
-------------------------------------------------------------------------------
@@ -83,33 +386,116 @@ instance Pretty (SymbolicPath from to) where
-------------------------------------------------------------------------------
--- TODO
--- infixr 5 <//>
+infixr 7 <.>
+
+-- | Types that support 'System.FilePath.<.>'.
+class FileLike p where
+ -- | Like 'System.FilePath.<.>', but also supporting symbolic paths.
+ (<.>) :: p -> String -> p
+
+instance FileLike FilePath where
+ (<.>) = (FilePath.<.>)
+
+instance p ~ File => FileLike (SymbolicPathX allowAbsolute dir p) where
+ SymbolicPath p <.> ext = SymbolicPath (p <.> ext)
+
+infixr 5 </>
+
+-- | Types that support 'System.FilePath.</>'.
+class PathLike p q r | q r -> p, p r -> q, p q -> r where
+ -- | Like 'System.FilePath.</>', but also supporting symbolic paths.
+ (</>) :: p -> q -> r
+
+instance PathLike FilePath FilePath FilePath where
+ (</>) = (FilePath.</>)
+
+-- | This instance ensures we don't accidentally discard a symbolic path
+-- in a 'System.FilePath.</>' operation due to the second path being absolute.
--
--- -- | Path composition
--- --
--- -- We don't reuse @</>@ name to not clash with "System.FilePath".
--- --
--- (<//>) :: path a b -> path b c -> path a c
+-- (Recall that @a </> b = b@ whenever @b@ is absolute.)
+instance
+ (b1 ~ 'Dir b2, a3 ~ a1, c2 ~ c3, midAbsolute ~ OnlyRelative)
+ => PathLike
+ (SymbolicPathX allowAbsolute a1 b1)
+ (SymbolicPathX midAbsolute b2 c2)
+ (SymbolicPathX allowAbsolute a3 c3)
+ where
+ SymbolicPath p1 </> SymbolicPath p2 = SymbolicPath (p1 </> p2)
--------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
+-- Abstract directory locations.
--- * Path ends
+-- | Abstract directory: current working directory.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data CWD
--------------------------------------------------------------------------------
+-- | Abstract directory: package directory (e.g. a directory containing the @.cabal@ file).
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Pkg
+
+-- | Abstract directory: dist directory (e.g. @dist-newstyle@).
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Dist
+
+-- | Abstract directory: source directory (a search directory for source files).
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Source
+
+-- | Abstract directory: include directory (a search directory for CPP includes like header files, e.g. with @ghc -I@).
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Include
+
+-- | Abstract directory: search directory for extra libraries.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Lib
+
+-- | Abstract directory: MacOS framework directory.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Framework
+
+-- | Abstract directory: build directory.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Build
+
+-- | Abstract directory: directory for build artifacts, such as documentation or @.hie@ files.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Artifacts
+
+-- | Abstract directory: package database directory.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data PkgDB
--- | Class telling that index is for directories.
-class IsDir dir
+-- | Abstract directory: data files directory.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data DataDir
-data PackageDir deriving (Typeable)
-data SourceDir deriving (Typeable)
+-- | Abstract directory: directory for HPC @.mix@ files.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Mix
-data LicenseFile deriving (Typeable)
+-- | Abstract directory: directory for HPC @.tix@ files.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Tix
--- These instances needs to be derived standalone at least on GHC-7.6
-deriving instance Data PackageDir
-deriving instance Data SourceDir
-deriving instance Data LicenseFile
+-- | Abstract directory: a temporary directory.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Tmp
-instance IsDir PackageDir
-instance IsDir SourceDir
+-- | Abstract directory: directory for response files.
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path.
+data Response
diff --git a/Cabal-tests/Cabal-tests.cabal b/Cabal-tests/Cabal-tests.cabal
index 7e9f5e5dbd..858ce659c4 100644
--- a/Cabal-tests/Cabal-tests.cabal
+++ b/Cabal-tests/Cabal-tests.cabal
@@ -22,7 +22,7 @@ source-repository head
library
hs-source-dirs: lib
exposed-modules: Test.Utils.TempTestDir
- build-depends: base, directory, Cabal
+ build-depends: base, directory, Cabal, filepath
-- Small, fast running tests.
test-suite unit-tests
diff --git a/Cabal-tests/lib/Test/Utils/TempTestDir.hs b/Cabal-tests/lib/Test/Utils/TempTestDir.hs
index 79e8635889..e3155eb839 100644
--- a/Cabal-tests/lib/Test/Utils/TempTestDir.hs
+++ b/Cabal-tests/lib/Test/Utils/TempTestDir.hs
@@ -15,9 +15,7 @@ import Control.Monad (when)
import System.Directory
import System.IO.Error
-#if !(MIN_VERSION_directory(1,2,7))
import System.FilePath ((</>))
-#endif
import qualified System.Info (os)
-- | Much like 'withTemporaryDirectory' but with a number of hacks to make
@@ -26,7 +24,8 @@ withTestDir :: Verbosity -> String -> (FilePath -> IO a) -> IO a
withTestDir verbosity template action = do
systmpdir <- getTemporaryDirectory
bracket
- (createTempDirectory systmpdir template)
+ ( do { tmpRelDir <- createTempDirectory systmpdir template
+ ; return $ systmpdir </> tmpRelDir } )
(removeDirectoryRecursiveHack verbosity)
action
diff --git a/Cabal-tests/tests/NoThunks.hs b/Cabal-tests/tests/NoThunks.hs
index da422e37c5..6a81475dc0 100644
--- a/Cabal-tests/tests/NoThunks.hs
+++ b/Cabal-tests/tests/NoThunks.hs
@@ -24,7 +24,7 @@ import Distribution.ModuleName (ModuleName)
import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
import Distribution.SPDX (License, LicenseExceptionId, LicenseExpression, LicenseId, LicenseRef, SimpleLicenseExpression)
import Distribution.System (Arch, OS)
-import Distribution.Utils.Path (SymbolicPath)
+import Distribution.Utils.Path (SymbolicPathX)
import Distribution.Utils.ShortText (ShortText)
import Distribution.Version (Version, VersionRange)
import Language.Haskell.Extension (Extension, KnownExtension, Language)
@@ -121,7 +121,8 @@ instance NoThunks ShortText where
instance NoThunks a => NoThunks (PerCompilerFlavor a)
-instance (Typeable a, Typeable b) => NoThunks (SymbolicPath a b)
+instance (Typeable allowAbs, Typeable from, Typeable to)
+ => NoThunks (SymbolicPathX allowAbs from to)
deriving via (OnlyCheckWhnf LicenseId) instance NoThunks LicenseId
deriving via (OnlyCheckWhnf LicenseExceptionId) instance NoThunks LicenseExceptionId
diff --git a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr
index d754955f46..3d03421210 100644
--- a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr
@@ -63,7 +63,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
@@ -188,7 +188,8 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "tests/test_Octree.hs",
+ (SymbolicPath
+ "tests/test_Octree.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
@@ -289,7 +290,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "README.lhs",
+ (SymbolicPath "README.lhs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/anynone.expr b/Cabal-tests/tests/ParserTests/regressions/anynone.expr
index 17e61add69..3191425d60 100644
--- a/Cabal-tests/tests/ParserTests/regressions/anynone.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/anynone.expr
@@ -29,7 +29,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
diff --git a/Cabal-tests/tests/ParserTests/regressions/big-version.expr b/Cabal-tests/tests/ParserTests/regressions/big-version.expr
index 943e723c19..e677de2062 100644
--- a/Cabal-tests/tests/ParserTests/regressions/big-version.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/big-version.expr
@@ -31,7 +31,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
diff --git a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr
index 874b496426..f6ffe291e5 100644
--- a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr
@@ -41,7 +41,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
@@ -307,7 +307,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "Tests.hs",
+ (SymbolicPath "Tests.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/common.expr b/Cabal-tests/tests/ParserTests/regressions/common.expr
index 9a1c7a53df..e0eb4a1dde 100644
--- a/Cabal-tests/tests/ParserTests/regressions/common.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/common.expr
@@ -44,7 +44,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
@@ -137,7 +137,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "Tests.hs",
+ (SymbolicPath "Tests.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/common2.expr b/Cabal-tests/tests/ParserTests/regressions/common2.expr
index f74c75224e..b3cb004eec 100644
--- a/Cabal-tests/tests/ParserTests/regressions/common2.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/common2.expr
@@ -40,7 +40,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
@@ -413,7 +413,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "Tests.hs",
+ (SymbolicPath "Tests.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/common3.expr b/Cabal-tests/tests/ParserTests/regressions/common3.expr
index 91c43cb075..21b200baa7 100644
--- a/Cabal-tests/tests/ParserTests/regressions/common3.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/common3.expr
@@ -44,7 +44,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
@@ -137,7 +137,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "Tests.hs",
+ (SymbolicPath "Tests.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.cabal b/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.cabal
index 9fb2f39cbe..6c4cf929dc 100644
--- a/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.cabal
+++ b/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.cabal
@@ -71,7 +71,7 @@ library
-- this is forbidden by a parser
-- hs-source-dirs: /var/secret/source
- -- this is the only case catched by Cabal-3.0.2.0
+ -- this is the only case caught by Cabal-3.0.2.0
hs-source-dirs: ../../assoc/src
-- globs not allowed in field
diff --git a/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check b/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check
index 341645e243..16464335f7 100644
--- a/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check
+++ b/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check
@@ -8,7 +8,7 @@
[malformed-relative-path] 'hs-source-dirs: src/../src' is not a good relative path: "parent directory segment: .."
[malformed-relative-path] 'license-file: .' is not a good relative path: "trailing dot segment"
[malformed-relative-path] 'license-file: LICENSE2/' is not a good relative path: "trailing slash"
-[invalid-path-win] The path 'C:foo/bar' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$".
-[invalid-path-win] The path 'c/**/*.c' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$".
-[invalid-path-win] The path 'files/<>/*.txt' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$".
-[invalid-path-win] The path '||s' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$".
+[invalid-path-win] The path 'C:foo/bar' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|", and there are a few reserved names including "aux", "nul", "con", "prn", "com{1-9}", "lpt{1-9}" and "clock$".
+[invalid-path-win] The path 'c/**/*.c' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|", and there are a few reserved names including "aux", "nul", "con", "prn", "com{1-9}", "lpt{1-9}" and "clock$".
+[invalid-path-win] The path 'files/<>/*.txt' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|", and there are a few reserved names including "aux", "nul", "con", "prn", "com{1-9}", "lpt{1-9}" and "clock$".
+[invalid-path-win] The path '||s' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|", and there are a few reserved names including "aux", "nul", "con", "prn", "com{1-9}", "lpt{1-9}" and "clock$".
diff --git a/Cabal-tests/tests/ParserTests/regressions/elif.expr b/Cabal-tests/tests/ParserTests/regressions/elif.expr
index b9ea1f18bc..1315d68946 100644
--- a/Cabal-tests/tests/ParserTests/regressions/elif.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/elif.expr
@@ -1,184 +1,195 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [CondBranch
- {condBranchCondition = `Var (OS Linux)`,
- condBranchIfFalse = Nothing,
- condBranchIfTrue = CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName
- "unix")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor
- []
- [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor
- []
- [],
- sharedOptions = PerCompilerFlavor
- []
- [],
- staticOptions = PerCompilerFlavor
- []
- [],
- targetBuildDepends = [Dependency
- (PackageName
- "unix")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}}}],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [ModuleName "ElseIf"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "elif", pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [SourceRepo
- {repoBranch = Nothing,
- repoKind = RepoHead,
- repoLocation = Just "https://github.com/hvr/-.git",
- repoModule = Nothing,
- repoSubdir = Nothing,
- repoTag = Nothing,
- repoType = Just (KnownRepoType Git)}],
- specVersion = CabalSpecV1_10,
- stability = "",
- subLibraries = [],
- synopsis = "The elif demo",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV1_10,
+ package = PackageIdentifier {
+ pkgName = PackageName "elif",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [
+ SourceRepo {
+ repoKind = RepoHead,
+ repoType = Just
+ (KnownRepoType Git),
+ repoLocation = Just
+ "https://github.com/hvr/-.git",
+ repoModule = Nothing,
+ repoBranch = Nothing,
+ repoTag = Nothing,
+ repoSubdir = Nothing}],
+ synopsis = "The elif demo",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName "ElseIf"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = [
+ CondBranch {
+ condBranchCondition =
+ `Var (OS Linux)`,
+ condBranchIfTrue = CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "unix")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "unix")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []},
+ condBranchIfFalse = Nothing}]},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/elif2.expr b/Cabal-tests/tests/ParserTests/regressions/elif2.expr
index b4e7be7dc7..61f2177cba 100644
--- a/Cabal-tests/tests/ParserTests/regressions/elif2.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/elif2.expr
@@ -1,393 +1,399 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [CondBranch
- {condBranchCondition = `Var (OS Linux)`,
- condBranchIfFalse = Just
- CondNode
- {condTreeComponents = [CondBranch
- {condBranchCondition = `Var (OS Windows)`,
- condBranchIfFalse = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = False,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor
- []
- [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor
- []
- [],
- sharedOptions = PerCompilerFlavor
- []
- [],
- staticOptions = PerCompilerFlavor
- []
- [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condBranchIfTrue = CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName
- "Win32")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor
- []
- [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor
- []
- [],
- sharedOptions = PerCompilerFlavor
- []
- [],
- staticOptions = PerCompilerFlavor
- []
- [],
- targetBuildDepends = [Dependency
- (PackageName
- "Win32")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}}}],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor
- []
- [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor
- []
- [],
- sharedOptions = PerCompilerFlavor
- []
- [],
- staticOptions = PerCompilerFlavor
- []
- [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condBranchIfTrue = CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName
- "unix")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor
- []
- [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor
- []
- [],
- sharedOptions = PerCompilerFlavor
- []
- [],
- staticOptions = PerCompilerFlavor
- []
- [],
- targetBuildDepends = [Dependency
- (PackageName
- "unix")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}}}],
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV2_2,
+ package = PackageIdentifier {
+ pkgName = PackageName "elif",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [
+ SourceRepo {
+ repoKind = RepoHead,
+ repoType = Just
+ (KnownRepoType Git),
+ repoLocation = Just
+ "https://github.com/hvr/-.git",
+ repoModule = Nothing,
+ repoBranch = Nothing,
+ repoTag = Nothing,
+ repoSubdir = Nothing}],
+ synopsis = "The elif demo",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName "ElseIf"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = [
+ CondBranch {
+ condBranchCondition =
+ `Var (OS Linux)`,
+ condBranchIfTrue = CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "unix")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "unix")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []},
+ condBranchIfFalse = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = [
+ CondBranch {
+ condBranchCondition =
+ `Var (OS Windows)`,
+ condBranchIfTrue = CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "Win32")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "Win32")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []},
+ condBranchIfFalse = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = False,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [ModuleName "ElseIf"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "elif", pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [SourceRepo
- {repoBranch = Nothing,
- repoKind = RepoHead,
- repoLocation = Just "https://github.com/hvr/-.git",
- repoModule = Nothing,
- repoSubdir = Nothing,
- repoTag = Nothing,
- repoType = Just (KnownRepoType Git)}],
- specVersion = CabalSpecV2_2,
- stability = "",
- subLibraries = [],
- synopsis = "The elif demo",
- testSuites = [],
- testedWith = []}}
+ condTreeComponents = []}}]}}]},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr b/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr
index f544742992..e1b125e7a3 100644
--- a/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr
@@ -1,130 +1,144 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (UnionVersionRanges
- (LaterVersion (mkVersion [4, 4]))
- (ThisVersion (mkVersion [4, 4])))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [ModuleName "Data.Encoding"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor
- ["-Wall",
- "-O2",
- "-threaded",
- "-rtsopts",
- "-with-rtsopts=-N1 -A64m"]
- [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (UnionVersionRanges
- (LaterVersion
- (mkVersion
- [4, 4]))
- (ThisVersion
- (mkVersion
- [4, 4])))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Nothing,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = ["README.md", "--", "--"],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "encoding",
- pkgVersion = mkVersion [0, 8]},
- pkgUrl = "",
- setupBuildInfo = Just
- SetupBuildInfo
- {defaultSetupDepends = False,
- setupDepends = [Dependency
- (PackageName "base")
- (EarlierVersion (mkVersion [5]))
- mainLibSet,
- Dependency
- (PackageName "ghc-prim")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet]},
- sourceRepos = [],
- specVersion = CabalSpecV1_12,
- stability = "",
- subLibraries = [],
- synopsis = "",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV1_12,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "encoding",
+ pkgVersion = mkVersion [0, 8]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis = "",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Nothing,
+ setupBuildInfo = Just
+ SetupBuildInfo {
+ setupDepends = [
+ Dependency
+ (PackageName "base")
+ (EarlierVersion (mkVersion [5]))
+ mainLibSet,
+ Dependency
+ (PackageName "ghc-prim")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ defaultSetupDepends = False},
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [
+ SymbolicPath "README.md",
+ SymbolicPath "--",
+ SymbolicPath "--"],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName "Data.Encoding"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ [
+ "-Wall",
+ "-O2",
+ "-threaded",
+ "-rtsopts",
+ "-with-rtsopts=-N1 -A64m"]
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (UnionVersionRanges
+ (LaterVersion
+ (mkVersion [4, 4]))
+ (ThisVersion
+ (mkVersion [4, 4])))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (UnionVersionRanges
+ (LaterVersion
+ (mkVersion [4, 4]))
+ (ThisVersion
+ (mkVersion [4, 4])))
+ mainLibSet],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr
index b549eb51f7..9084371a61 100644
--- a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr
@@ -119,9 +119,9 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [
- "CHANGELOG.md"],
+ SymbolicPath "CHANGELOG.md"],
extraTmpFiles = [],
extraDocFiles = []},
gpdScannedVersion = Nothing,
@@ -651,7 +651,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "doctests.hs",
+ (SymbolicPath "doctests.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
@@ -746,7 +746,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "Example.hs",
+ (SymbolicPath "Example.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr b/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr
index 92b76bbb0e..346af927d1 100644
--- a/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr
@@ -51,7 +51,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
@@ -9501,7 +9501,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"isdefinite-cpu",
- modulePath = "Noop.hs",
+ modulePath = SymbolicPath
+ "Noop.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -9605,7 +9606,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"isdefinite-gpu",
- modulePath = "Noop.hs",
+ modulePath = SymbolicPath
+ "Noop.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -9709,7 +9711,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"isdefinite",
- modulePath = "Noop.hs",
+ modulePath = SymbolicPath
+ "Noop.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -9802,7 +9805,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"memcheck",
- modulePath = "Memcheck.hs",
+ modulePath = SymbolicPath
+ "Memcheck.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -9898,7 +9902,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "Spec.hs",
+ (SymbolicPath "Spec.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr b/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr
index bcb1f1f5bb..fba99528b5 100644
--- a/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr
@@ -1,108 +1,119 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [ModuleName "ElseIf"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "hidden-main-lib",
- pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV3_0,
- stability = "",
- subLibraries = [],
- synopsis = "main lib have to be visible",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV3_0,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "hidden-main-lib",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis =
+ "main lib have to be visible",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName "ElseIf"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation.expr b/Cabal-tests/tests/ParserTests/regressions/indentation.expr
index 2b747fd1b8..e5b106dc5c 100644
--- a/Cabal-tests/tests/ParserTests/regressions/indentation.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/indentation.expr
@@ -1,109 +1,120 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Nothing,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = concat
- ["* foo\n",
- "\n",
- " * foo-bar\n",
- "\n",
- " * foo-baz\n",
- "\n",
- ".\n",
- ".\n",
- ".\n",
- "some dots"],
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "indentation",
- pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV3_0,
- stability = "",
- subLibraries = [],
- synopsis = "",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV3_0,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "indentation",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis = "",
+ description = concat
+ [
+ "* foo\n",
+ "\n",
+ " * foo-bar\n",
+ "\n",
+ " * foo-baz\n",
+ "\n",
+ ".\n",
+ ".\n",
+ ".\n",
+ "some dots"],
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Nothing,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation2.expr b/Cabal-tests/tests/ParserTests/regressions/indentation2.expr
index 56f23f26d0..46f24105f0 100644
--- a/Cabal-tests/tests/ParserTests/regressions/indentation2.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/indentation2.expr
@@ -1,99 +1,113 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Nothing,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = concat ["foo\n", " indent2\n", " indent4"],
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "indentation",
- pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV3_0,
- stability = "",
- subLibraries = [],
- synopsis = "",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV3_0,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "indentation",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis = "",
+ description = concat
+ [
+ "foo\n",
+ " indent2\n",
+ " indent4"],
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Nothing,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation3.expr b/Cabal-tests/tests/ParserTests/regressions/indentation3.expr
index f7ed51e79f..0191d063f6 100644
--- a/Cabal-tests/tests/ParserTests/regressions/indentation3.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/indentation3.expr
@@ -1,104 +1,115 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Nothing,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = concat
- ["indent0\n",
- "\n",
- " indent2\n",
- "indent0\n",
- " indent2"],
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "indentation",
- pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV3_0,
- stability = "",
- subLibraries = [],
- synopsis = "",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV3_0,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "indentation",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis = "",
+ description = concat
+ [
+ "indent0\n",
+ "\n",
+ " indent2\n",
+ "indent0\n",
+ " indent2"],
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Nothing,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr
index be5e955442..07c04ec6cb 100644
--- a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr
@@ -31,7 +31,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
@@ -48,7 +48,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"flag-test-exe",
- modulePath = "FirstMain.hs",
+ modulePath = SymbolicPath
+ "FirstMain.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -132,7 +133,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "SecondMain.hs",
+ (SymbolicPath "SecondMain.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr
index 996d49e662..2ff7de7917 100644
--- a/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr
@@ -29,7 +29,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr
index aa4f6492cd..43c345dd17 100644
--- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr
@@ -29,7 +29,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
@@ -204,7 +204,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"demo-a",
- modulePath = "Main.hs",
+ modulePath = SymbolicPath
+ "Main.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -283,7 +284,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"demo-b",
- modulePath = "Main.hs",
+ modulePath = SymbolicPath
+ "Main.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr
index 208e17e41f..e660685162 100644
--- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr
@@ -29,7 +29,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
@@ -204,7 +204,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"demo-a",
- modulePath = "Main.hs",
+ modulePath = SymbolicPath
+ "Main.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -293,7 +294,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"demo-b",
- modulePath = "Main.hs",
+ modulePath = SymbolicPath
+ "Main.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr
index 5cf5a7c1db..7435b0d59b 100644
--- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr
@@ -29,7 +29,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr
index b436742cd0..a221632efa 100644
--- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr
@@ -29,7 +29,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-774.expr b/Cabal-tests/tests/ParserTests/regressions/issue-774.expr
index af63d8cd9f..e1ffb85dce 100644
--- a/Cabal-tests/tests/ParserTests/regressions/issue-774.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/issue-774.expr
@@ -1,111 +1,122 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [ModuleName "Issue"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor
- ["-Wall",
- "-threaded",
- "-with-rtsopts=-N -s -M1G -c",
- "-rtsopts"]
- [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = concat
- ["Here is some C code:\n",
- "\n",
- "> for(i = 0; i < 100; i++) {\n",
- "> printf(\"%d\\n\",i);\n",
- "> }\n",
- "\n",
- "What does it look like?"],
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "issue",
- pkgVersion = mkVersion [744]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV1_12,
- stability = "",
- subLibraries = [],
- synopsis = "Package description parser interprets curly braces in the description field",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV1_12,
+ package = PackageIdentifier {
+ pkgName = PackageName "issue",
+ pkgVersion = mkVersion [744]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis =
+ "Package description parser interprets curly braces in the description field",
+ description = concat
+ [
+ "Here is some C code:\n",
+ "\n",
+ "> for(i = 0; i < 100; i++) {\n",
+ "> printf(\"%d\\n\",i);\n",
+ "> }\n",
+ "\n",
+ "What does it look like?"],
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName "Issue"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ [
+ "-Wall",
+ "-threaded",
+ "-with-rtsopts=-N -s -M1G -c",
+ "-rtsopts"]
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr
index aac1a2153e..c9e675ceb7 100644
--- a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr
@@ -70,7 +70,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
@@ -182,7 +182,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"jaeger-flamegraph",
- modulePath = "Main.hs",
+ modulePath = SymbolicPath
+ "Main.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -341,7 +342,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "Driver.hs",
+ (SymbolicPath "Driver.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr
index 6fc8dafb3e..0bb5556b2f 100644
--- a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr
@@ -1,170 +1,166 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "containers")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "deepseq")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "transformers")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "filepath")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "directory")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [ModuleName "LeadingComma",
- ModuleName "LeadingComma2",
- ModuleName "TrailingComma",
- ModuleName "TrailingComma",
- ModuleName "Comma",
- ModuleName "InBetween",
- ModuleName "NoCommas",
- ModuleName "NoCommas"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "containers")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "deepseq")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "transformers")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "filepath")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "directory")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "leading-comma",
- pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV3_0,
- stability = "",
- subLibraries = [],
- synopsis = "leading comma, trailing comma, or ordinary",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV3_0,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "leading-comma",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis =
+ "leading comma, trailing comma, or ordinary",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName "LeadingComma",
+ ModuleName "LeadingComma2",
+ ModuleName "TrailingComma",
+ ModuleName "TrailingComma",
+ ModuleName "Comma",
+ ModuleName "InBetween",
+ ModuleName "NoCommas",
+ ModuleName "NoCommas"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "containers")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "deepseq")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "transformers")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "filepath")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "directory")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "containers")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "deepseq")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "transformers")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "filepath")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "directory")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr
index c813d8b566..b1ba1b282f 100644
--- a/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr
@@ -1,163 +1,159 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "containers")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "deepseq")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "transformers")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "filepath")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "directory")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [ModuleName "LeadingComma"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "containers")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "deepseq")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "transformers")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "filepath")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "directory")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "leading-comma",
- pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV2_2,
- stability = "",
- subLibraries = [],
- synopsis = "leading comma, trailing comma, or ordinary",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV2_2,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "leading-comma",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis =
+ "leading comma, trailing comma, or ordinary",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName "LeadingComma"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "containers")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "deepseq")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "transformers")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "filepath")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "directory")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "containers")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "deepseq")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "transformers")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "filepath")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "directory")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr
index 954c378122..8906a91f63 100644
--- a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr
@@ -105,10 +105,11 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [
- "cbits/noticehandlers.h",
- "CHANGELOG.md"],
+ SymbolicPath
+ "cbits/noticehandlers.h",
+ SymbolicPath "CHANGELOG.md"],
extraTmpFiles = [],
extraDocFiles = []},
gpdScannedVersion = Nothing,
@@ -154,7 +155,8 @@ GenericPackageDescription {
asmSources = [],
cmmSources = [],
cSources = [
- "cbits/noticehandlers.c"],
+ SymbolicPath
+ "cbits/noticehandlers.c"],
cxxSources = [],
jsSources = [],
hsSourceDirs = [
@@ -175,7 +177,8 @@ GenericPackageDescription {
extraDynLibFlavours = [],
extraLibDirs = [],
extraLibDirsStatic = [],
- includeDirs = ["cbits"],
+ includeDirs = [
+ SymbolicPath "cbits"],
includes = [],
autogenIncludes = [],
installIncludes = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr
index 0b1c1ccd52..3c26ece45a 100644
--- a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr
@@ -109,10 +109,11 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [
- "cbits/noticehandlers.h",
- "CHANGELOG.md"],
+ SymbolicPath
+ "cbits/noticehandlers.h",
+ SymbolicPath "CHANGELOG.md"],
extraTmpFiles = [],
extraDocFiles = []},
gpdScannedVersion = Nothing,
@@ -159,7 +160,8 @@ GenericPackageDescription {
asmSources = [],
cmmSources = [],
cSources = [
- "cbits/noticehandlers.c"],
+ SymbolicPath
+ "cbits/noticehandlers.c"],
cxxSources = [],
jsSources = [],
hsSourceDirs = [
@@ -180,7 +182,8 @@ GenericPackageDescription {
extraDynLibFlavours = [],
extraLibDirs = [],
extraLibDirsStatic = [],
- includeDirs = ["cbits"],
+ includeDirs = [
+ SymbolicPath "cbits"],
includes = [],
autogenIncludes = [],
installIncludes = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr
index 2878577225..de8a15f04c 100644
--- a/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr
@@ -1,151 +1,161 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [_×_
- (UnqualComponentName "str-example")
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "str-string")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "str-bytestring")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet],
- condTreeData = Executable
- {buildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [SymbolicPath
- "str-example"],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [Mixin
- {mixinIncludeRenaming = IncludeRenaming
- {includeProvidesRn = ModuleRenaming
- [_×_
- (ModuleName
- "Str")
- (ModuleName
- "Str.String")],
- includeRequiresRn = DefaultRenaming},
- mixinLibraryName = LMainLibName,
- mixinPackageName = PackageName
- "str-string"},
- Mixin
- {mixinIncludeRenaming = IncludeRenaming
- {includeProvidesRn = ModuleRenaming
- [_×_
- (ModuleName
- "Str")
- (ModuleName
- "Str.ByteString")],
- includeRequiresRn = DefaultRenaming},
- mixinLibraryName = LMainLibName,
- mixinPackageName = PackageName
- "str-bytestring"}],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "str-string")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "str-bytestring")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- exeName = UnqualComponentName "str-example",
- exeScope = ExecutablePublic,
- modulePath = "Main.hs"}}],
- condForeignLibs = [],
- condLibrary = Nothing,
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "mixin", pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV2_0,
- stability = "",
- subLibraries = [],
- synopsis = "",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV2_0,
+ package = PackageIdentifier {
+ pkgName = PackageName "mixin",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis = "",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Nothing,
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [
+ _×_
+ (UnqualComponentName
+ "str-example")
+ CondNode {
+ condTreeData = Executable {
+ exeName = UnqualComponentName
+ "str-example",
+ modulePath = SymbolicPath
+ "Main.hs",
+ exeScope = ExecutablePublic,
+ buildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [
+ SymbolicPath "str-example"],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-string")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-bytestring")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = [
+ Mixin {
+ mixinPackageName = PackageName
+ "str-string",
+ mixinLibraryName = LMainLibName,
+ mixinIncludeRenaming =
+ IncludeRenaming {
+ includeProvidesRn =
+ ModuleRenaming
+ [
+ _×_
+ (ModuleName "Str")
+ (ModuleName "Str.String")],
+ includeRequiresRn =
+ DefaultRenaming}},
+ Mixin {
+ mixinPackageName = PackageName
+ "str-bytestring",
+ mixinLibraryName = LMainLibName,
+ mixinIncludeRenaming =
+ IncludeRenaming {
+ includeProvidesRn =
+ ModuleRenaming
+ [
+ _×_
+ (ModuleName "Str")
+ (ModuleName "Str.ByteString")],
+ includeRequiresRn =
+ DefaultRenaming}}]}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-string")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-bytestring")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []}],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr
index b2866d4a5e..3bf06bc9c3 100644
--- a/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr
@@ -1,151 +1,161 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [_×_
- (UnqualComponentName "str-example")
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "str-string")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "str-bytestring")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet],
- condTreeData = Executable
- {buildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [SymbolicPath
- "str-example"],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [Mixin
- {mixinIncludeRenaming = IncludeRenaming
- {includeProvidesRn = ModuleRenaming
- [_×_
- (ModuleName
- "Str")
- (ModuleName
- "Str.String")],
- includeRequiresRn = DefaultRenaming},
- mixinLibraryName = LMainLibName,
- mixinPackageName = PackageName
- "str-string"},
- Mixin
- {mixinIncludeRenaming = IncludeRenaming
- {includeProvidesRn = ModuleRenaming
- [_×_
- (ModuleName
- "Str")
- (ModuleName
- "Str.ByteString")],
- includeRequiresRn = DefaultRenaming},
- mixinLibraryName = LMainLibName,
- mixinPackageName = PackageName
- "str-bytestring"}],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "str-string")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "str-bytestring")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- exeName = UnqualComponentName "str-example",
- exeScope = ExecutablePublic,
- modulePath = "Main.hs"}}],
- condForeignLibs = [],
- condLibrary = Nothing,
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Nothing,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "mixin", pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV3_0,
- stability = "",
- subLibraries = [],
- synopsis = "",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV3_0,
+ package = PackageIdentifier {
+ pkgName = PackageName "mixin",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis = "",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Nothing,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Nothing,
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [
+ _×_
+ (UnqualComponentName
+ "str-example")
+ CondNode {
+ condTreeData = Executable {
+ exeName = UnqualComponentName
+ "str-example",
+ modulePath = SymbolicPath
+ "Main.hs",
+ exeScope = ExecutablePublic,
+ buildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [
+ SymbolicPath "str-example"],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-string")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-bytestring")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = [
+ Mixin {
+ mixinPackageName = PackageName
+ "str-string",
+ mixinLibraryName = LMainLibName,
+ mixinIncludeRenaming =
+ IncludeRenaming {
+ includeProvidesRn =
+ ModuleRenaming
+ [
+ _×_
+ (ModuleName "Str")
+ (ModuleName "Str.String")],
+ includeRequiresRn =
+ DefaultRenaming}},
+ Mixin {
+ mixinPackageName = PackageName
+ "str-bytestring",
+ mixinLibraryName = LMainLibName,
+ mixinIncludeRenaming =
+ IncludeRenaming {
+ includeProvidesRn =
+ ModuleRenaming
+ [
+ _×_
+ (ModuleName "Str")
+ (ModuleName "Str.ByteString")],
+ includeRequiresRn =
+ DefaultRenaming}}]}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-string")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-bytestring")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []}],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr
index 1a02247a87..0c0fc57a8b 100644
--- a/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr
@@ -1,136 +1,144 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [_×_
- (UnqualComponentName "str-example")
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "str-string")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "str-bytestring")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet],
- condTreeData = Executable
- {buildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [SymbolicPath
- "str-example"],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [Mixin
- {mixinIncludeRenaming = IncludeRenaming
- {includeProvidesRn = HidingRenaming
- [ModuleName
- "Foo"],
- includeRequiresRn = DefaultRenaming},
- mixinLibraryName = LMainLibName,
- mixinPackageName = PackageName
- "str"}],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "str-string")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "str-bytestring")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- exeName = UnqualComponentName "str-example",
- exeScope = ExecutablePublic,
- modulePath = "Main.hs"}}],
- condForeignLibs = [],
- condLibrary = Nothing,
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Nothing,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "mixin", pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV3_0,
- stability = "",
- subLibraries = [],
- synopsis = "",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV3_0,
+ package = PackageIdentifier {
+ pkgName = PackageName "mixin",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis = "",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Nothing,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Nothing,
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [
+ _×_
+ (UnqualComponentName
+ "str-example")
+ CondNode {
+ condTreeData = Executable {
+ exeName = UnqualComponentName
+ "str-example",
+ modulePath = SymbolicPath
+ "Main.hs",
+ exeScope = ExecutablePublic,
+ buildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [
+ SymbolicPath "str-example"],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-string")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-bytestring")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = [
+ Mixin {
+ mixinPackageName = PackageName
+ "str",
+ mixinLibraryName = LMainLibName,
+ mixinIncludeRenaming =
+ IncludeRenaming {
+ includeProvidesRn =
+ HidingRenaming
+ [ModuleName "Foo"],
+ includeRequiresRn =
+ DefaultRenaming}}]}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-string")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-bytestring")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []}],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/monad-param.expr b/Cabal-tests/tests/ParserTests/regressions/monad-param.expr
index 0f94cf3be9..28d57c1e3b 100644
--- a/Cabal-tests/tests/ParserTests/regressions/monad-param.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/monad-param.expr
@@ -39,7 +39,7 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []},
diff --git a/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr b/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr
index 2af5d422e3..a8c6b0c0c4 100644
--- a/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr
@@ -1,178 +1,196 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [ModuleName "ElseIf"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [_×_
- (UnqualComponentName "public")
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [ModuleName "ElseIf2"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor
- [] [],
- sharedOptions = PerCompilerFlavor
- [] [],
- staticOptions = PerCompilerFlavor
- [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LSubLibName (UnqualComponentName "public"),
- libVisibility = LibraryVisibilityPrivate,
- reexportedModules = [],
- signatures = []}}],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "multiple-libs",
- pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV2_0,
- stability = "",
- subLibraries = [],
- synopsis = "visible flag only since 3.0",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV2_0,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "multiple-libs",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis =
+ "visible flag only since 3.0",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName "ElseIf"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []},
+ condSubLibraries = [
+ _×_
+ (UnqualComponentName "public")
+ CondNode {
+ condTreeData = Library {
+ libName = LSubLibName
+ (UnqualComponentName "public"),
+ exposedModules = [
+ ModuleName "ElseIf2"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPrivate,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []}],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/noVersion.expr b/Cabal-tests/tests/ParserTests/regressions/noVersion.expr
index e96ca1efb3..8187272c2c 100644
--- a/Cabal-tests/tests/ParserTests/regressions/noVersion.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/noVersion.expr
@@ -1,108 +1,119 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "bad-package")
- (EarlierVersion (mkVersion [0]))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [ModuleName "ElseIf"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "bad-package")
- (EarlierVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "noVersion",
- pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV1_22,
- stability = "",
- subLibraries = [],
- synopsis = "-none in build-depends",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV1_22,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "noVersion",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis =
+ "-none in build-depends",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName "ElseIf"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "bad-package")
+ (EarlierVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "bad-package")
+ (EarlierVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr
index 650054bcf0..2f2663733c 100644
--- a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr
@@ -1,176 +1,194 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [CondBranch
- {condBranchCondition = `CNot (Var (PackageFlag (FlagName "\\28961")))`,
- condBranchIfFalse = Nothing,
- condBranchIfTrue = CondNode
- {condTreeComponents = [],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = False,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor
- []
- [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor
- []
- [],
- sharedOptions = PerCompilerFlavor
- []
- [],
- staticOptions = PerCompilerFlavor
- []
- [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}}}],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [ModuleName "\937"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [MkPackageFlag
- {flagDefault = True,
- flagDescription = "\28961",
- flagManual = False,
- flagName = FlagName "\28961"}],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [_×_ "x-\28961" "\28961"],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "\28961", pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [SourceRepo
- {repoBranch = Nothing,
- repoKind = RepoHead,
- repoLocation = Just "https://github.com/hvr/-.git",
- repoModule = Nothing,
- repoSubdir = Nothing,
- repoTag = Nothing,
- repoType = Just (KnownRepoType Git)}],
- specVersion = CabalSpecV1_10,
- stability = "",
- subLibraries = [],
- synopsis = "The canonical non-package \28961",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV1_10,
+ package = PackageIdentifier {
+ pkgName = PackageName "\28961",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [
+ SourceRepo {
+ repoKind = RepoHead,
+ repoType = Just
+ (KnownRepoType Git),
+ repoLocation = Just
+ "https://github.com/hvr/-.git",
+ repoModule = Nothing,
+ repoBranch = Nothing,
+ repoTag = Nothing,
+ repoSubdir = Nothing}],
+ synopsis =
+ "The canonical non-package \28961",
+ description = "",
+ category = "",
+ customFieldsPD = [
+ _×_ "x-\28961" "\28961"],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [
+ MkPackageFlag {
+ flagName = FlagName "\28961",
+ flagDescription = "\28961",
+ flagDefault = True,
+ flagManual = False}],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName "\937"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = [
+ CondBranch {
+ condBranchCondition =
+ `CNot (Var (PackageFlag (FlagName "\\28961")))`,
+ condBranchIfTrue = CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = False,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = []},
+ condBranchIfFalse = Nothing}]},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/shake.expr b/Cabal-tests/tests/ParserTests/regressions/shake.expr
index 30e0f9077c..8dd849d75b 100644
--- a/Cabal-tests/tests/ParserTests/regressions/shake.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/shake.expr
@@ -88,42 +88,68 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [
- "html/viz.js",
- "html/profile.html",
- "html/progress.html",
- "html/shake.js",
- "docs/manual/build.bat",
- "docs/manual/Build.hs",
- "docs/manual/build.sh",
- "docs/manual/constants.c",
- "docs/manual/constants.h",
- "docs/manual/main.c"],
- dataDir = ".",
+ SymbolicPath "html/viz.js",
+ SymbolicPath
+ "html/profile.html",
+ SymbolicPath
+ "html/progress.html",
+ SymbolicPath "html/shake.js",
+ SymbolicPath
+ "docs/manual/build.bat",
+ SymbolicPath
+ "docs/manual/Build.hs",
+ SymbolicPath
+ "docs/manual/build.sh",
+ SymbolicPath
+ "docs/manual/constants.c",
+ SymbolicPath
+ "docs/manual/constants.h",
+ SymbolicPath
+ "docs/manual/main.c"],
+ dataDir = SymbolicPath ".",
extraSrcFiles = [
- "src/Test/C/constants.c",
- "src/Test/C/constants.h",
- "src/Test/C/main.c",
- "src/Test/MakeTutor/Makefile",
- "src/Test/MakeTutor/hellofunc.c",
- "src/Test/MakeTutor/hellomake.c",
- "src/Test/MakeTutor/hellomake.h",
- "src/Test/Tar/list.txt",
- "src/Test/Ninja/*.ninja",
- "src/Test/Ninja/subdir/*.ninja",
- "src/Test/Ninja/*.output",
- "src/Test/Progress/*.prog",
- "src/Test/Tup/hello.c",
- "src/Test/Tup/root.cfg",
- "src/Test/Tup/newmath/root.cfg",
- "src/Test/Tup/newmath/square.c",
- "src/Test/Tup/newmath/square.h",
- "src/Paths.hs",
- "docs/Manual.md",
- "docs/shake-progress.png"],
+ SymbolicPath
+ "src/Test/C/constants.c",
+ SymbolicPath
+ "src/Test/C/constants.h",
+ SymbolicPath
+ "src/Test/C/main.c",
+ SymbolicPath
+ "src/Test/MakeTutor/Makefile",
+ SymbolicPath
+ "src/Test/MakeTutor/hellofunc.c",
+ SymbolicPath
+ "src/Test/MakeTutor/hellomake.c",
+ SymbolicPath
+ "src/Test/MakeTutor/hellomake.h",
+ SymbolicPath
+ "src/Test/Tar/list.txt",
+ SymbolicPath
+ "src/Test/Ninja/*.ninja",
+ SymbolicPath
+ "src/Test/Ninja/subdir/*.ninja",
+ SymbolicPath
+ "src/Test/Ninja/*.output",
+ SymbolicPath
+ "src/Test/Progress/*.prog",
+ SymbolicPath
+ "src/Test/Tup/hello.c",
+ SymbolicPath
+ "src/Test/Tup/root.cfg",
+ SymbolicPath
+ "src/Test/Tup/newmath/root.cfg",
+ SymbolicPath
+ "src/Test/Tup/newmath/square.c",
+ SymbolicPath
+ "src/Test/Tup/newmath/square.h",
+ SymbolicPath "src/Paths.hs",
+ SymbolicPath "docs/Manual.md",
+ SymbolicPath
+ "docs/shake-progress.png"],
extraTmpFiles = [],
extraDocFiles = [
- "CHANGES.txt",
- "README.md"]},
+ SymbolicPath "CHANGES.txt",
+ SymbolicPath "README.md"]},
gpdScannedVersion = Nothing,
genPackageFlags = [
MkPackageFlag {
@@ -804,7 +830,8 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"shake",
- modulePath = "Run.hs",
+ modulePath = SymbolicPath
+ "Run.hs",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -1127,7 +1154,7 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"shake",
- modulePath = "",
+ modulePath = SymbolicPath "",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -1194,7 +1221,7 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"shake",
- modulePath = "",
+ modulePath = SymbolicPath "",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -1258,7 +1285,7 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"shake",
- modulePath = "",
+ modulePath = SymbolicPath "",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -1329,7 +1356,7 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"shake",
- modulePath = "",
+ modulePath = SymbolicPath "",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -1393,7 +1420,7 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"shake",
- modulePath = "",
+ modulePath = SymbolicPath "",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -1468,7 +1495,7 @@ GenericPackageDescription {
condTreeData = Executable {
exeName = UnqualComponentName
"shake",
- modulePath = "",
+ modulePath = SymbolicPath "",
exeScope = ExecutablePublic,
buildInfo = BuildInfo {
buildable = True,
@@ -1544,7 +1571,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "Test.hs",
+ (SymbolicPath "Test.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr
index 29b85215c1..2ca07bf232 100644
--- a/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr
@@ -1,98 +1,109 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Right BSD3,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "spdx", pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV2_0,
- stability = "",
- subLibraries = [],
- synopsis = "testing positive parsing of spdx identifiers",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV2_0,
+ package = PackageIdentifier {
+ pkgName = PackageName "spdx",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Right BSD3,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis =
+ "testing positive parsing of spdx identifiers",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr
index 427f0eb21c..9c50edd486 100644
--- a/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr
@@ -1,99 +1,113 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left
- (License (ELicense (ELicenseId AGPL_1_0) Nothing)),
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "spdx", pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV2_2,
- stability = "",
- subLibraries = [],
- synopsis = "testing positive parsing of spdx identifiers",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV2_2,
+ package = PackageIdentifier {
+ pkgName = PackageName "spdx",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left
+ (License
+ (ELicense
+ (ELicenseId AGPL_1_0)
+ Nothing)),
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis =
+ "testing positive parsing of spdx identifiers",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr
index b7b57e34bf..944faa4c0c 100644
--- a/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr
@@ -1,99 +1,113 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left
- (License (ELicense (ELicenseId AGPL_1_0_only) Nothing)),
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "spdx", pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV2_4,
- stability = "",
- subLibraries = [],
- synopsis = "testing positive parsing of spdx identifiers",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV2_4,
+ package = PackageIdentifier {
+ pkgName = PackageName "spdx",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left
+ (License
+ (ELicense
+ (ELicenseId AGPL_1_0_only)
+ Nothing)),
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis =
+ "testing positive parsing of spdx identifiers",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
+ mixins = []}},
+ condTreeConstraints = [],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr b/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr
index f714c7a0fe..8f2edf09a3 100644
--- a/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr
@@ -53,13 +53,13 @@ GenericPackageDescription {
testSuites = [],
benchmarks = [],
dataFiles = [],
- dataDir = ".",
+ dataDir = SymbolicPath ".",
extraSrcFiles = [
- ".ghci",
- ".gitignore",
- ".travis.yml",
- ".vim.custom",
- "README.md"],
+ SymbolicPath ".ghci",
+ SymbolicPath ".gitignore",
+ SymbolicPath ".travis.yml",
+ SymbolicPath ".vim.custom",
+ SymbolicPath "README.md"],
extraTmpFiles = [],
extraDocFiles = []},
gpdScannedVersion = Nothing,
@@ -244,7 +244,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "Main.hs",
+ (SymbolicPath "Main.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
@@ -422,7 +422,7 @@ GenericPackageDescription {
"",
testInterface = TestSuiteExeV10
(mkVersion [1, 0])
- "doctests.hs",
+ (SymbolicPath "doctests.hs"),
testBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
diff --git a/Cabal-tests/tests/ParserTests/regressions/version-sets.expr b/Cabal-tests/tests/ParserTests/regressions/version-sets.expr
index f3c993b7b7..b134e4584a 100644
--- a/Cabal-tests/tests/ParserTests/regressions/version-sets.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/version-sets.expr
@@ -1,286 +1,263 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "network")
- (MajorBoundVersion (mkVersion [0]))
- mainLibSet,
- Dependency
- (PackageName "base")
- (ThisVersion (mkVersion [1]))
- mainLibSet,
- Dependency
- (PackageName "base")
- (ThisVersion (mkVersion [1]))
- mainLibSet,
- Dependency
- (PackageName "base")
- (UnionVersionRanges
- (ThisVersion (mkVersion [1]))
- (ThisVersion (mkVersion [2])))
- mainLibSet,
- Dependency
- (PackageName "base")
- (ThisVersion (mkVersion [1, 2]))
- mainLibSet,
- Dependency
- (PackageName "base")
- (UnionVersionRanges
- (ThisVersion (mkVersion [1, 2]))
- (ThisVersion (mkVersion [3, 4])))
- mainLibSet,
- Dependency
- (PackageName "ghc")
- (UnionVersionRanges
- (ThisVersion (mkVersion [8, 6, 3]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [8, 4, 4]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [8, 2, 2]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [8, 0, 2]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [7, 10, 3]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [7, 8, 4]))
- (UnionVersionRanges
- (ThisVersion
- (mkVersion [7, 6, 3]))
- (ThisVersion
- (mkVersion [7, 4, 2])))))))))
- mainLibSet,
- Dependency
- (PackageName "Cabal")
- (UnionVersionRanges
- (MajorBoundVersion (mkVersion [2, 4, 1, 1]))
- (MajorBoundVersion (mkVersion [2, 2, 0, 0])))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Just Haskell2010,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "network")
- (MajorBoundVersion
- (mkVersion
- [0]))
- mainLibSet,
- Dependency
- (PackageName
- "base")
- (ThisVersion
- (mkVersion
- [1]))
- mainLibSet,
- Dependency
- (PackageName
- "base")
- (ThisVersion
- (mkVersion
- [1]))
- mainLibSet,
- Dependency
- (PackageName
- "base")
- (UnionVersionRanges
- (ThisVersion
- (mkVersion
- [1]))
- (ThisVersion
- (mkVersion
- [2])))
- mainLibSet,
- Dependency
- (PackageName
- "base")
- (ThisVersion
- (mkVersion
- [1, 2]))
- mainLibSet,
- Dependency
- (PackageName
- "base")
- (UnionVersionRanges
- (ThisVersion
- (mkVersion
- [1, 2]))
- (ThisVersion
- (mkVersion
- [3, 4])))
- mainLibSet,
- Dependency
- (PackageName
- "ghc")
- (UnionVersionRanges
- (ThisVersion
- (mkVersion
- [8,
- 6,
- 3]))
- (UnionVersionRanges
- (ThisVersion
- (mkVersion
- [8,
- 4,
- 4]))
- (UnionVersionRanges
- (ThisVersion
- (mkVersion
- [8,
- 2,
- 2]))
- (UnionVersionRanges
- (ThisVersion
- (mkVersion
- [8,
- 0,
- 2]))
- (UnionVersionRanges
- (ThisVersion
- (mkVersion
- [7,
- 10,
- 3]))
- (UnionVersionRanges
- (ThisVersion
- (mkVersion
- [7,
- 8,
- 4]))
- (UnionVersionRanges
- (ThisVersion
- (mkVersion
- [7,
- 6,
- 3]))
- (ThisVersion
- (mkVersion
- [7,
- 4,
- 2])))))))))
- mainLibSet,
- Dependency
- (PackageName
- "Cabal")
- (UnionVersionRanges
- (MajorBoundVersion
- (mkVersion
- [2,
- 4,
- 1,
- 1]))
- (MajorBoundVersion
- (mkVersion
- [2,
- 2,
- 0,
- 0])))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Nothing,
- category = "",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = "",
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [],
- licenseRaw = Left NONE,
- maintainer = "",
- package = PackageIdentifier
- {pkgName = PackageName "version-sets",
- pkgVersion = mkVersion [0]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [],
- specVersion = CabalSpecV3_0,
- stability = "",
- subLibraries = [],
- synopsis = "version set notation",
- testSuites = [],
- testedWith = [_×_
- GHC
- (UnionVersionRanges
- (ThisVersion (mkVersion [8, 6, 3]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [8, 4, 4]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [8, 2, 2]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [8, 0, 2]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [7, 10, 3]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [7, 8, 4]))
- (UnionVersionRanges
- (ThisVersion (mkVersion [7, 6, 3]))
- (ThisVersion
- (mkVersion [7, 4, 2])))))))))]}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV3_0,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "version-sets",
+ pkgVersion = mkVersion [0]},
+ licenseRaw = Left NONE,
+ licenseFiles = [],
+ copyright = "",
+ maintainer = "",
+ author = "",
+ stability = "",
+ testedWith = [
+ _×_
+ GHC
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 6, 3]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 4, 4]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 2, 2]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 0, 2]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [7, 10, 3]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [7, 8, 4]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [7, 6, 3]))
+ (ThisVersion
+ (mkVersion [7, 4, 2])))))))))],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [],
+ synopsis =
+ "version set notation",
+ description = "",
+ category = "",
+ customFieldsPD = [],
+ buildTypeRaw = Nothing,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Just
+ Haskell2010,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "network")
+ (MajorBoundVersion
+ (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "base")
+ (ThisVersion (mkVersion [1]))
+ mainLibSet,
+ Dependency
+ (PackageName "base")
+ (ThisVersion (mkVersion [1]))
+ mainLibSet,
+ Dependency
+ (PackageName "base")
+ (UnionVersionRanges
+ (ThisVersion (mkVersion [1]))
+ (ThisVersion (mkVersion [2])))
+ mainLibSet,
+ Dependency
+ (PackageName "base")
+ (ThisVersion (mkVersion [1, 2]))
+ mainLibSet,
+ Dependency
+ (PackageName "base")
+ (UnionVersionRanges
+ (ThisVersion (mkVersion [1, 2]))
+ (ThisVersion
+ (mkVersion [3, 4])))
+ mainLibSet,
+ Dependency
+ (PackageName "ghc")
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 6, 3]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 4, 4]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 2, 2]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 0, 2]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [7, 10, 3]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [7, 8, 4]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [7, 6, 3]))
+ (ThisVersion
+ (mkVersion [7, 4, 2])))))))))
+ mainLibSet,
+ Dependency
+ (PackageName "Cabal")
+ (UnionVersionRanges
+ (MajorBoundVersion
+ (mkVersion [2, 4, 1, 1]))
+ (MajorBoundVersion
+ (mkVersion [2, 2, 0, 0])))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "network")
+ (MajorBoundVersion
+ (mkVersion [0]))
+ mainLibSet,
+ Dependency
+ (PackageName "base")
+ (ThisVersion (mkVersion [1]))
+ mainLibSet,
+ Dependency
+ (PackageName "base")
+ (ThisVersion (mkVersion [1]))
+ mainLibSet,
+ Dependency
+ (PackageName "base")
+ (UnionVersionRanges
+ (ThisVersion (mkVersion [1]))
+ (ThisVersion (mkVersion [2])))
+ mainLibSet,
+ Dependency
+ (PackageName "base")
+ (ThisVersion (mkVersion [1, 2]))
+ mainLibSet,
+ Dependency
+ (PackageName "base")
+ (UnionVersionRanges
+ (ThisVersion (mkVersion [1, 2]))
+ (ThisVersion
+ (mkVersion [3, 4])))
+ mainLibSet,
+ Dependency
+ (PackageName "ghc")
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 6, 3]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 4, 4]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 2, 2]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [8, 0, 2]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [7, 10, 3]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [7, 8, 4]))
+ (UnionVersionRanges
+ (ThisVersion
+ (mkVersion [7, 6, 3]))
+ (ThisVersion
+ (mkVersion [7, 4, 2])))))))))
+ mainLibSet,
+ Dependency
+ (PackageName "Cabal")
+ (UnionVersionRanges
+ (MajorBoundVersion
+ (mkVersion [2, 4, 1, 1]))
+ (MajorBoundVersion
+ (mkVersion [2, 2, 0, 0])))
+ mainLibSet],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr b/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr
index edbbeed748..03959b195c 100644
--- a/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr
+++ b/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr
@@ -1,225 +1,239 @@
-GenericPackageDescription
- {condBenchmarks = [],
- condExecutables = [_×_
- (UnqualComponentName "wl-pprint-string-example")
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (EarlierVersion (mkVersion [5]))
- mainLibSet,
- Dependency
- (PackageName "str-string")
- (OrLaterVersion (mkVersion [0, 1, 0, 0]))
- mainLibSet,
- Dependency
- (PackageName "wl-pprint-indef")
- (OrLaterVersion (mkVersion [0]))
- mainLibSet],
- condTreeData = Executable
- {buildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [SymbolicPath
- "example-string"],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [ModuleName
- "StringImpl"],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (EarlierVersion
- (mkVersion
- [5]))
- mainLibSet,
- Dependency
- (PackageName
- "str-string")
- (OrLaterVersion
- (mkVersion
- [0,
- 1,
- 0,
- 0]))
- mainLibSet,
- Dependency
- (PackageName
- "wl-pprint-indef")
- (OrLaterVersion
- (mkVersion
- [0]))
- mainLibSet],
- virtualModules = []},
- exeName = UnqualComponentName
- "wl-pprint-string-example",
- exeScope = ExecutablePublic,
- modulePath = "Main.hs"}}],
- condForeignLibs = [],
- condLibrary = Just
- CondNode
- {condTreeComponents = [],
- condTreeConstraints = [Dependency
- (PackageName "base")
- (EarlierVersion (mkVersion [5]))
- mainLibSet,
- Dependency
- (PackageName "str-sig")
- (OrLaterVersion (mkVersion [0, 1, 0, 0]))
- mainLibSet],
- condTreeData = Library
- {exposedModules = [ModuleName "Text.PrettyPrint.Leijen"],
- libBuildInfo = BuildInfo
- {asmOptions = [],
- asmSources = [],
- autogenIncludes = [],
- autogenModules = [],
- buildToolDepends = [],
- buildTools = [],
- buildable = True,
- cSources = [],
- ccOptions = [],
- cmmOptions = [],
- cmmSources = [],
- cppOptions = [],
- customFieldsBI = [],
- cxxOptions = [],
- cxxSources = [],
- defaultExtensions = [],
- defaultLanguage = Nothing,
- extraBundledLibs = [],
- extraDynLibFlavours = [],
- extraFrameworkDirs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- extraLibDirsStatic = [],
- extraLibFlavours = [],
- extraLibs = [],
- extraLibsStatic = [],
- frameworks = [],
- hsSourceDirs = [],
- hsc2hsOptions = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- jsSources = [],
- ldOptions = [],
- mixins = [],
- oldExtensions = [],
- options = PerCompilerFlavor [] [],
- otherExtensions = [],
- otherLanguages = [],
- otherModules = [],
- pkgconfigDepends = [],
- profOptions = PerCompilerFlavor [] [],
- sharedOptions = PerCompilerFlavor [] [],
- staticOptions = PerCompilerFlavor [] [],
- targetBuildDepends = [Dependency
- (PackageName
- "base")
- (EarlierVersion
- (mkVersion
- [5]))
- mainLibSet,
- Dependency
- (PackageName
- "str-sig")
- (OrLaterVersion
- (mkVersion
- [0,
- 1,
- 0,
- 0]))
- mainLibSet],
- virtualModules = []},
- libExposed = True,
- libName = LMainLibName,
- libVisibility = LibraryVisibilityPublic,
- reexportedModules = [],
- signatures = []}},
- condSubLibraries = [],
- condTestSuites = [],
- genPackageFlags = [],
- gpdScannedVersion = Nothing,
- packageDescription = PackageDescription
- {author = "Daan Leijen",
- benchmarks = [],
- bugReports = "",
- buildTypeRaw = Just Simple,
- category = "Text",
- copyright = "",
- customFieldsPD = [],
- dataDir = ".",
- dataFiles = [],
- description = concat
- ["This is a pretty printing library based on Wadler's paper \"A Prettier\n",
- "Printer\". See the haddocks for full info. This version allows the\n",
- "library user to declare overlapping instances of the 'Pretty' class."],
- executables = [],
- extraDocFiles = [],
- extraSrcFiles = [],
- extraTmpFiles = [],
- foreignLibs = [],
- homepage = "",
- library = Nothing,
- licenseFiles = [SymbolicPath "LICENSE"],
- licenseRaw = Right BSD3,
- maintainer = "Noam Lewis <jones.noamle@gmail.com>",
- package = PackageIdentifier
- {pkgName = PackageName "wl-pprint-indef",
- pkgVersion = mkVersion [1, 2]},
- pkgUrl = "",
- setupBuildInfo = Nothing,
- sourceRepos = [SourceRepo
- {repoBranch = Nothing,
- repoKind = RepoHead,
- repoLocation = Just
- "git@github.com:danidiaz/wl-pprint-indef.git",
- repoModule = Nothing,
- repoSubdir = Nothing,
- repoTag = Nothing,
- repoType = Just (KnownRepoType Git)}],
- specVersion = CabalSpecV1_6,
- stability = "",
- subLibraries = [],
- synopsis = "The Wadler/Leijen Pretty Printer",
- testSuites = [],
- testedWith = []}}
+GenericPackageDescription {
+ packageDescription =
+ PackageDescription {
+ specVersion = CabalSpecV1_6,
+ package = PackageIdentifier {
+ pkgName = PackageName
+ "wl-pprint-indef",
+ pkgVersion = mkVersion [1, 2]},
+ licenseRaw = Right BSD3,
+ licenseFiles = [
+ SymbolicPath "LICENSE"],
+ copyright = "",
+ maintainer =
+ "Noam Lewis <jones.noamle@gmail.com>",
+ author = "Daan Leijen",
+ stability = "",
+ testedWith = [],
+ homepage = "",
+ pkgUrl = "",
+ bugReports = "",
+ sourceRepos = [
+ SourceRepo {
+ repoKind = RepoHead,
+ repoType = Just
+ (KnownRepoType Git),
+ repoLocation = Just
+ "git@github.com:danidiaz/wl-pprint-indef.git",
+ repoModule = Nothing,
+ repoBranch = Nothing,
+ repoTag = Nothing,
+ repoSubdir = Nothing}],
+ synopsis =
+ "The Wadler/Leijen Pretty Printer",
+ description =
+ concat
+ [
+ "This is a pretty printing library based on Wadler's paper \"A Prettier\n",
+ "Printer\". See the haddocks for full info. This version allows the\n",
+ "library user to declare overlapping instances of the 'Pretty' class."],
+ category = "Text",
+ customFieldsPD = [],
+ buildTypeRaw = Just Simple,
+ setupBuildInfo = Nothing,
+ library = Nothing,
+ subLibraries = [],
+ executables = [],
+ foreignLibs = [],
+ testSuites = [],
+ benchmarks = [],
+ dataFiles = [],
+ dataDir = SymbolicPath ".",
+ extraSrcFiles = [],
+ extraTmpFiles = [],
+ extraDocFiles = []},
+ gpdScannedVersion = Nothing,
+ genPackageFlags = [],
+ condLibrary = Just
+ CondNode {
+ condTreeData = Library {
+ libName = LMainLibName,
+ exposedModules = [
+ ModuleName
+ "Text.PrettyPrint.Leijen"],
+ reexportedModules = [],
+ signatures = [],
+ libExposed = True,
+ libVisibility =
+ LibraryVisibilityPublic,
+ libBuildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (EarlierVersion (mkVersion [5]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-sig")
+ (OrLaterVersion
+ (mkVersion [0, 1, 0, 0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (EarlierVersion (mkVersion [5]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-sig")
+ (OrLaterVersion
+ (mkVersion [0, 1, 0, 0]))
+ mainLibSet],
+ condTreeComponents = []},
+ condSubLibraries = [],
+ condForeignLibs = [],
+ condExecutables = [
+ _×_
+ (UnqualComponentName
+ "wl-pprint-string-example")
+ CondNode {
+ condTreeData = Executable {
+ exeName = UnqualComponentName
+ "wl-pprint-string-example",
+ modulePath = SymbolicPath
+ "Main.hs",
+ exeScope = ExecutablePublic,
+ buildInfo = BuildInfo {
+ buildable = True,
+ buildTools = [],
+ buildToolDepends = [],
+ cppOptions = [],
+ asmOptions = [],
+ cmmOptions = [],
+ ccOptions = [],
+ cxxOptions = [],
+ ldOptions = [],
+ hsc2hsOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ asmSources = [],
+ cmmSources = [],
+ cSources = [],
+ cxxSources = [],
+ jsSources = [],
+ hsSourceDirs = [
+ SymbolicPath "example-string"],
+ otherModules = [
+ ModuleName "StringImpl"],
+ virtualModules = [],
+ autogenModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraLibsStatic = [],
+ extraGHCiLibs = [],
+ extraBundledLibs = [],
+ extraLibFlavours = [],
+ extraDynLibFlavours = [],
+ extraLibDirs = [],
+ extraLibDirsStatic = [],
+ includeDirs = [],
+ includes = [],
+ autogenIncludes = [],
+ installIncludes = [],
+ options = PerCompilerFlavor
+ []
+ [],
+ profOptions = PerCompilerFlavor
+ []
+ [],
+ sharedOptions =
+ PerCompilerFlavor [] [],
+ staticOptions =
+ PerCompilerFlavor [] [],
+ customFieldsBI = [],
+ targetBuildDepends = [
+ Dependency
+ (PackageName "base")
+ (EarlierVersion (mkVersion [5]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-string")
+ (OrLaterVersion
+ (mkVersion [0, 1, 0, 0]))
+ mainLibSet,
+ Dependency
+ (PackageName "wl-pprint-indef")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ mixins = []}},
+ condTreeConstraints = [
+ Dependency
+ (PackageName "base")
+ (EarlierVersion (mkVersion [5]))
+ mainLibSet,
+ Dependency
+ (PackageName "str-string")
+ (OrLaterVersion
+ (mkVersion [0, 1, 0, 0]))
+ mainLibSet,
+ Dependency
+ (PackageName "wl-pprint-indef")
+ (OrLaterVersion (mkVersion [0]))
+ mainLibSet],
+ condTreeComponents = []}],
+ condTestSuites = [],
+ condBenchmarks = []}
diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
index a6142498ae..71653353f9 100644
--- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
+++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
@@ -33,15 +33,15 @@ md5Check proxy md5Int = structureHash proxy @?= md5FromInteger md5Int
md5CheckGenericPackageDescription :: Proxy GenericPackageDescription -> Assertion
md5CheckGenericPackageDescription proxy = md5Check proxy
#if MIN_VERSION_base(4,19,0)
- 0x7559521b9eb2e2fa4a608a86c629dc17
+ 0x5a48c6570cbcf96af4c51f38962e37b5
#else
- 0xa78ea118e2e29b5809d359c9431df3ba
+ 0xc5c0e54b95e651216e92db04c9cd4ecf
#endif
md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion
md5CheckLocalBuildInfo proxy = md5Check proxy
#if MIN_VERSION_base(4,19,0)
- 0x8a8e81b52a34b8610acdcd0b9d488940
+ 0x6d668de33d7b4d5df3830e65e6941373
#else
- 0xb53fbd58281a6f329f7b659d91fcd86e
+ 0xcdf740970a7d37e5e7ca48ea5f4f25eb7
#endif
diff --git a/Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs b/Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs
index 5992a61d0d..a89ce9b36e 100644
--- a/Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs
+++ b/Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs
@@ -1,6 +1,8 @@
-- This is Distribution.Extra.Doctest module from cabal-doctest-1.0.4
-- This isn't technically a Custom-Setup script, but it /was/.
+{-# LANGUAGE FlexibleInstances #-}
+
{-
Copyright (c) 2017, Oleg Grenrus
@@ -104,15 +106,19 @@ import Distribution.Simple.Compiler
(CompilerFlavor (GHC), CompilerId (..), PackageDB (..), compilerId)
import Distribution.Simple.LocalBuildInfo
(ComponentLocalBuildInfo (componentPackageDeps), LocalBuildInfo,
- compiler, withExeLBI, withLibLBI, withPackageDB, withTestLBI)
+ compiler, withExeLBI, withLibLBI, withPackageDB, withTestLBI
+ )
import Distribution.Simple.Setup
- (BuildFlags (buildDistPref, buildVerbosity),
- HaddockFlags (haddockDistPref, haddockVerbosity), emptyBuildFlags,
+ ( CommonSetupFlags(..)
+ , BuildFlags(..)
+ , HaddockFlags (..)
+ , emptyBuildFlags,
fromFlag)
import Distribution.Simple.Utils
(createDirectoryIfMissingVerbose, info)
import Distribution.Text
(display)
+import Distribution.Verbosity
import System.FilePath
((</>))
@@ -150,7 +156,20 @@ import Distribution.Package
(PackageId)
#endif
-#if MIN_VERSION_Cabal(3,0,0)
+#if MIN_VERSION_Cabal(3,11,0)
+import Distribution.Utils.Path
+ ( SymbolicPathX
+ , makeSymbolicPath
+ , makeRelativePathEx )
+import qualified Distribution.Utils.Path as Cabal
+ (getSymbolicPath)
+import Distribution.Simple.Utils
+ (findFileEx)
+#elif MIN_VERSION_Cabal(3,0,0)
+import Distribution.Utils.Path
+ (SymbolicPath)
+import qualified Distribution.Utils.Path as Cabal
+ (getSymbolicPath)
import Distribution.Simple.Utils
(findFileEx)
#else
@@ -163,11 +182,6 @@ import Distribution.Types.LibraryName
(libraryNameString)
#endif
-#if MIN_VERSION_Cabal(3,5,0)
-import Distribution.Utils.Path
- (getSymbolicPath)
-#endif
-
#if MIN_VERSION_directory(1,2,2)
import System.Directory
(makeAbsolute)
@@ -184,9 +198,18 @@ makeAbsolute p | isAbsolute p = return p
return $ cwd </> p
#endif
-#if !MIN_VERSION_Cabal(3,0,0)
-findFileEx :: verbosity -> [FilePath] -> FilePath -> IO FilePath
-findFileEx _ = findFile
+findFile' :: Verbosity -> [FilePath] -> FilePath -> IO FilePath
+#if MIN_VERSION_Cabal(3,11,0)
+findFile' verbosity searchPath fileName
+ = toFilePath <$>
+ findFileEx verbosity
+ (fmap makeSymbolicPath searchPath) (makeRelativePathEx fileName)
+#elif MIN_VERSION_Cabal(3,0,0)
+findFile' verbosity searchPath fileName
+ = findFileEx verbosity searchPath fileName
+#else
+findFile' _verbosity searchPath fileName
+ = findFile searchPath fileName
#endif
#if !MIN_VERSION_Cabal(2,0,0)
@@ -194,9 +217,16 @@ mkVersion :: [Int] -> Version
mkVersion ds = Version ds []
#endif
-#if !MIN_VERSION_Cabal(3,5,0)
-getSymbolicPath :: FilePath -> FilePath
-getSymbolicPath = id
+class CompatPath p where
+ toFilePath :: p -> FilePath
+instance CompatPath FilePath where
+ toFilePath = id
+#if MIN_VERSION_Cabal(3,11,0)
+instance CompatPath (SymbolicPathX allowAbs from to) where
+ toFilePath = Cabal.getSymbolicPath
+#elif MIN_VERSION_Cabal(3,5,0)
+instance CompatPath (SymbolicPath from to) where
+ toFilePath = Cabal.getSymbolicPath
#endif
-------------------------------------------------------------------------------
@@ -253,10 +283,16 @@ addDoctestsUserHook testsuiteName uh = uh
-- | Convert only flags used by 'generateBuildModule'.
haddockToBuildFlags :: HaddockFlags -> BuildFlags
-haddockToBuildFlags f = emptyBuildFlags
+haddockToBuildFlags f =
+#if MIN_VERSION_Cabal(3,11,0)
+ emptyBuildFlags
+ { buildCommonFlags = haddockCommonFlags f }
+#else
+ emptyBuildFlags
{ buildVerbosity = haddockVerbosity f
, buildDistPref = haddockDistPref f
}
+#endif
data Name = NameLib (Maybe String) | NameExe String deriving (Eq, Show)
@@ -300,17 +336,18 @@ generateBuildModule testSuiteName flags pkg lbi = do
let distPref = fromFlag (buildDistPref flags)
-- Package DBs & environments
- let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ]
+ let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ toFilePath distPref </> "package.conf.inplace" ]
let dbFlags = "-hide-all-packages" : packageDbArgs dbStack
let envFlags
| ghcCanBeToldToIgnorePkgEnvs = [ "-package-env=-" ]
| otherwise = []
withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testSuiteName) $ do
+ let testAutogenDir = toFilePath $
#if MIN_VERSION_Cabal(1,25,0)
- let testAutogenDir = autogenComponentModulesDir lbi suitecfg
+ autogenComponentModulesDir lbi suitecfg
#else
- let testAutogenDir = autogenModulesDir lbi
+ autogenModulesDir lbi
#endif
createDirectoryIfMissingVerbose verbosity True testAutogenDir
@@ -363,19 +400,22 @@ generateBuildModule testSuiteName flags pkg lbi = do
let module_sources = modules
-- We need the directory with the component's cabal_macros.h!
+
+ let compAutogenDir =
+ toFilePath $
#if MIN_VERSION_Cabal(1,25,0)
- let compAutogenDir = autogenComponentModulesDir lbi compCfg
+ autogenComponentModulesDir lbi compCfg
#else
- let compAutogenDir = autogenModulesDir lbi
+ autogenModulesDir lbi
#endif
-- Lib sources and includes
iArgsNoPrefix
<- mapM makeAbsolute
$ compAutogenDir -- autogenerated files
- : (distPref ++ "/build") -- preprocessed files (.hsc -> .hs); "build" is hardcoded in Cabal.
- : map getSymbolicPath (hsSourceDirs compBI)
- includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs compBI
+ : (toFilePath distPref ++ "/build") -- preprocessed files (.hsc -> .hs); "build" is hardcoded in Cabal.
+ : map toFilePath (hsSourceDirs compBI)
+ includeArgs <- mapM (fmap ("-I"++) . makeAbsolute . toFilePath) $ includeDirs compBI
-- We clear all includes, so the CWD isn't used.
let iArgs' = map ("-i"++) iArgsNoPrefix
iArgs = "-i" : iArgs'
@@ -393,7 +433,7 @@ generateBuildModule testSuiteName flags pkg lbi = do
-- even though the main-is module is named Main, its filepath might
-- actually be Something.hs. To account for this possibility, we simply
-- pass the full path to the main-is module instead.
- mainIsPath <- T.traverse (findFileEx verbosity iArgsNoPrefix) (compMainIs comp)
+ mainIsPath <- T.traverse (findFile' verbosity iArgsNoPrefix) (compMainIs comp)
let all_sources = map display module_sources
++ additionalModules
@@ -419,7 +459,7 @@ generateBuildModule testSuiteName flags pkg lbi = do
-- For now, we only check for doctests in libraries and executables.
getBuildDoctests withLibLBI mbLibraryName exposedModules (const Nothing) libBuildInfo
- getBuildDoctests withExeLBI (NameExe . executableName) (const []) (Just . modulePath) buildInfo
+ getBuildDoctests withExeLBI (NameExe . executableName) (const []) (Just . toFilePath . modulePath) buildInfo
components <- readIORef componentsRef
F.for_ components $ \(Component cmpName cmpPkgs cmpFlags cmpSources) -> do
diff --git a/Cabal-tests/tests/custom-setup/IdrisSetup.hs b/Cabal-tests/tests/custom-setup/IdrisSetup.hs
index 8fc21c80ec..952be05296 100644
--- a/Cabal-tests/tests/custom-setup/IdrisSetup.hs
+++ b/Cabal-tests/tests/custom-setup/IdrisSetup.hs
@@ -65,6 +65,10 @@ import Distribution.Simple.Utils (rewriteFileEx)
import Distribution.Compiler
import Distribution.PackageDescription
import Distribution.Text
+#if MIN_VERSION_Cabal(3,11,0)
+import Distribution.Utils.Path
+ (getSymbolicPath, makeSymbolicPath)
+#endif
import System.Environment
import System.Exit
@@ -93,11 +97,16 @@ lookupEnv v = lookup v `fmap` getEnvironment
-- make on mingw32 expects unix style separators
#ifdef mingw32_HOST_OS
-(<//>) = (Px.</>)
-idrisCmd local = Px.joinPath $ splitDirectories $ ".." <//> ".." <//> buildDir local <//> "idris" <//> "idris"
+idrisCmd local = Px.joinPath $ splitDirectories $ ".." Px.</> ".." Px.</> bd Px.</> "idris" Px.</> "idris"
#else
-idrisCmd local = ".." </> ".." </> buildDir local </> "idris" </> "idris"
+idrisCmd local = ".." </> ".." </> bd </> "idris" </> "idris"
+#endif
+ where
+ bd =
+#if MIN_VERSION_Cabal(3,11,0)
+ getSymbolicPath $
#endif
+ buildDir local
-- -----------------------------------------------------------------------------
-- Make Commands
@@ -109,11 +118,14 @@ mymake = "gmake"
#else
mymake = "make"
#endif
-make verbosity =
- P.runProgramInvocation verbosity . P.simpleProgramInvocation mymake
+
+make verbosity dir args =
+ P.runProgramInvocation verbosity $ P.simpleProgramInvocation mymake $
+ [ "-C", dir ] ++ args
#ifdef mingw32_HOST_OS
-windres verbosity = P.runProgramInvocation verbosity . P.simpleProgramInvocation "windres"
+windres verbosity =
+ P.runProgramInvocation verbosity . P.simpleProgramInvocation "windres"
#endif
-- -----------------------------------------------------------------------------
-- Flags
@@ -160,7 +172,7 @@ idrisClean _ flags _ _ = cleanStdLib
cleanStdLib = makeClean "libs"
- makeClean dir = make verbosity [ "-C", dir, "clean", "IDRIS=idris" ]
+ makeClean dir = make verbosity dir [ "clean", "IDRIS=idris" ]
-- -----------------------------------------------------------------------------
-- Configure
@@ -223,7 +235,11 @@ generateToolchainModule verbosity srcDir toolDir = do
idrisConfigure _ flags pkgdesc local = do
configureRTS
withLibLBI pkgdesc local $ \_ libcfg -> do
- let libAutogenDir = autogenComponentModulesDir local libcfg
+ let libAutogenDir =
+#if MIN_VERSION_Cabal(3,11,0)
+ getSymbolicPath $
+#endif
+ autogenComponentModulesDir local libcfg
generateVersionModule verbosity libAutogenDir (isRelease (configFlags local))
if isFreestanding $ configFlags local
then do
@@ -244,7 +260,7 @@ idrisConfigure _ flags pkgdesc local = do
-- installing but shouldn't be in the distribution. And it won't make the
-- distribution if it's not there, so instead I just delete
-- the file after configure.
- configureRTS = make verbosity ["-C", "rts", "clean"]
+ configureRTS = make verbosity "rts" ["clean"]
#if !(MIN_VERSION_Cabal(2,0,0))
autogenComponentModulesDir lbi _ = autogenModulesDir lbi
@@ -297,7 +313,14 @@ idrisPreBuild args flags = do
return (Nothing, [(fromString "idris", emptyBuildInfo { ldOptions = [dir ++ "/idris_icon.o"] })])
where
verbosity = S.fromFlag $ S.buildVerbosity flags
- dir = S.fromFlagOrDefault "dist" $ S.buildDistPref flags
+
+ dir =
+#if MIN_VERSION_Cabal(3,11,0)
+ getSymbolicPath $ S.fromFlagOrDefault (makeSymbolicPath "dist") $
+#else
+ S.fromFlagOrDefault "dist" $
+#endif
+ S.buildDistPref flags
#else
return (Nothing, [])
#endif
@@ -313,10 +336,9 @@ idrisBuild _ flags _ local
putStrLn "Building libraries..."
makeBuild "libs"
where
- makeBuild dir = make verbosity [ "-C", dir, "build" , "IDRIS=" ++ idrisCmd local]
+ makeBuild dir = make verbosity dir ["IDRIS=" ++ idrisCmd local]
- buildRTS = make verbosity (["-C", "rts", "build"] ++
- gmpflag (usesGMP (configFlags local)))
+ buildRTS = make verbosity "rts" $ gmpflag (usesGMP (configFlags local))
gmpflag False = []
gmpflag True = ["GMP=-DIDRIS_GMP"]
@@ -348,7 +370,7 @@ idrisInstall verbosity copy pkg local
installOrdinaryFiles verbosity mandest [("man", "idris.1")]
makeInstall src target =
- make verbosity [ "-C", src, "install" , "TARGET=" ++ target, "IDRIS=" ++ idrisCmd local]
+ make verbosity src [ "install", "TARGET=" ++ target, "IDRIS=" ++ idrisCmd local]
-- -----------------------------------------------------------------------------
-- Test
@@ -360,7 +382,11 @@ idrisInstall verbosity copy pkg local
fixPkg pkg target = pkg { dataDir = target }
idrisTestHook args pkg local hooks flags = do
- let target = datadir $ L.absoluteInstallDirs pkg local NoCopyDest
+ let target =
+#if MIN_VERSION_Cabal(3,11,0)
+ makeSymbolicPath $
+#endif
+ datadir $ L.absoluteInstallDirs pkg local NoCopyDest
testHook simpleUserHooks args (fixPkg pkg target) local hooks flags
-- -----------------------------------------------------------------------------
diff --git a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs
index 67966cb6f9..15fae62649 100644
--- a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs
+++ b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs
@@ -29,7 +29,7 @@ import Distribution.Types.DumpBuildInfo (DumpBuildInfo)
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.UnitId (DefUnitId, UnitId)
import Distribution.Utils.NubList (NubList)
-import Distribution.Utils.Path (SymbolicPath)
+import Distribution.Utils.Path (SymbolicPathX)
import Distribution.Utils.ShortText (ShortText, fromShortText)
import Distribution.Verbosity
import Distribution.Verbosity.Internal
@@ -55,7 +55,7 @@ instance ToExpr Dependency where
| cs == mainLibSet = App "Dependency" [toExpr pn, toExpr vr, App "mainLibSet" []]
| otherwise = genericToExpr d
-instance ToExpr (SymbolicPath from to)
+instance ToExpr (SymbolicPathX allowAbs from to)
instance ToExpr a => ToExpr (InstallDirs a)
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index eb3b6e055f..e987dcaea8 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -51,7 +51,13 @@ library
else
build-depends: unix >= 2.6.0.0 && < 2.9
- ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates
+ ghc-options:
+ -Wall
+ -fno-ignore-asserts
+ -fwarn-tabs
+ -fwarn-incomplete-uni-patterns
+ -fwarn-incomplete-record-updates
+ -fno-warn-unticked-promoted-constructors
if impl(ghc >= 8.0)
ghc-options: -Wcompat -Wnoncanonical-monad-instances
diff --git a/Cabal/src/Distribution/Compat/Internal/TempFile.hs b/Cabal/src/Distribution/Compat/Internal/TempFile.hs
index 805df70022..5d3683be07 100644
--- a/Cabal/src/Distribution/Compat/Internal/TempFile.hs
+++ b/Cabal/src/Distribution/Compat/Internal/TempFile.hs
@@ -126,10 +126,11 @@ createTempDirectory dir template = do
findTempName pid
where
findTempName x = do
- let dirpath = dir </> template ++ "-" ++ show x
+ let relpath = template ++ "-" ++ show x
+ dirpath = dir </> relpath
r <- tryIO $ mkPrivateDir dirpath
case r of
- Right _ -> return dirpath
+ Right _ -> return relpath
Left e
| isAlreadyExistsError e -> findTempName (x + 1)
| otherwise -> ioError e
diff --git a/Cabal/src/Distribution/Compat/Time.hs b/Cabal/src/Distribution/Compat/Time.hs
index 9727690bf1..9af0500fae 100644
--- a/Cabal/src/Distribution/Compat/Time.hs
+++ b/Cabal/src/Distribution/Compat/Time.hs
@@ -21,7 +21,8 @@ import Prelude ()
import System.Directory (getModificationTime)
-import Distribution.Simple.Utils (withTempDirectory)
+import Distribution.Simple.Utils (withTempDirectoryCwd)
+import Distribution.Utils.Path (getSymbolicPath, sameDirectory)
import Distribution.Verbosity (silent)
import System.FilePath
@@ -177,8 +178,8 @@ getCurTime = posixTimeToModTime `fmap` getPOSIXTime -- Uses 'gettimeofday'.
-- than 10 ms, but never larger than 1 second.
calibrateMtimeChangeDelay :: IO (Int, Int)
calibrateMtimeChangeDelay =
- withTempDirectory silent "." "calibration-" $ \dir -> do
- let fileName = dir </> "probe"
+ withTempDirectoryCwd silent Nothing sameDirectory "calibration-" $ \dir -> do
+ let fileName = getSymbolicPath dir </> "probe"
mtimes <- for [1 .. 25] $ \(i :: Int) -> time $ do
writeFile fileName $ show i
t0 <- getModTime fileName
diff --git a/Cabal/src/Distribution/Make.hs b/Cabal/src/Distribution/Make.hs
index 82334d550f..1568abaac6 100644
--- a/Cabal/src/Distribution/Make.hs
+++ b/Cabal/src/Distribution/Make.hs
@@ -68,15 +68,13 @@ import Distribution.Compat.Prelude
import Prelude ()
-- local
+import Distribution.License
import Distribution.Package
+import Distribution.Pretty
import Distribution.Simple.Command
import Distribution.Simple.Program
import Distribution.Simple.Setup
-
import Distribution.Simple.Utils
-
-import Distribution.License
-import Distribution.Pretty
import Distribution.Version
import System.Environment (getArgs, getProgName)
@@ -114,7 +112,6 @@ defaultMainHelper args = do
putStrLn $
"Cabal library version "
++ prettyShow cabalVersion
-
progs = defaultProgramDb
commands =
[ configureCommand progs `commandAddAction` configureAction
@@ -131,8 +128,9 @@ defaultMainHelper args = do
configureAction :: ConfigFlags -> [String] -> IO ()
configureAction flags args = do
noExtraFlags args
- let verbosity = fromFlag (configVerbosity flags)
- rawSystemExit verbosity "sh" $
+ let verbosity = fromFlag $ configVerbosity flags
+ mbWorkDir = flagToMaybe $ configWorkingDir flags
+ rawSystemExit verbosity mbWorkDir "sh" $
"configure"
: configureArgs backwardsCompatHack flags
where
@@ -141,47 +139,63 @@ configureAction flags args = do
copyAction :: CopyFlags -> [String] -> IO ()
copyAction flags args = do
noExtraFlags args
- let destArgs = case fromFlag $ copyDest flags of
+ let verbosity = fromFlag $ copyVerbosity flags
+ mbWorkDir = flagToMaybe $ copyWorkingDir flags
+ destArgs = case fromFlag $ copyDest flags of
NoCopyDest -> ["install"]
CopyTo path -> ["copy", "destdir=" ++ path]
CopyToDb _ -> error "CopyToDb not supported via Make"
- rawSystemExit (fromFlag $ copyVerbosity flags) "make" destArgs
+ rawSystemExit verbosity mbWorkDir "make" destArgs
installAction :: InstallFlags -> [String] -> IO ()
installAction flags args = do
noExtraFlags args
- rawSystemExit (fromFlag $ installVerbosity flags) "make" ["install"]
- rawSystemExit (fromFlag $ installVerbosity flags) "make" ["register"]
+ let verbosity = fromFlag $ installVerbosity flags
+ mbWorkDir = flagToMaybe $ installWorkingDir flags
+ rawSystemExit verbosity mbWorkDir "make" ["install"]
+ rawSystemExit verbosity mbWorkDir "make" ["register"]
haddockAction :: HaddockFlags -> [String] -> IO ()
haddockAction flags args = do
noExtraFlags args
- rawSystemExit (fromFlag $ haddockVerbosity flags) "make" ["docs"]
+ let verbosity = fromFlag $ haddockVerbosity flags
+ mbWorkDir = flagToMaybe $ haddockWorkingDir flags
+ rawSystemExit verbosity mbWorkDir "make" ["docs"]
`catchIO` \_ ->
- rawSystemExit (fromFlag $ haddockVerbosity flags) "make" ["doc"]
+ rawSystemExit verbosity mbWorkDir "make" ["doc"]
buildAction :: BuildFlags -> [String] -> IO ()
buildAction flags args = do
noExtraFlags args
- rawSystemExit (fromFlag $ buildVerbosity flags) "make" []
+ let verbosity = fromFlag $ buildVerbosity flags
+ mbWorkDir = flagToMaybe $ buildWorkingDir flags
+ rawSystemExit verbosity mbWorkDir "make" []
cleanAction :: CleanFlags -> [String] -> IO ()
cleanAction flags args = do
noExtraFlags args
- rawSystemExit (fromFlag $ cleanVerbosity flags) "make" ["clean"]
+ let verbosity = fromFlag $ cleanVerbosity flags
+ mbWorkDir = flagToMaybe $ cleanWorkingDir flags
+ rawSystemExit verbosity mbWorkDir "make" ["clean"]
sdistAction :: SDistFlags -> [String] -> IO ()
sdistAction flags args = do
noExtraFlags args
- rawSystemExit (fromFlag $ sDistVerbosity flags) "make" ["dist"]
+ let verbosity = fromFlag $ sDistVerbosity flags
+ mbWorkDir = flagToMaybe $ sDistWorkingDir flags
+ rawSystemExit verbosity mbWorkDir "make" ["dist"]
registerAction :: RegisterFlags -> [String] -> IO ()
registerAction flags args = do
noExtraFlags args
- rawSystemExit (fromFlag $ regVerbosity flags) "make" ["register"]
+ let verbosity = fromFlag $ registerVerbosity flags
+ mbWorkDir = flagToMaybe $ registerWorkingDir flags
+ rawSystemExit verbosity mbWorkDir "make" ["register"]
unregisterAction :: RegisterFlags -> [String] -> IO ()
unregisterAction flags args = do
noExtraFlags args
- rawSystemExit (fromFlag $ regVerbosity flags) "make" ["unregister"]
+ let verbosity = fromFlag $ registerVerbosity flags
+ mbWorkDir = flagToMaybe $ registerWorkingDir flags
+ rawSystemExit verbosity mbWorkDir "make" ["unregister"]
diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs
index 43f8bf0d2a..f444a4c23f 100644
--- a/Cabal/src/Distribution/PackageDescription/Check.hs
+++ b/Cabal/src/Distribution/PackageDescription/Check.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
@@ -70,14 +71,9 @@ import Distribution.Simple.Glob
import Distribution.Simple.Utils hiding (findPackageDesc, notice)
import Distribution.Utils.Generic (isAscii)
import Distribution.Utils.Path
- ( LicenseFile
- , PackageDir
- , SymbolicPath
- , getSymbolicPath
- )
import Distribution.Verbosity
import Distribution.Version
-import System.FilePath (splitExtension, takeFileName, (<.>), (</>))
+import System.FilePath (splitExtension, takeFileName)
import qualified Data.ByteString.Lazy as BS
import qualified Distribution.SPDX as SPDX
@@ -185,6 +181,7 @@ checkPackageFilesGPD verbosity gpd root =
, getDirectoryContentsM = System.Directory.getDirectoryContents . relative
}
+ relative :: FilePath -> FilePath
relative path = root </> path
-- | Same as 'checkPackageFilesGPD', but working with 'PackageDescription'.
@@ -456,19 +453,20 @@ checkPackageDescription
(PackageDistSuspicious ShortDesc)
-- § Paths.
- mapM_ (checkPath False "extra-source-files" PathKindGlob) extraSrcFiles_
- mapM_ (checkPath False "extra-tmp-files" PathKindFile) extraTmpFiles_
- mapM_ (checkPath False "extra-doc-files" PathKindGlob) extraDocFiles_
- mapM_ (checkPath False "data-files" PathKindGlob) dataFiles_
- checkPath True "data-dir" PathKindDirectory dataDir_
+ mapM_ (checkPath False "extra-source-files" PathKindGlob . getSymbolicPath) extraSrcFiles_
+ mapM_ (checkPath False "extra-tmp-files" PathKindFile . getSymbolicPath) extraTmpFiles_
+ mapM_ (checkPath False "extra-doc-files" PathKindGlob . getSymbolicPath) extraDocFiles_
+ mapM_ (checkPath False "data-files" PathKindGlob . getSymbolicPath) dataFiles_
+ let rawDataDir = getSymbolicPath dataDir_
+ checkPath True "data-dir" PathKindDirectory rawDataDir
let licPaths = map getSymbolicPath licenseFiles_
mapM_ (checkPath False "license-file" PathKindFile) licPaths
mapM_ checkLicFileExist licenseFiles_
-- § Globs.
- dataGlobs <- mapM (checkGlob "data-files") dataFiles_
- extraGlobs <- mapM (checkGlob "extra-source-files") extraSrcFiles_
- docGlobs <- mapM (checkGlob "extra-doc-files") extraDocFiles_
+ dataGlobs <- mapM (checkGlob "data-files" . getSymbolicPath) dataFiles_
+ extraGlobs <- mapM (checkGlob "extra-source-files" . getSymbolicPath) extraSrcFiles_
+ docGlobs <- mapM (checkGlob "extra-doc-files" . getSymbolicPath) extraDocFiles_
-- We collect globs to feed them to checkMissingDocs.
-- § Missing documentation.
@@ -519,9 +517,9 @@ checkPackageDescription
checkConfigureExists (buildType pkg)
checkSetupExists (buildType pkg)
checkCabalFile (packageName pkg)
- mapM_ (checkGlobFile specVersion_ "." "extra-source-files") extraSrcFiles_
- mapM_ (checkGlobFile specVersion_ "." "extra-doc-files") extraDocFiles_
- mapM_ (checkGlobFile specVersion_ dataDir_ "data-files") dataFiles_
+ mapM_ (checkGlobFile specVersion_ "." "extra-source-files" . getSymbolicPath) extraSrcFiles_
+ mapM_ (checkGlobFile specVersion_ "." "extra-doc-files" . getSymbolicPath) extraDocFiles_
+ mapM_ (checkGlobFile specVersion_ rawDataDir "data-files" . getSymbolicPath) dataFiles_
where
checkNull
:: Monad m
@@ -786,7 +784,7 @@ checkCabalFile pn = do
checkLicFileExist
:: Monad m
- => SymbolicPath PackageDir LicenseFile
+ => RelativePath Pkg File
-> CheckM m ()
checkLicFileExist sp = do
let fp = getSymbolicPath sp
diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs
index a610b5875a..fdafa89b6e 100644
--- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs
+++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs
@@ -86,7 +86,7 @@ checkLibrary
checkP
( not $
all
- (flip elem (allExplicitIncludes lib))
+ (flip elem (allExplicitIncludes lib) . getSymbolicPath)
(view L.autogenIncludes lib)
)
$ (PackageBuildImpossible AutogenIncludesNotIncluded)
@@ -107,8 +107,8 @@ checkLibrary
where
allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath]
allExplicitIncludes x =
- view L.includes x
- ++ view L.installIncludes x
+ map getSymbolicPath (view L.includes x)
+ ++ map getSymbolicPath (view L.installIncludes x)
checkForeignLib :: Monad m => ForeignLib -> CheckM m ()
checkForeignLib
@@ -136,12 +136,13 @@ checkExecutable
ads
exe@( Executable
exeName_
- modulePath_
+ symbolicModulePath_
_exeScope_
buildInfo_
) = do
-- Target type/name (exe).
let cet = CETExecutable exeName_
+ modulePath_ = getSymbolicPath symbolicModulePath_
-- § Exe specific checks
checkP
@@ -172,7 +173,7 @@ checkExecutable
checkP
( not $
all
- (flip elem (view L.includes exe))
+ (flip elem (view L.includes exe) . relativeSymbolicPath)
(view L.autogenIncludes exe)
)
(PackageBuildImpossible AutogenIncludesNotIncludedExe)
@@ -217,7 +218,7 @@ checkTestSuite
checkP
( not $
all
- (flip elem (view L.includes ts))
+ (flip elem (view L.includes ts) . relativeSymbolicPath)
(view L.autogenIncludes ts)
)
(PackageBuildImpossible AutogenIncludesNotIncludedExe)
@@ -233,12 +234,12 @@ checkTestSuite
where
mainIsWrongExt =
case testInterface_ of
- TestSuiteExeV10 _ f -> not (fileExtensionSupportedLanguage f)
+ TestSuiteExeV10 _ f -> not (fileExtensionSupportedLanguage $ getSymbolicPath f)
_ -> False
mainIsNotHsExt =
case testInterface_ of
- TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
+ TestSuiteExeV10 _ f -> takeExtension (getSymbolicPath f) `notElem` [".hs", ".lhs"]
_ -> False
checkBenchmark
@@ -278,7 +279,7 @@ checkBenchmark
checkP
( not $
all
- (flip elem (view L.includes bm))
+ (flip elem (view L.includes bm) . relativeSymbolicPath)
(view L.autogenIncludes bm)
)
(PackageBuildImpossible AutogenIncludesNotIncludedExe)
@@ -290,7 +291,7 @@ checkBenchmark
-- they are different.
mainIsWrongExt =
case benchmarkInterface_ of
- BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
+ BenchmarkExeV10 _ f -> takeExtension (getSymbolicPath f) `notElem` [".hs", ".lhs"]
_ -> False
-- ------------------------------------------------------------
@@ -346,14 +347,14 @@ checkBuildInfo cet ams ads bi = do
mapM_ checkCustomField (customFieldsBI bi)
-- Content.
- mapM_ (checkLocalPathExist "extra-lib-dirs") (extraLibDirs bi)
+ mapM_ (checkLocalPathExist "extra-lib-dirs" . getSymbolicPath) (extraLibDirs bi)
mapM_
- (checkLocalPathExist "extra-lib-dirs-static")
+ (checkLocalPathExist "extra-lib-dirs-static" . getSymbolicPath)
(extraLibDirsStatic bi)
mapM_
- (checkLocalPathExist "extra-framework-dirs")
+ (checkLocalPathExist "extra-framework-dirs" . getSymbolicPath)
(extraFrameworkDirs bi)
- mapM_ (checkLocalPathExist "include-dirs") (includeDirs bi)
+ mapM_ (checkLocalPathExist "include-dirs" . getSymbolicPath) (includeDirs bi)
mapM_
(checkLocalPathExist "hs-source-dirs" . getSymbolicPath)
(hsSourceDirs bi)
@@ -431,27 +432,27 @@ checkBuildInfoPathsContent bi = do
-- Paths well-formedness check for BuildInfo.
checkBuildInfoPathsWellFormedness :: Monad m => BuildInfo -> CheckM m ()
checkBuildInfoPathsWellFormedness bi = do
- mapM_ (checkPath False "asm-sources" PathKindFile) (asmSources bi)
- mapM_ (checkPath False "cmm-sources" PathKindFile) (cmmSources bi)
- mapM_ (checkPath False "c-sources" PathKindFile) (cSources bi)
- mapM_ (checkPath False "cxx-sources" PathKindFile) (cxxSources bi)
- mapM_ (checkPath False "js-sources" PathKindFile) (jsSources bi)
+ mapM_ (checkPath False "asm-sources" PathKindFile . getSymbolicPath) (asmSources bi)
+ mapM_ (checkPath False "cmm-sources" PathKindFile . getSymbolicPath) (cmmSources bi)
+ mapM_ (checkPath False "c-sources" PathKindFile . getSymbolicPath) (cSources bi)
+ mapM_ (checkPath False "cxx-sources" PathKindFile . getSymbolicPath) (cxxSources bi)
+ mapM_ (checkPath False "js-sources" PathKindFile . getSymbolicPath) (jsSources bi)
mapM_
- (checkPath False "install-includes" PathKindFile)
+ (checkPath False "install-includes" PathKindFile . getSymbolicPath)
(installIncludes bi)
mapM_
(checkPath False "hs-source-dirs" PathKindDirectory . getSymbolicPath)
(hsSourceDirs bi)
-- Possibly absolute paths.
- mapM_ (checkPath True "includes" PathKindFile) (includes bi)
+ mapM_ (checkPath True "includes" PathKindFile . getSymbolicPath) (includes bi)
mapM_
- (checkPath True "include-dirs" PathKindDirectory)
+ (checkPath True "include-dirs" PathKindDirectory . getSymbolicPath)
(includeDirs bi)
mapM_
- (checkPath True "extra-lib-dirs" PathKindDirectory)
+ (checkPath True "extra-lib-dirs" PathKindDirectory . getSymbolicPath)
(extraLibDirs bi)
mapM_
- (checkPath True "extra-lib-dirs-static" PathKindDirectory)
+ (checkPath True "extra-lib-dirs-static" PathKindDirectory . getSymbolicPath)
(extraLibDirsStatic bi)
mapM_ checkOptionPath (perCompilerFlavorToList $ options bi)
where
@@ -501,8 +502,8 @@ checkBuildInfoFeatures bi sv = do
(PackageBuildWarning CVExtensionsDeprecated)
-- asm-sources, cmm-sources and friends only w/ spec ≥ 1.10
- checkCVSources (asmSources bi)
- checkCVSources (cmmSources bi)
+ checkCVSources (map getSymbolicPath $ asmSources bi)
+ checkCVSources (map getSymbolicPath $ cmmSources bi)
checkCVSources (extraBundledLibs bi)
checkCVSources (extraLibFlavours bi)
diff --git a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs
index 6f21d5d0da..859b3f12c5 100644
--- a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs
+++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -47,11 +48,6 @@ import Distribution.Types.TestType (TestType, knownTestTypes)
import Distribution.Types.UnqualComponentName
import Distribution.Types.Version (Version)
import Distribution.Utils.Path
- ( LicenseFile
- , PackageDir
- , SymbolicPath
- , getSymbolicPath
- )
import Language.Haskell.Extension (Extension)
import qualified Data.Either as Either
@@ -276,7 +272,7 @@ data CheckExplanation
| NotPackageName FilePath String
| NoDesc
| MultiDesc [String]
- | UnknownFile String (SymbolicPath PackageDir LicenseFile)
+ | UnknownFile String (RelativePath Pkg File)
| MissingSetupFile
| MissingConfigureScript
| UnknownDirectory String FilePath
@@ -1117,9 +1113,9 @@ ppExplanation (InvalidOnWin paths) =
++ quotes paths
++ " invalid on Windows, which "
++ "would cause portability problems for this package. Windows file "
- ++ "names cannot contain any of the characters \":*?<>|\" and there "
- ++ "a few reserved names including \"aux\", \"nul\", \"con\", "
- ++ "\"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"."
+ ++ "names cannot contain any of the characters \":*?<>|\", and there "
+ ++ "are a few reserved names including \"aux\", \"nul\", \"con\", "
+ ++ "\"prn\", \"com{1-9}\", \"lpt{1-9}\" and \"clock$\"."
where
quotes [failed] = "path " ++ quote failed ++ " is"
quotes failed =
diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs
index 58e9f4046b..657e37cbbc 100644
--- a/Cabal/src/Distribution/Simple.hs
+++ b/Cabal/src/Distribution/Simple.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
@@ -98,6 +99,7 @@ import Distribution.Simple.Install
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Test
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
import Language.Haskell.Extension
@@ -112,7 +114,6 @@ import System.Directory
, removeFile
)
import System.Environment (getArgs, getProgName)
-import System.FilePath (takeDirectory, (</>))
import Data.List (unionBy, (\\))
@@ -173,15 +174,15 @@ defaultMainHelper hooks args = topHandler $ do
CommandHelp help -> printHelp help
CommandList opts -> printOptionsList opts
CommandErrors errs -> printErrors errs
- CommandReadyToGo (flags, commandParse) ->
+ CommandReadyToGo (globalFlags, commandParse) ->
case commandParse of
_
- | fromFlag (globalVersion flags) -> printVersion
- | fromFlag (globalNumericVersion flags) -> printNumericVersion
+ | fromFlag (globalVersion globalFlags) -> printVersion
+ | fromFlag (globalNumericVersion globalFlags) -> printNumericVersion
CommandHelp help -> printHelp help
CommandList opts -> printOptionsList opts
CommandErrors errs -> printErrors errs
- CommandReadyToGo action -> action
+ CommandReadyToGo action -> action globalFlags
where
printHelp help = getProgName >>= putStr . help
printOptionsList = putStr . unlines
@@ -195,21 +196,24 @@ defaultMainHelper hooks args = topHandler $ do
++ prettyShow cabalVersion
progs = addKnownPrograms (hookedPrograms hooks) defaultProgramDb
+ addAction :: CommandUI flags -> (GlobalFlags -> UserHooks -> flags -> [String] -> IO res) -> Command (GlobalFlags -> IO ())
+ addAction cmd action =
+ cmd `commandAddAction` \flags as globalFlags -> void $ action globalFlags hooks flags as
+ commands :: [Command (GlobalFlags -> IO ())]
commands =
- [ configureCommand progs
- `commandAddAction` \fs as -> configureAction hooks fs as >> return ()
- , buildCommand progs `commandAddAction` buildAction hooks
- , replCommand progs `commandAddAction` replAction hooks
- , installCommand `commandAddAction` installAction hooks
- , copyCommand `commandAddAction` copyAction hooks
- , haddockCommand `commandAddAction` haddockAction hooks
- , cleanCommand `commandAddAction` cleanAction hooks
- , sdistCommand `commandAddAction` sdistAction hooks
- , hscolourCommand `commandAddAction` hscolourAction hooks
- , registerCommand `commandAddAction` registerAction hooks
- , unregisterCommand `commandAddAction` unregisterAction hooks
- , testCommand `commandAddAction` testAction hooks
- , benchmarkCommand `commandAddAction` benchAction hooks
+ [ configureCommand progs `addAction` configureAction
+ , buildCommand progs `addAction` buildAction
+ , replCommand progs `addAction` replAction
+ , installCommand `addAction` installAction
+ , copyCommand `addAction` copyAction
+ , haddockCommand `addAction` haddockAction
+ , cleanCommand `addAction` cleanAction
+ , sdistCommand `addAction` sdistAction
+ , hscolourCommand `addAction` hscolourAction
+ , registerCommand `addAction` registerAction
+ , unregisterCommand `addAction` unregisterAction
+ , testCommand `addAction` testAction
+ , benchmarkCommand `addAction` benchAction
]
-- | Combine the preprocessors in the given hooks with the
@@ -223,14 +227,22 @@ allSuffixHandlers hooks =
overridesPP :: [PPSuffixHandler] -> [PPSuffixHandler] -> [PPSuffixHandler]
overridesPP = unionBy (\x y -> fst x == fst y)
-configureAction :: UserHooks -> ConfigFlags -> Args -> IO LocalBuildInfo
-configureAction hooks flags args = do
- distPref <- findDistPrefOrDefault (configDistPref flags)
- let flags' =
+configureAction :: GlobalFlags -> UserHooks -> ConfigFlags -> Args -> IO LocalBuildInfo
+configureAction globalFlags hooks flags args = do
+ distPref <- findDistPrefOrDefault (setupDistPref $ configCommonFlags flags)
+ let commonFlags = configCommonFlags flags
+ commonFlags' =
+ commonFlags
+ { setupDistPref = toFlag distPref
+ , setupWorkingDir = globalWorkingDir globalFlags <> setupWorkingDir commonFlags
+ , setupTargets = args
+ }
+ flags' =
flags
- { configDistPref = toFlag distPref
- , configArgs = args
+ { configCommonFlags = commonFlags'
}
+ mbWorkDir = flagToMaybe $ setupWorkingDir commonFlags'
+ verbosity = fromFlag $ setupVerbosity commonFlags'
-- See docs for 'HookedBuildInfo'
pbi <- preConf hooks args flags'
@@ -239,7 +251,8 @@ configureAction hooks flags args = do
confPkgDescr
hooks
verbosity
- (flagToMaybe (configCabalFilePath flags))
+ mbWorkDir
+ (flagToMaybe (setupCabalFilePath commonFlags'))
let epkg_descr = (pkg_descr0, pbi)
@@ -252,41 +265,60 @@ configureAction hooks flags args = do
{ pkgDescrFile = mb_pd_file
, extraConfigArgs = args
}
- writePersistBuildConfig distPref localbuildinfo
+ writePersistBuildConfig mbWorkDir distPref localbuildinfo
let pkg_descr = localPkgDescr localbuildinfo
postConf hooks args flags' pkg_descr localbuildinfo
return localbuildinfo
- where
- verbosity = fromFlag (configVerbosity flags)
confPkgDescr
:: UserHooks
-> Verbosity
- -> Maybe FilePath
- -> IO (Maybe FilePath, GenericPackageDescription)
-confPkgDescr hooks verbosity mb_path = do
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> Maybe (SymbolicPath Pkg File)
+ -> IO (Maybe (SymbolicPath Pkg File), GenericPackageDescription)
+confPkgDescr hooks verbosity cwd mb_path = do
mdescr <- readDesc hooks
case mdescr of
Just descr -> return (Nothing, descr)
Nothing -> do
pdfile <- case mb_path of
- Nothing -> defaultPackageDesc verbosity
+ Nothing -> relativeSymbolicPath <$> tryFindPackageDesc verbosity cwd
Just path -> return path
info verbosity "Using Parsec parser"
- descr <- readGenericPackageDescription verbosity pdfile
+ descr <- readGenericPackageDescription verbosity cwd pdfile
return (Just pdfile, descr)
-buildAction :: UserHooks -> BuildFlags -> Args -> IO ()
-buildAction hooks flags args = do
- distPref <- findDistPrefOrDefault (buildDistPref flags)
- let verbosity = fromFlag $ buildVerbosity flags
- lbi <- getBuildConfig hooks verbosity distPref
- let flags' =
- flags
- { buildDistPref = toFlag distPref
- , buildCabalFilePath = maybeToFlag (cabalFilePath lbi)
- }
+getCommonFlags
+ :: GlobalFlags
+ -> UserHooks
+ -> CommonSetupFlags
+ -> Args
+ -> IO (LocalBuildInfo, CommonSetupFlags)
+getCommonFlags globalFlags hooks commonFlags args = do
+ distPref <- findDistPrefOrDefault (setupDistPref commonFlags)
+ let verbosity = fromFlag $ setupVerbosity commonFlags
+ lbi <- getBuildConfig globalFlags hooks verbosity distPref
+ let common' = configCommonFlags $ configFlags lbi
+ return $
+ ( lbi
+ , commonFlags
+ { setupDistPref = toFlag distPref
+ , setupCabalFilePath = setupCabalFilePath common' <> setupCabalFilePath commonFlags
+ , setupWorkingDir =
+ globalWorkingDir globalFlags
+ <> setupWorkingDir common'
+ <> setupWorkingDir commonFlags
+ , setupTargets = args
+ }
+ )
+
+buildAction :: GlobalFlags -> UserHooks -> BuildFlags -> Args -> IO ()
+buildAction globalFlags hooks flags args = do
+ let common = buildCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ (lbi, common') <- getCommonFlags globalFlags hooks common args
+ let flags' = flags{buildCommonFlags = common'}
progs <-
reconfigurePrograms
@@ -302,16 +334,15 @@ buildAction hooks flags args = do
postBuild
(return lbi{withPrograms = progs})
hooks
- flags'{buildArgs = args}
+ flags'
args
-replAction :: UserHooks -> ReplFlags -> Args -> IO ()
-replAction hooks flags args = do
- distPref <- findDistPrefOrDefault (replDistPref flags)
- let verbosity = fromFlag $ replVerbosity flags
- flags' = flags{replDistPref = toFlag distPref}
-
- lbi <- getBuildConfig hooks verbosity distPref
+replAction :: GlobalFlags -> UserHooks -> ReplFlags -> Args -> IO ()
+replAction globalFlags hooks flags args = do
+ let common = replCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ (lbi, common') <- getCommonFlags globalFlags hooks common args
+ let flags' = flags{replCommonFlags = common'}
progs <-
reconfigurePrograms
verbosity
@@ -334,37 +365,30 @@ replAction hooks flags args = do
replHook hooks pkg_descr lbi' hooks flags' args
postRepl hooks args flags' pkg_descr lbi'
-hscolourAction :: UserHooks -> HscolourFlags -> Args -> IO ()
-hscolourAction hooks flags args = do
- distPref <- findDistPrefOrDefault (hscolourDistPref flags)
- let verbosity = fromFlag $ hscolourVerbosity flags
- lbi <- getBuildConfig hooks verbosity distPref
- let flags' =
- flags
- { hscolourDistPref = toFlag distPref
- , hscolourCabalFilePath = maybeToFlag (cabalFilePath lbi)
- }
+hscolourAction :: GlobalFlags -> UserHooks -> HscolourFlags -> Args -> IO ()
+hscolourAction globalFlags hooks flags args = do
+ let common = hscolourCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ (_lbi, common') <- getCommonFlags globalFlags hooks common args
+ let flags' = flags{hscolourCommonFlags = common'}
+ distPref = fromFlag $ setupDistPref common'
hookedAction
verbosity
preHscolour
hscolourHook
postHscolour
- (getBuildConfig hooks verbosity distPref)
+ (getBuildConfig globalFlags hooks verbosity distPref)
hooks
flags'
args
-haddockAction :: UserHooks -> HaddockFlags -> Args -> IO ()
-haddockAction hooks flags args = do
- distPref <- findDistPrefOrDefault (haddockDistPref flags)
- let verbosity = fromFlag $ haddockVerbosity flags
- lbi <- getBuildConfig hooks verbosity distPref
- let flags' =
- flags
- { haddockDistPref = toFlag distPref
- , haddockCabalFilePath = maybeToFlag (cabalFilePath lbi)
- }
+haddockAction :: GlobalFlags -> UserHooks -> HaddockFlags -> Args -> IO ()
+haddockAction globalFlags hooks flags args = do
+ let common = haddockCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ (lbi, common') <- getCommonFlags globalFlags hooks common args
+ let flags' = flags{haddockCommonFlags = common'}
progs <-
reconfigurePrograms
@@ -380,25 +404,42 @@ haddockAction hooks flags args = do
postHaddock
(return lbi{withPrograms = progs})
hooks
- flags'{haddockArgs = args}
+ flags'
args
-cleanAction :: UserHooks -> CleanFlags -> Args -> IO ()
-cleanAction hooks flags args = do
- distPref <- findDistPrefOrDefault (cleanDistPref flags)
-
- elbi <- tryGetBuildConfig hooks verbosity distPref
- let flags' =
- flags
- { cleanDistPref = toFlag distPref
- , cleanCabalFilePath = case elbi of
- Left _ -> mempty
- Right lbi -> maybeToFlag (cabalFilePath lbi)
+cleanAction :: GlobalFlags -> UserHooks -> CleanFlags -> Args -> IO ()
+cleanAction globalFlags hooks flags args = do
+ let common = cleanCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ distPref <- findDistPrefOrDefault (setupDistPref common)
+ elbi <- tryGetBuildConfig globalFlags hooks verbosity distPref
+ let common' =
+ common
+ { setupDistPref = toFlag distPref
+ , setupWorkingDir = case elbi of
+ Left _ ->
+ globalWorkingDir globalFlags
+ <> setupWorkingDir common
+ Right lbi ->
+ globalWorkingDir globalFlags
+ <> setupWorkingDir (configCommonFlags $ configFlags lbi)
+ <> setupWorkingDir common
+ , setupCabalFilePath = case elbi of
+ Left _ -> setupCabalFilePath common
+ Right lbi ->
+ setupCabalFilePath common
+ <> setupCabalFilePath (configCommonFlags $ configFlags lbi)
+ , setupTargets = args
}
+ flags' =
+ flags{cleanCommonFlags = common'}
+
+ mbWorkDirFlag = cleanWorkingDir flags
+ mbWorkDir = flagToMaybe mbWorkDirFlag
pbi <- preClean hooks args flags'
- (_, ppd) <- confPkgDescr hooks verbosity Nothing
+ (_, ppd) <- confPkgDescr hooks verbosity mbWorkDir Nothing
-- It might seem like we are doing something clever here
-- but we're really not: if you look at the implementation
-- of 'clean' in the end all the package description is
@@ -413,125 +454,115 @@ cleanAction hooks flags args = do
cleanHook hooks pkg_descr () hooks flags'
postClean hooks args flags' pkg_descr ()
- where
- verbosity = fromFlag (cleanVerbosity flags)
-
-copyAction :: UserHooks -> CopyFlags -> Args -> IO ()
-copyAction hooks flags args = do
- distPref <- findDistPrefOrDefault (copyDistPref flags)
- let verbosity = fromFlag $ copyVerbosity flags
- lbi <- getBuildConfig hooks verbosity distPref
- let flags' =
- flags
- { copyDistPref = toFlag distPref
- , copyCabalFilePath = maybeToFlag (cabalFilePath lbi)
- }
+
+copyAction :: GlobalFlags -> UserHooks -> CopyFlags -> Args -> IO ()
+copyAction globalFlags hooks flags args = do
+ let common = copyCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ (_lbi, common') <- getCommonFlags globalFlags hooks common args
+ let flags' = flags{copyCommonFlags = common'}
+ distPref = fromFlag $ setupDistPref common'
hookedAction
verbosity
preCopy
copyHook
postCopy
- (getBuildConfig hooks verbosity distPref)
+ (getBuildConfig globalFlags hooks verbosity distPref)
hooks
- flags'{copyArgs = args}
+ flags'
args
-installAction :: UserHooks -> InstallFlags -> Args -> IO ()
-installAction hooks flags args = do
- distPref <- findDistPrefOrDefault (installDistPref flags)
- let verbosity = fromFlag $ installVerbosity flags
- lbi <- getBuildConfig hooks verbosity distPref
- let flags' =
- flags
- { installDistPref = toFlag distPref
- , installCabalFilePath = maybeToFlag (cabalFilePath lbi)
- }
+installAction :: GlobalFlags -> UserHooks -> InstallFlags -> Args -> IO ()
+installAction globalFlags hooks flags args = do
+ let common = installCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ (_lbi, common') <- getCommonFlags globalFlags hooks common args
+ let flags' = flags{installCommonFlags = common'}
+ distPref = fromFlag $ setupDistPref common'
hookedAction
verbosity
preInst
instHook
postInst
- (getBuildConfig hooks verbosity distPref)
+ (getBuildConfig globalFlags hooks verbosity distPref)
hooks
flags'
args
-- Since Cabal-3.4 UserHooks are completely ignored
-sdistAction :: UserHooks -> SDistFlags -> Args -> IO ()
-sdistAction _hooks flags _args = do
- (_, ppd) <- confPkgDescr emptyUserHooks verbosity Nothing
+sdistAction :: GlobalFlags -> UserHooks -> SDistFlags -> Args -> IO ()
+sdistAction _globalFlags _hooks flags _args = do
+ let mbWorkDir = flagToMaybe $ sDistWorkingDir flags
+ (_, ppd) <- confPkgDescr emptyUserHooks verbosity mbWorkDir Nothing
let pkg_descr = flattenPackageDescription ppd
sdist pkg_descr flags srcPref knownSuffixHandlers
where
- verbosity = fromFlag (sDistVerbosity flags)
-
-testAction :: UserHooks -> TestFlags -> Args -> IO ()
-testAction hooks flags args = do
- distPref <- findDistPrefOrDefault (testDistPref flags)
- let verbosity = fromFlag $ testVerbosity flags
- flags' = flags{testDistPref = toFlag distPref}
-
+ verbosity = fromFlag (setupVerbosity $ sDistCommonFlags flags)
+
+testAction :: GlobalFlags -> UserHooks -> TestFlags -> Args -> IO ()
+testAction globalFlags hooks flags args = do
+ let common = testCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ (_lbi, common') <- getCommonFlags globalFlags hooks common args
+ let flags' = flags{testCommonFlags = common'}
+ distPref = fromFlag $ setupDistPref common'
hookedActionWithArgs
verbosity
preTest
testHook
postTest
- (getBuildConfig hooks verbosity distPref)
+ (getBuildConfig globalFlags hooks verbosity distPref)
hooks
flags'
args
-benchAction :: UserHooks -> BenchmarkFlags -> Args -> IO ()
-benchAction hooks flags args = do
- distPref <- findDistPrefOrDefault (benchmarkDistPref flags)
- let verbosity = fromFlag $ benchmarkVerbosity flags
- flags' = flags{benchmarkDistPref = toFlag distPref}
+benchAction :: GlobalFlags -> UserHooks -> BenchmarkFlags -> Args -> IO ()
+benchAction globalFlags hooks flags args = do
+ let common = benchmarkCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ (_lbi, common') <- getCommonFlags globalFlags hooks common args
+ let flags' = flags{benchmarkCommonFlags = common'}
+ distPref = fromFlag $ setupDistPref common'
hookedActionWithArgs
verbosity
preBench
benchHook
postBench
- (getBuildConfig hooks verbosity distPref)
+ (getBuildConfig globalFlags hooks verbosity distPref)
hooks
flags'
args
-registerAction :: UserHooks -> RegisterFlags -> Args -> IO ()
-registerAction hooks flags args = do
- distPref <- findDistPrefOrDefault (regDistPref flags)
- let verbosity = fromFlag $ regVerbosity flags
- lbi <- getBuildConfig hooks verbosity distPref
- let flags' =
- flags
- { regDistPref = toFlag distPref
- , regCabalFilePath = maybeToFlag (cabalFilePath lbi)
- }
+registerAction :: GlobalFlags -> UserHooks -> RegisterFlags -> Args -> IO ()
+registerAction globalFlags hooks flags args = do
+ let common = registerCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ (_lbi, common') <- getCommonFlags globalFlags hooks common args
+ let flags' = flags{registerCommonFlags = common'}
+ distPref = fromFlag $ setupDistPref common'
hookedAction
verbosity
preReg
regHook
postReg
- (getBuildConfig hooks verbosity distPref)
+ (getBuildConfig globalFlags hooks verbosity distPref)
hooks
- flags'{regArgs = args}
+ flags'
args
-unregisterAction :: UserHooks -> RegisterFlags -> Args -> IO ()
-unregisterAction hooks flags args = do
- distPref <- findDistPrefOrDefault (regDistPref flags)
- let verbosity = fromFlag $ regVerbosity flags
- lbi <- getBuildConfig hooks verbosity distPref
- let flags' =
- flags
- { regDistPref = toFlag distPref
- , regCabalFilePath = maybeToFlag (cabalFilePath lbi)
- }
+unregisterAction :: GlobalFlags -> UserHooks -> RegisterFlags -> Args -> IO ()
+unregisterAction globalFlags hooks flags args = do
+ let common = registerCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ (_lbi, common') <- getCommonFlags globalFlags hooks common args
+ let flags' = flags{registerCommonFlags = common'}
+ distPref = fromFlag $ setupDistPref common'
hookedAction
verbosity
preUnreg
unregHook
postUnreg
- (getBuildConfig hooks verbosity distPref)
+ (getBuildConfig globalFlags hooks verbosity distPref)
hooks
flags'
args
@@ -625,16 +656,22 @@ sanityCheckHookedBuildInfo _ _ _ = return ()
-- | Try to read the 'localBuildInfoFile'
tryGetBuildConfig
- :: UserHooks
+ :: GlobalFlags
+ -> UserHooks
-> Verbosity
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-> IO (Either ConfigStateFileError LocalBuildInfo)
-tryGetBuildConfig u v = try . getBuildConfig u v
+tryGetBuildConfig g u v = try . getBuildConfig g u v
-- | Read the 'localBuildInfoFile' or throw an exception.
-getBuildConfig :: UserHooks -> Verbosity -> FilePath -> IO LocalBuildInfo
-getBuildConfig hooks verbosity distPref = do
- lbi_wo_programs <- getPersistBuildConfig distPref
+getBuildConfig
+ :: GlobalFlags
+ -> UserHooks
+ -> Verbosity
+ -> SymbolicPath Pkg (Dir Dist)
+ -> IO LocalBuildInfo
+getBuildConfig globalFlags hooks verbosity distPref = do
+ lbi_wo_programs <- getPersistBuildConfig mbWorkDir distPref
-- Restore info about unconfigured programs, since it is not serialized
let lbi =
lbi_wo_programs
@@ -647,15 +684,16 @@ getBuildConfig hooks verbosity distPref = do
case pkgDescrFile lbi of
Nothing -> return lbi
Just pkg_descr_file -> do
- outdated <- checkPersistBuildConfigOutdated distPref pkg_descr_file
+ outdated <- checkPersistBuildConfigOutdated mbWorkDir distPref pkg_descr_file
if outdated
then reconfigure pkg_descr_file lbi
else return lbi
where
- reconfigure :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo
+ mbWorkDir = flagToMaybe $ globalWorkingDir globalFlags
+ reconfigure :: SymbolicPath Pkg File -> LocalBuildInfo -> IO LocalBuildInfo
reconfigure pkg_descr_file lbi = do
notice verbosity $
- pkg_descr_file
+ getSymbolicPath pkg_descr_file
++ " has been changed. "
++ "Re-configuring with most recently used options. "
++ "If this fails, please run configure manually.\n"
@@ -671,35 +709,43 @@ getBuildConfig hooks verbosity distPref = do
(builtinPrograms ++ hookedPrograms hooks)
)
`fmap` configPrograms_ cFlags
- , -- Use the current, not saved verbosity level:
- configVerbosity = Flag verbosity
+ , configCommonFlags =
+ (configCommonFlags cFlags)
+ { -- Use the current, not saved verbosity level:
+ setupVerbosity = Flag verbosity
+ }
}
- configureAction hooks cFlags' (extraConfigArgs lbi)
+ configureAction globalFlags hooks cFlags' (extraConfigArgs lbi)
-- --------------------------------------------------------------------------
-- Cleaning
clean :: PackageDescription -> CleanFlags -> IO ()
clean pkg_descr flags = do
- let distPref = fromFlagOrDefault defaultDistPref $ cleanDistPref flags
+ let common = cleanCommonFlags flags
+ verbosity = fromFlag (setupVerbosity common)
+ distPref = fromFlagOrDefault defaultDistPref $ setupDistPref common
+ mbWorkDir = flagToMaybe $ setupWorkingDir common
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
+ distPath = i distPref
notice verbosity "cleaning..."
maybeConfig <-
if fromFlag (cleanSaveConf flags)
- then maybeGetPersistBuildConfig distPref
+ then maybeGetPersistBuildConfig mbWorkDir distPref
else return Nothing
-- remove the whole dist/ directory rather than tracking exactly what files
-- we created in there.
chattyTry "removing dist/" $ do
- exists <- doesDirectoryExist distPref
- when exists (removeDirectoryRecursive distPref)
+ exists <- doesDirectoryExist distPath
+ when exists (removeDirectoryRecursive distPath)
-- Any extra files the user wants to remove
- traverse_ removeFileOrDirectory (extraTmpFiles pkg_descr)
+ traverse_ (removeFileOrDirectory . i) (extraTmpFiles pkg_descr)
-- If the user wanted to save the config, write it back
- traverse_ (writePersistBuildConfig distPref) maybeConfig
+ traverse_ (writePersistBuildConfig mbWorkDir distPref) maybeConfig
where
removeFileOrDirectory :: FilePath -> IO ()
removeFileOrDirectory fname = do
@@ -708,7 +754,6 @@ clean pkg_descr flags = do
if isDir
then removeDirectoryRecursive fname
else when isFile $ removeFile fname
- verbosity = fromFlag (cleanVerbosity flags)
-- --------------------------------------------------------------------------
-- Default hooks
@@ -737,7 +782,7 @@ simpleUserHooks =
finalChecks _args flags pkg_descr lbi =
checkForeignDeps pkg_descr lbi (lessVerbose verbosity)
where
- verbosity = fromFlag (configVerbosity flags)
+ verbosity = fromFlag (setupVerbosity $ configCommonFlags flags)
-- | Basic autoconf 'UserHooks':
--
@@ -752,17 +797,17 @@ autoconfUserHooks :: UserHooks
autoconfUserHooks =
simpleUserHooks
{ postConf = defaultPostConf
- , preBuild = readHookWithArgs buildVerbosity buildDistPref
- , preRepl = readHookWithArgs replVerbosity replDistPref
- , preCopy = readHookWithArgs copyVerbosity copyDistPref
- , preClean = readHook cleanVerbosity cleanDistPref
- , preInst = readHook installVerbosity installDistPref
- , preHscolour = readHook hscolourVerbosity hscolourDistPref
- , preHaddock = readHookWithArgs haddockVerbosity haddockDistPref
- , preReg = readHook regVerbosity regDistPref
- , preUnreg = readHook regVerbosity regDistPref
- , preTest = readHookWithArgs testVerbosity testDistPref
- , preBench = readHookWithArgs benchmarkVerbosity benchmarkDistPref
+ , preBuild = readHookWithArgs buildCommonFlags
+ , preRepl = readHookWithArgs replCommonFlags
+ , preCopy = readHookWithArgs copyCommonFlags
+ , preClean = readHook cleanCommonFlags
+ , preInst = readHook installCommonFlags
+ , preHscolour = readHook hscolourCommonFlags
+ , preHaddock = readHookWithArgs haddockCommonFlags
+ , preReg = readHook registerCommonFlags
+ , preUnreg = readHook registerCommonFlags
+ , preTest = readHookWithArgs testCommonFlags
+ , preBench = readHookWithArgs benchmarkCommonFlags
}
where
defaultPostConf
@@ -773,12 +818,11 @@ autoconfUserHooks =
-> IO ()
defaultPostConf args flags pkg_descr lbi =
do
- let verbosity = fromFlag (configVerbosity flags)
- baseDir lbi' =
- fromMaybe
- ""
- (takeDirectory <$> cabalFilePath lbi')
- confExists <- doesFileExist $ (baseDir lbi) </> "configure"
+ let common = configCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ mbWorkDir = flagToMaybe $ setupWorkingDir common
+ baseDir = packageRoot common
+ confExists <- doesFileExist $ baseDir </> "configure"
if confExists
then
runConfigureScript
@@ -787,45 +831,51 @@ autoconfUserHooks =
lbi
else dieWithException verbosity ConfigureScriptNotFound
- pbi <- getHookedBuildInfo verbosity (buildDir lbi)
+ pbi <- getHookedBuildInfo verbosity mbWorkDir (buildDir lbi)
sanityCheckHookedBuildInfo verbosity pkg_descr pbi
let pkg_descr' = updatePackageDescription pbi pkg_descr
lbi' = lbi{localPkgDescr = pkg_descr'}
postConf simpleUserHooks args flags pkg_descr' lbi'
readHookWithArgs
- :: (a -> Flag Verbosity)
- -> (a -> Flag FilePath)
+ :: (flags -> CommonSetupFlags)
-> Args
- -> a
+ -> flags
-> IO HookedBuildInfo
- readHookWithArgs get_verbosity get_dist_pref _ flags = do
- dist_dir <- findDistPrefOrDefault (get_dist_pref flags)
- getHookedBuildInfo verbosity (dist_dir </> "build")
- where
- verbosity = fromFlag (get_verbosity flags)
+ readHookWithArgs get_common_flags _args flags = do
+ let common = get_common_flags flags
+ verbosity = fromFlag (setupVerbosity common)
+ mbWorkDir = flagToMaybe $ setupWorkingDir common
+ distPref = setupDistPref common
+ dist_dir <- findDistPrefOrDefault distPref
+ getHookedBuildInfo verbosity mbWorkDir (dist_dir </> makeRelativePathEx "build")
readHook
- :: (a -> Flag Verbosity)
- -> (a -> Flag FilePath)
+ :: (flags -> CommonSetupFlags)
-> Args
- -> a
+ -> flags
-> IO HookedBuildInfo
- readHook get_verbosity get_dist_pref a flags = do
- noExtraFlags a
- dist_dir <- findDistPrefOrDefault (get_dist_pref flags)
- getHookedBuildInfo verbosity (dist_dir </> "build")
- where
- verbosity = fromFlag (get_verbosity flags)
-
-getHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo
-getHookedBuildInfo verbosity build_dir = do
- maybe_infoFile <- findHookedPackageDesc verbosity build_dir
+ readHook get_common_flags args flags = do
+ let common = get_common_flags flags
+ verbosity = fromFlag (setupVerbosity common)
+ mbWorkDir = flagToMaybe $ setupWorkingDir common
+ distPref = setupDistPref common
+ noExtraFlags args
+ dist_dir <- findDistPrefOrDefault distPref
+ getHookedBuildInfo verbosity mbWorkDir (dist_dir </> makeRelativePathEx "build")
+
+getHookedBuildInfo
+ :: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg (Dir Build)
+ -> IO HookedBuildInfo
+getHookedBuildInfo verbosity mbWorkDir build_dir = do
+ maybe_infoFile <- findHookedPackageDesc verbosity mbWorkDir build_dir
case maybe_infoFile of
Nothing -> return emptyHookedBuildInfo
Just infoFile -> do
- info verbosity $ "Reading parameters from " ++ infoFile
- readHookedBuildInfo verbosity infoFile
+ info verbosity $ "Reading parameters from " ++ getSymbolicPath infoFile
+ readHookedBuildInfo verbosity mbWorkDir infoFile
defaultTestHook
:: Args
@@ -856,17 +906,14 @@ defaultInstallHook
defaultInstallHook pkg_descr localbuildinfo _ flags = do
let copyFlags =
defaultCopyFlags
- { copyDistPref = installDistPref flags
- , copyDest = installDest flags
- , copyVerbosity = installVerbosity flags
+ { copyDest = installDest flags
+ , copyCommonFlags = installCommonFlags flags
}
install pkg_descr localbuildinfo copyFlags
let registerFlags =
defaultRegisterFlags
- { regDistPref = installDistPref flags
- , regInPlace = installInPlace flags
+ { regInPlace = installInPlace flags
, regPackageDB = installPackageDB flags
- , regVerbosity = installVerbosity flags
}
when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags
@@ -900,6 +947,6 @@ defaultRegHook pkg_descr localbuildinfo _ flags =
then register pkg_descr localbuildinfo flags
else
setupMessage
- (fromFlag (regVerbosity flags))
+ (fromFlag (setupVerbosity $ registerCommonFlags flags))
"Package contains no library to register:"
(packageId pkg_descr)
diff --git a/Cabal/src/Distribution/Simple/Bench.hs b/Cabal/src/Distribution/Simple/Bench.hs
index 86b6e06bfa..da4788adce 100644
--- a/Cabal/src/Distribution/Simple/Bench.hs
+++ b/Cabal/src/Distribution/Simple/Bench.hs
@@ -25,18 +25,18 @@ import qualified Distribution.PackageDescription as PD
import Distribution.Pretty
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
-import Distribution.Simple.Flag (fromFlag)
import Distribution.Simple.InstallDirs
import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.Setup.Benchmark
+import Distribution.Simple.Setup.Common
import Distribution.Simple.UserHooks
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Types.UnqualComponentName
import Distribution.Simple.Errors
import System.Directory (doesFileExist)
-import System.FilePath ((<.>), (</>))
-- | Perform the \"@.\/setup bench@\" action.
bench
@@ -54,13 +54,15 @@ bench args pkg_descr lbi flags = do
benchmarkNames = args
pkgBenchmarks = PD.benchmarks pkg_descr
enabledBenchmarks = map fst (LBI.enabledBenchLBIs pkg_descr lbi)
+ mbWorkDir = flagToMaybe $ benchmarkWorkingDir flags
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
-- Run the benchmark
doBench :: PD.Benchmark -> IO ExitCode
doBench bm =
case PD.benchmarkInterface bm of
PD.BenchmarkExeV10 _ _ -> do
- let cmd = LBI.buildDir lbi </> name </> name <.> exeExtension (LBI.hostPlatform lbi)
+ let cmd = i $ LBI.buildDir lbi </> makeRelativePathEx (name </> name <.> exeExtension (LBI.hostPlatform lbi))
options =
map (benchOption pkg_descr lbi bm) $
benchmarkOptions flags
@@ -73,7 +75,7 @@ bench args pkg_descr lbi flags = do
notice verbosity $ startMessage name
-- This will redirect the child process
-- stdout/stderr to the parent process.
- exitcode <- rawSystemExitCode verbosity cmd options
+ exitcode <- rawSystemExitCode verbosity mbWorkDir cmd options
notice verbosity $ finishMessage name exitcode
return exitcode
_ -> do
diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
index bc6ac7ae6b..e4e40b5fb5 100644
--- a/Cabal/src/Distribution/Simple/Build.hs
+++ b/Cabal/src/Distribution/Simple/Build.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
@@ -90,6 +91,7 @@ import qualified Distribution.Simple.Program.GHC as GHC
import Distribution.Simple.Program.Types
import Distribution.Simple.Register
import Distribution.Simple.Setup.Build
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Repl
import Distribution.Simple.ShowBuildInfo
@@ -109,8 +111,8 @@ import Control.Monad
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
import Distribution.Simple.Errors
-import System.Directory (doesFileExist, getCurrentDirectory, removeFile)
-import System.FilePath (takeDirectory, (<.>), (</>))
+import System.Directory (doesFileExist, removeFile)
+import System.FilePath (takeDirectory)
-- -----------------------------------------------------------------------------
@@ -126,8 +128,10 @@ build
-- ^ preprocessors to run before compiling
-> IO ()
build pkg_descr lbi flags suffixes = do
+ let distPref = fromFlag $ buildDistPref flags
+ verbosity = fromFlag $ buildVerbosity flags
checkSemaphoreSupport verbosity (compiler lbi) flags
- targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags)
+ targets <- readTargetInfos verbosity pkg_descr lbi (buildTargets flags)
let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)
info verbosity $
"Component build order: "
@@ -147,7 +151,8 @@ build pkg_descr lbi flags suffixes = do
-- Before the actual building, dump out build-information.
-- This way, if the actual compilation failed, the options have still been
-- dumped.
- dumpBuildInfo verbosity distPref (configDumpBuildInfo (configFlags lbi)) pkg_descr lbi flags
+ dumpBuildInfo verbosity distPref (configDumpBuildInfo (configFlags $ lbi)) pkg_descr lbi $
+ flags
-- Now do the actual building
(\f -> foldM_ f (installedPkgs lbi) componentsToBuild) $ \index target -> do
@@ -162,14 +167,15 @@ build pkg_descr lbi flags suffixes = do
, withPackageDB = withPackageDB lbi ++ [internalPackageDB]
, installedPkgs = index
}
+ let numJobs = buildNumJobs flags
par_strat <-
toFlag <$> case buildUseSemaphore flags of
- Flag sem_name -> case buildNumJobs flags of
+ Flag sem_name -> case numJobs of
Flag{} -> do
warn verbosity $ "Ignoring -j due to --semaphore"
return $ UseSem sem_name
NoFlag -> return $ UseSem sem_name
- NoFlag -> return $ case buildNumJobs flags of
+ NoFlag -> return $ case numJobs of
Flag n -> NumJobs n
NoFlag -> Serial
mb_ipi <-
@@ -185,9 +191,6 @@ build pkg_descr lbi flags suffixes = do
return (maybe index (Index.insert `flip` index) mb_ipi)
return ()
- where
- distPref = fromFlag (buildDistPref flags)
- verbosity = fromFlag (buildVerbosity flags)
-- | Check for conditions that would prevent the build from succeeding.
checkSemaphoreSupport
@@ -204,7 +207,7 @@ checkSemaphoreSupport verbosity comp flags = do
-- lib:Cabal made sure that dependencies are up-to-date.
dumpBuildInfo
:: Verbosity
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-- ^ To which directory should the build-info be dumped?
-> Flag DumpBuildInfo
-- ^ Should we dump detailed build information for this component?
@@ -216,6 +219,7 @@ dumpBuildInfo
-- ^ Flags that the user passed to build
-> IO ()
dumpBuildInfo verbosity distPref dumpBuildInfoFlag pkg_descr lbi flags = do
+ let mbWorkDir = flagToMaybe $ buildWorkingDir flags
when shouldDumpBuildInfo $ do
-- Changing this line might break consumers of the dumped build info.
-- Announce changes on mailing lists!
@@ -228,26 +232,28 @@ dumpBuildInfo verbosity distPref dumpBuildInfoFlag pkg_descr lbi flags = do
(showComponentName . componentLocalName . targetCLBI)
activeTargets
)
- pwd <- getCurrentDirectory
+
+ wdir <- absoluteWorkingDir mbWorkDir
(compilerProg, _) <- case flavorToProgram (compilerFlavor (compiler lbi)) of
Nothing ->
dieWithException verbosity $ UnknownCompilerFlavor (compilerFlavor (compiler lbi))
Just program -> requireProgram verbosity program (withPrograms lbi)
- let (warns, json) = mkBuildInfo pwd pkg_descr lbi flags (compilerProg, compiler lbi) activeTargets
+ let (warns, json) = mkBuildInfo wdir pkg_descr lbi flags (compilerProg, compiler lbi) activeTargets
buildInfoText = renderJson json
unless (null warns) $
warn verbosity $
"Encountered warnings while dumping build-info:\n"
++ unlines warns
- LBS.writeFile (buildInfoPref distPref) buildInfoText
+ LBS.writeFile buildInfoFile buildInfoText
when (not shouldDumpBuildInfo) $ do
-- Remove existing build-info.json as it might be outdated now.
- exists <- doesFileExist (buildInfoPref distPref)
- when exists $ removeFile (buildInfoPref distPref)
+ exists <- doesFileExist buildInfoFile
+ when exists $ removeFile buildInfoFile
where
+ buildInfoFile = interpretSymbolicPathLBI lbi $ buildInfoPref distPref
shouldDumpBuildInfo = fromFlagOrDefault NoDumpBuildInfo dumpBuildInfoFlag == DumpBuildInfo
-- \| Given the flavor of the compiler, try to find out
@@ -272,8 +278,8 @@ repl
-> [String]
-> IO ()
repl pkg_descr lbi flags suffixes args = do
- let distPref = fromFlag (replDistPref flags)
- verbosity = fromFlag (replVerbosity flags)
+ let distPref = fromFlag $ replDistPref flags
+ verbosity = fromFlag $ replVerbosity flags
target <-
readTargetInfos verbosity pkg_descr lbi args >>= \r -> case r of
@@ -314,7 +320,7 @@ repl pkg_descr lbi flags suffixes args = do
lbi' = lbiForComponent comp lbi
preBuildComponent verbosity lbi subtarget
buildComponent
- mempty{buildVerbosity = toFlag verbosity}
+ mempty{buildCommonFlags = mempty{setupVerbosity = toFlag verbosity}}
NoFlag
pkg_descr
lbi'
@@ -354,12 +360,14 @@ buildComponent
-> [PPSuffixHandler]
-> Component
-> ComponentLocalBuildInfo
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-> IO (Maybe InstalledPackageInfo)
buildComponent flags _ _ _ _ (CTest TestSuite{testInterface = TestSuiteUnsupported tt}) _ _ =
- dieWithException (fromFlag $ buildVerbosity flags) $ NoSupportBuildingTestSuite tt
+ dieWithException (fromFlag $ buildVerbosity flags) $
+ NoSupportBuildingTestSuite tt
buildComponent flags _ _ _ _ (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt}) _ _ =
- dieWithException (fromFlag $ buildVerbosity flags) $ NoSupportBuildingBenchMark tt
+ dieWithException (fromFlag $ buildVerbosity flags) $
+ NoSupportBuildingBenchMark tt
buildComponent
flags
numJobs
@@ -376,10 +384,10 @@ buildComponent
-- built.
distPref =
do
+ inplaceDir <- absoluteWorkingDirLBI lbi0
let verbosity = fromFlag $ buildVerbosity flags
- pwd <- getCurrentDirectory
let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) =
- testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
+ testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 inplaceDir distPref
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras verbosity comp lbi -- TODO find cpphs processed files
(genDir, generatedExtras) <- generateCode (testCodeGenerators test) (testName test) pkg_descr (testBuildInfo test) lbi clbi verbosity
@@ -399,6 +407,7 @@ buildComponent
verbosity
(compiler lbi)
(withPrograms lbi)
+ (mbWorkDirLBI lbi)
(withPackageDB lbi)
ipi
HcPkg.defaultRegisterOptions
@@ -455,12 +464,12 @@ buildComponent
then do
-- Register the library in-place, so exes can depend
-- on internally defined libraries.
- pwd <- getCurrentDirectory
+ inplaceDir <- absoluteWorkingDirLBI lbi
let
-- The in place registration uses the "-inplace" suffix, not an ABI hash
installedPkgInfo =
inplaceInstalledPackageInfo
- pwd
+ inplaceDir
distPref
pkg_descr
-- NB: Use a fake ABI hash to avoid
@@ -474,6 +483,7 @@ buildComponent
verbosity
(compiler lbi)
(withPrograms lbi)
+ (flagToMaybe $ buildWorkingDir flags)
(withPackageDB lbi)
installedPkgInfo
HcPkg.defaultRegisterOptions
@@ -515,24 +525,27 @@ generateCode
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Verbosity
- -> IO (FilePath, [ModuleName.ModuleName])
+ -> IO (SymbolicPath Pkg (Dir Source), [ModuleName.ModuleName])
generateCode codeGens nm pdesc bi lbi clbi verbosity = do
- when (not . null $ codeGens) $ createDirectoryIfMissingVerbose verbosity True tgtDir
+ when (not . null $ codeGens) $ createDirectoryIfMissingVerbose verbosity True $ i tgtDir
(\x -> (tgtDir, x)) . concat <$> mapM go codeGens
where
allLibs = (maybe id (:) $ library pdesc) (subLibraries pdesc)
dependencyLibs = filter (const True) allLibs -- intersect with componentPackageDeps of clbi
srcDirs = concatMap (hsSourceDirs . libBuildInfo) dependencyLibs
nm' = unUnqualComponentName nm
- tgtDir = buildDir lbi </> nm' </> nm' ++ "-gen"
+ mbWorkDir = mbWorkDirLBI lbi
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
+ tgtDir = buildDir lbi </> makeRelativePathEx (nm' </> nm' ++ "-gen")
go :: String -> IO [ModuleName.ModuleName]
go codeGenProg =
fmap fromString . lines
- <$> getDbProgramOutput
+ <$> getDbProgramOutputCwd
verbosity
+ mbWorkDir
(simpleProgram codeGenProg)
(withPrograms lbi)
- ( (tgtDir : map getSymbolicPath srcDirs)
+ ( map interpretSymbolicPathCWD (tgtDir : srcDirs)
++ ( "--"
: GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) (GHC.componentGhcOptions verbosity lbi bi clbi tgtDir)
)
@@ -540,35 +553,35 @@ generateCode codeGens nm pdesc bi lbi clbi verbosity = do
-- | Add extra C sources generated by preprocessing to build
-- information.
-addExtraCSources :: BuildInfo -> [FilePath] -> BuildInfo
+addExtraCSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCSources bi extras = bi{cSources = new}
where
new = ordNub (extras ++ cSources bi)
-- | Add extra C++ sources generated by preprocessing to build
-- information.
-addExtraCxxSources :: BuildInfo -> [FilePath] -> BuildInfo
+addExtraCxxSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCxxSources bi extras = bi{cxxSources = new}
where
new = ordNub (extras ++ cxxSources bi)
-- | Add extra C-- sources generated by preprocessing to build
-- information.
-addExtraCmmSources :: BuildInfo -> [FilePath] -> BuildInfo
+addExtraCmmSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCmmSources bi extras = bi{cmmSources = new}
where
new = ordNub (extras ++ cmmSources bi)
-- | Add extra ASM sources generated by preprocessing to build
-- information.
-addExtraAsmSources :: BuildInfo -> [FilePath] -> BuildInfo
+addExtraAsmSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraAsmSources bi extras = bi{asmSources = new}
where
new = ordNub (extras ++ asmSources bi)
-- | Add extra JS sources generated by preprocessing to build
-- information.
-addExtraJsSources :: BuildInfo -> [FilePath] -> BuildInfo
+addExtraJsSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraJsSources bi extras = bi{jsSources = new}
where
new = ordNub (extras ++ jsSources bi)
@@ -581,10 +594,10 @@ addExtraOtherModules bi extras = bi{otherModules = new}
new = ordNub (extras ++ otherModules bi)
-- | Add extra source dir for generated modules.
-addSrcDir :: BuildInfo -> FilePath -> BuildInfo
+addSrcDir :: BuildInfo -> SymbolicPath Pkg (Dir Source) -> BuildInfo
addSrcDir bi extra = bi{hsSourceDirs = new}
where
- new = ordNub (unsafeMakeSymbolicPath extra : hsSourceDirs bi)
+ new = ordNub (extra : hsSourceDirs bi)
replComponent
:: ReplFlags
@@ -594,7 +607,7 @@ replComponent
-> [PPSuffixHandler]
-> Component
-> ComponentLocalBuildInfo
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-> IO ()
replComponent _ verbosity _ _ _ (CTest TestSuite{testInterface = TestSuiteUnsupported tt}) _ _ =
dieWithException verbosity $ NoSupportBuildingTestSuite tt
@@ -611,9 +624,9 @@ replComponent
)
clbi
distPref = do
- pwd <- getCurrentDirectory
+ inplaceDir <- absoluteWorkingDirLBI lbi0
let (pkg, lib, libClbi, lbi, _, _, _) =
- testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
+ testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 inplaceDir distPref
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras verbosity comp lbi
let libbi = libBuildInfo lib
@@ -690,7 +703,8 @@ testSuiteLibV09AsLibAndExe
-> ComponentLocalBuildInfo
-> LocalBuildInfo
-> FilePath
- -> FilePath
+ -- ^ absolute inplace dir
+ -> SymbolicPath Pkg (Dir Dist)
-> ( PackageDescription
, Library
, ComponentLocalBuildInfo
@@ -704,8 +718,8 @@ testSuiteLibV09AsLibAndExe
test@TestSuite{testInterface = TestSuiteLibV09 _ m}
clbi
lbi
- distPref
- pwd =
+ inplaceDir
+ distPref =
(pkg, lib, libClbi, lbi, ipi, exe, exeClbi)
where
bi = testBuildInfo test
@@ -749,12 +763,7 @@ testSuiteLibV09AsLibAndExe
, testSuites = []
, subLibraries = [lib]
}
- ipi = inplaceInstalledPackageInfo pwd distPref pkg (mkAbiHash "") lib lbi libClbi
- testDir =
- buildDir lbi
- </> stubName test
- </> stubName test
- ++ "-tmp"
+ ipi = inplaceInstalledPackageInfo inplaceDir distPref pkg (mkAbiHash "") lib lbi libClbi
testLibDep =
Dependency
pkgName'
@@ -763,11 +772,11 @@ testSuiteLibV09AsLibAndExe
exe =
Executable
{ exeName = mkUnqualComponentName $ stubName test
- , modulePath = stubFilePath test
+ , modulePath = makeRelativePathEx $ stubFilePath test
, exeScope = ExecutablePublic
, buildInfo =
(testBuildInfo test)
- { hsSourceDirs = [unsafeMakeSymbolicPath testDir]
+ { hsSourceDirs = [coerceSymbolicPath $ testBuildDir lbi test]
, targetBuildDepends =
testLibDep
: targetBuildDepends (testBuildInfo test)
@@ -807,7 +816,7 @@ testSuiteLibV09AsLibAndExe _ TestSuite{} _ _ _ _ = error "testSuiteLibV09AsLibAn
createInternalPackageDB
:: Verbosity
-> LocalBuildInfo
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-> IO PackageDB
createInternalPackageDB verbosity lbi distPref = do
existsAlready <- doesPackageDBExist dbPath
@@ -815,7 +824,8 @@ createInternalPackageDB verbosity lbi distPref = do
createPackageDB verbosity (compiler lbi) (withPrograms lbi) False dbPath
return (SpecificPackageDB dbPath)
where
- dbPath = internalPackageDBPath lbi distPref
+ dbRelPath = internalPackageDBPath lbi distPref
+ dbPath = interpretSymbolicPathLBI lbi dbRelPath
addInternalBuildTools
:: PackageDescription
@@ -830,7 +840,10 @@ addInternalBuildTools pkg lbi bi progs =
[ simpleConfiguredProgram toolName' (FoundOnSystem toolLocation)
| toolName <- getAllInternalToolDependencies pkg bi
, let toolName' = unUnqualComponentName toolName
- , let toolLocation = buildDir lbi </> toolName' </> toolName' <.> exeExtension (hostPlatform lbi)
+ , let toolLocation =
+ interpretSymbolicPathLBI lbi $
+ buildDir lbi
+ </> makeRelativePathEx (toolName' </> toolName' <.> exeExtension (hostPlatform lbi))
]
-- TODO: build separate libs in separate dirs so that we can build
@@ -912,7 +925,15 @@ replExe flags pkg_descr lbi exe clbi =
let verbosity = fromFlag $ replVerbosity flags
in case compilerFlavor (compiler lbi) of
GHC -> GHC.replExe flags NoFlag pkg_descr lbi exe clbi
- GHCJS -> GHCJS.replExe (replOptionsFlags $ replReplOptions flags) verbosity NoFlag pkg_descr lbi exe clbi
+ GHCJS ->
+ GHCJS.replExe
+ (replOptionsFlags $ replReplOptions flags)
+ verbosity
+ NoFlag
+ pkg_descr
+ lbi
+ exe
+ clbi
_ -> dieWithException verbosity REPLNotSupported
replFLib
@@ -939,7 +960,7 @@ preBuildComponent
preBuildComponent verbosity lbi tgt = do
let pkg_descr = localPkgDescr lbi
clbi = targetCLBI tgt
- createDirectoryIfMissingVerbose verbosity True (componentBuildDir lbi clbi)
+ createDirectoryIfMissingVerbose verbosity True (interpretSymbolicPathLBI lbi $ componentBuildDir lbi clbi)
writeBuiltinAutogenFiles verbosity pkg_descr lbi clbi
-- | Generate and write to disk all built-in autogenerated files
@@ -1046,4 +1067,4 @@ writeAutogenFiles verbosity lbi clbi autogenFiles = do
-- Write the contents of the file.
rewriteFileLBS verbosity path contents
where
- autogenDir = autogenComponentModulesDir lbi clbi
+ autogenDir = interpretSymbolicPathLBI lbi $ autogenComponentModulesDir lbi clbi
diff --git a/Cabal/src/Distribution/Simple/Build/Inputs.hs b/Cabal/src/Distribution/Simple/Build/Inputs.hs
index 48b3b60a12..bb984bfb8a 100644
--- a/Cabal/src/Distribution/Simple/Build/Inputs.hs
+++ b/Cabal/src/Distribution/Simple/Build/Inputs.hs
@@ -18,13 +18,17 @@ module Distribution.Simple.Build.Inputs
, BuildingWhat (..)
, LocalBuildInfo (..)
, TargetInfo (..)
+ , buildingWhatCommonFlags
, buildingWhatVerbosity
+ , buildingWhatWorkingDir
, buildingWhatDistPref
)
where
import Distribution.Simple.Compiler
-import Distribution.Simple.Setup (BuildingWhat (..), buildingWhatDistPref, buildingWhatVerbosity)
+import Distribution.Simple.Setup hiding
+ ( BuildFlags (buildVerbosity)
+ )
import Distribution.Types.BuildInfo
import Distribution.Types.Component
import Distribution.Types.ComponentLocalBuildInfo
diff --git a/Cabal/src/Distribution/Simple/BuildPaths.hs b/Cabal/src/Distribution/Simple/BuildPaths.hs
index b4adc37d3e..4c44bd380f 100644
--- a/Cabal/src/Distribution/Simple/BuildPaths.hs
+++ b/Cabal/src/Distribution/Simple/BuildPaths.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -45,6 +46,9 @@ module Distribution.Simple.BuildPaths
, getFLibSourceFiles
, exeBuildDir
, flibBuildDir
+ , stubName
+ , testBuildDir
+ , benchmarkBuildDir
) where
import Distribution.Compat.Prelude
@@ -59,13 +63,12 @@ import Distribution.Pretty
import Distribution.Simple.Errors
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess.Types (builtinHaskellSuffixes)
-import Distribution.Simple.Setup.Common (defaultDistPref)
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Haddock (HaddockTarget (..))
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Utils.Path
import Distribution.Verbosity
-import System.FilePath (normalise, (<.>), (</>))
-- ---------------------------------------------------------------------------
-- Build directories and files
@@ -73,12 +76,18 @@ import System.FilePath (normalise, (<.>), (</>))
srcPref :: FilePath -> FilePath
srcPref distPref = distPref </> "src"
-hscolourPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
+hscolourPref
+ :: HaddockTarget
+ -> SymbolicPath root (Dir Dist)
+ -> PackageDescription
+ -> SymbolicPath root (Dir Artifacts)
hscolourPref = haddockPref
-- | Build info json file, generated in every build
-buildInfoPref :: FilePath -> FilePath
-buildInfoPref distPref = distPref </> "build-info.json"
+buildInfoPref
+ :: SymbolicPath root (Dir Dist)
+ -> SymbolicPath root File
+buildInfoPref distPref = distPref </> makeRelativePathEx "build-info.json"
-- | This is the name of the directory in which the generated haddocks
-- should be stored. It does not include the @<dist>/doc/html@ prefix.
@@ -87,19 +96,23 @@ haddockDirName ForDevelopment = prettyShow . packageName
haddockDirName ForHackage = (++ "-docs") . prettyShow . packageId
-- | The directory to which generated haddock documentation should be written.
-haddockPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
+haddockPref
+ :: HaddockTarget
+ -> SymbolicPath root (Dir Dist)
+ -> PackageDescription
+ -> SymbolicPath root (Dir Artifacts)
haddockPref haddockTarget distPref pkg_descr =
- distPref </> "doc" </> "html" </> haddockDirName haddockTarget pkg_descr
+ distPref </> makeRelativePathEx ("doc" </> "html" </> haddockDirName haddockTarget pkg_descr)
-- | The directory in which we put auto-generated modules for EVERY
-- component in the package.
-autogenPackageModulesDir :: LocalBuildInfo -> String
-autogenPackageModulesDir lbi = buildDir lbi </> "global-autogen"
+autogenPackageModulesDir :: LocalBuildInfo -> SymbolicPath Pkg (Dir Source)
+autogenPackageModulesDir lbi = buildDir lbi </> makeRelativePathEx "global-autogen"
-- | The directory in which we put auto-generated modules for a
-- particular component.
-autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
-autogenComponentModulesDir lbi clbi = componentBuildDir lbi clbi </> "autogen"
+autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir Source)
+autogenComponentModulesDir lbi clbi = componentBuildDir lbi clbi </> makeRelativePathEx "autogen"
-- NB: Look at 'checkForeignDeps' for where a simplified version of this
-- has been copy-pasted.
@@ -136,14 +149,16 @@ getLibSourceFiles
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
- -> IO [(ModuleName.ModuleName, FilePath)]
-getLibSourceFiles verbosity lbi lib clbi = getSourceFiles verbosity searchpaths modules
+ -> IO [(ModuleName.ModuleName, SymbolicPath Pkg File)]
+getLibSourceFiles verbosity lbi lib clbi =
+ getSourceFiles verbosity mbWorkDir searchpaths modules
where
bi = libBuildInfo lib
modules = allLibModules lib clbi
+ mbWorkDir = mbWorkDirLBI lbi
searchpaths =
- componentBuildDir lbi clbi
- : map getSymbolicPath (hsSourceDirs bi)
+ coerceSymbolicPath (componentBuildDir lbi clbi)
+ : hsSourceDirs bi
++ [ autogenComponentModulesDir lbi clbi
, autogenPackageModulesDir lbi
]
@@ -153,61 +168,91 @@ getExeSourceFiles
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
- -> IO [(ModuleName.ModuleName, FilePath)]
+ -> IO [(ModuleName.ModuleName, SymbolicPath Pkg 'File)]
getExeSourceFiles verbosity lbi exe clbi = do
- moduleFiles <- getSourceFiles verbosity searchpaths modules
- srcMainPath <- findFileEx verbosity (map getSymbolicPath $ hsSourceDirs bi) (modulePath exe)
+ moduleFiles <- getSourceFiles verbosity mbWorkDir searchpaths modules
+ srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs bi) (modulePath exe)
return ((ModuleName.main, srcMainPath) : moduleFiles)
where
+ mbWorkDir = mbWorkDirLBI lbi
bi = buildInfo exe
modules = otherModules bi
searchpaths =
autogenComponentModulesDir lbi clbi
: autogenPackageModulesDir lbi
- : exeBuildDir lbi exe
- : map getSymbolicPath (hsSourceDirs bi)
+ : coerceSymbolicPath (exeBuildDir lbi exe)
+ : hsSourceDirs bi
getFLibSourceFiles
:: Verbosity
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
- -> IO [(ModuleName.ModuleName, FilePath)]
-getFLibSourceFiles verbosity lbi flib clbi = getSourceFiles verbosity searchpaths modules
+ -> IO [(ModuleName.ModuleName, SymbolicPath Pkg File)]
+getFLibSourceFiles verbosity lbi flib clbi =
+ getSourceFiles verbosity mbWorkDir searchpaths modules
where
bi = foreignLibBuildInfo flib
modules = otherModules bi
+ mbWorkDir = mbWorkDirLBI lbi
searchpaths =
autogenComponentModulesDir lbi clbi
: autogenPackageModulesDir lbi
- : flibBuildDir lbi flib
- : map getSymbolicPath (hsSourceDirs bi)
+ : coerceSymbolicPath (flibBuildDir lbi flib)
+ : hsSourceDirs bi
getSourceFiles
:: Verbosity
- -> [FilePath]
+ -> Maybe (SymbolicPath CWD ('Dir Pkg))
+ -> [SymbolicPathX allowAbsolute Pkg (Dir Source)]
-> [ModuleName.ModuleName]
- -> IO [(ModuleName.ModuleName, FilePath)]
-getSourceFiles verbosity dirs modules = flip traverse modules $ \m ->
+ -> IO [(ModuleName.ModuleName, SymbolicPathX allowAbsolute Pkg File)]
+getSourceFiles verbosity mbWorkDir dirs modules = flip traverse modules $ \m ->
fmap ((,) m) $
- findFileWithExtension builtinHaskellSuffixes dirs (ModuleName.toFilePath m)
- >>= maybe (notFound m) (return . normalise)
+ findFileCwdWithExtension
+ mbWorkDir
+ builtinHaskellSuffixes
+ dirs
+ (moduleNameSymbolicPath m)
+ >>= maybe (notFound m) (return . normaliseSymbolicPath)
where
notFound module_ =
dieWithException verbosity $ CantFindSourceModule module_
-- | The directory where we put build results for an executable
-exeBuildDir :: LocalBuildInfo -> Executable -> FilePath
-exeBuildDir lbi exe = buildDir lbi </> nm </> nm ++ "-tmp"
+exeBuildDir :: LocalBuildInfo -> Executable -> SymbolicPath Pkg (Dir Build)
+exeBuildDir lbi exe = buildDir lbi </> makeRelativePathEx (nm </> nm ++ "-tmp")
where
nm = unUnqualComponentName $ exeName exe
-- | The directory where we put build results for a foreign library
-flibBuildDir :: LocalBuildInfo -> ForeignLib -> FilePath
-flibBuildDir lbi flib = buildDir lbi </> nm </> nm ++ "-tmp"
+flibBuildDir :: LocalBuildInfo -> ForeignLib -> SymbolicPath Pkg (Dir Build)
+flibBuildDir lbi flib = buildDir lbi </> makeRelativePathEx (nm </> nm ++ "-tmp")
where
nm = unUnqualComponentName $ foreignLibName flib
+-- | The name of the stub executable associated with a library 'TestSuite'.
+stubName :: TestSuite -> FilePath
+stubName t = unUnqualComponentName (testName t) ++ "Stub"
+
+-- | The directory where we put build results for a test suite
+testBuildDir :: LocalBuildInfo -> TestSuite -> SymbolicPath Pkg (Dir Build)
+testBuildDir lbi tst =
+ buildDir lbi </> makeRelativePathEx testDir
+ where
+ testDir = case testInterface tst of
+ TestSuiteLibV09{} ->
+ stubName tst </> stubName tst ++ "-tmp"
+ _ -> nm </> nm ++ "-tmp"
+ nm = unUnqualComponentName $ testName tst
+
+-- | The directory where we put build results for a benchmark suite
+benchmarkBuildDir :: LocalBuildInfo -> Benchmark -> SymbolicPath Pkg (Dir Build)
+benchmarkBuildDir lbi bm =
+ buildDir lbi </> makeRelativePathEx (nm </> nm ++ "-tmp")
+ where
+ nm = unUnqualComponentName $ benchmarkName bm
+
-- ---------------------------------------------------------------------------
-- Library file names
diff --git a/Cabal/src/Distribution/Simple/BuildTarget.hs b/Cabal/src/Distribution/Simple/BuildTarget.hs
index 06b387c04a..cb5293b18b 100644
--- a/Cabal/src/Distribution/Simple/BuildTarget.hs
+++ b/Cabal/src/Distribution/Simple/BuildTarget.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -496,12 +497,12 @@ pkgComponentInfo pkg =
, cinfoStrName = componentStringName pkg (componentName c)
, cinfoSrcDirs = map getSymbolicPath $ hsSourceDirs bi
, cinfoModules = componentModules c
- , cinfoHsFiles = componentHsFiles c
- , cinfoAsmFiles = asmSources bi
- , cinfoCmmFiles = cmmSources bi
- , cinfoCFiles = cSources bi
- , cinfoCxxFiles = cxxSources bi
- , cinfoJsFiles = jsSources bi
+ , cinfoHsFiles = map getSymbolicPath $ componentHsFiles c
+ , cinfoAsmFiles = map getSymbolicPath $ asmSources bi
+ , cinfoCmmFiles = map getSymbolicPath $ cmmSources bi
+ , cinfoCFiles = map getSymbolicPath $ cSources bi
+ , cinfoCxxFiles = map getSymbolicPath $ cxxSources bi
+ , cinfoJsFiles = map getSymbolicPath $ jsSources bi
}
| c <- pkgComponents pkg
, let bi = componentBuildInfo c
@@ -529,7 +530,7 @@ componentModules (CExe exe) = exeModules exe
componentModules (CTest test) = testModules test
componentModules (CBench bench) = benchmarkModules bench
-componentHsFiles :: Component -> [FilePath]
+componentHsFiles :: Component -> [RelativePath Source File]
componentHsFiles (CExe exe) = [modulePath exe]
componentHsFiles
( CTest
diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs
index 2da6486cba..b403bb4c01 100644
--- a/Cabal/src/Distribution/Simple/Command.hs
+++ b/Cabal/src/Distribution/Simple/Command.hs
@@ -1,6 +1,8 @@
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
@@ -64,6 +66,7 @@ module Distribution.Simple.Command
-- * Option Descriptions
, OptDescr (..)
+ , fmapOptDescr
, Description
, SFlags
, LFlags
@@ -151,6 +154,16 @@ data OptDescr a
(Bool -> a -> a)
(a -> Maybe Bool)
+fmapOptDescr :: forall a b. (b -> a) -> (a -> (b -> b)) -> OptDescr a -> OptDescr b
+fmapOptDescr x u = \case
+ ReqArg d o p upd get -> ReqArg d o p (fmap m upd) (get . x)
+ OptArg d o p upd (str, g) get -> OptArg d o p (fmap m upd) (str, m g) (get . x)
+ ChoiceOpt opts -> ChoiceOpt $ fmap (\(d, o, upd, get) -> (d, o, m upd, get . x)) opts
+ BoolOpt d true false upd get -> BoolOpt d true false (\b -> m $ upd b) (get . x)
+ where
+ m :: (a -> a) -> (b -> b)
+ m upd_a b = u (upd_a $ x b) b
+
-- | Short command line option strings
type SFlags = [Char]
diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs
index 6aaa0931ee..ae8d1c0513 100644
--- a/Cabal/src/Distribution/Simple/Compiler.hs
+++ b/Cabal/src/Distribution/Simple/Compiler.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -82,11 +83,14 @@ import Prelude ()
import Distribution.Compiler
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Version
+
import Language.Haskell.Extension
import qualified Data.Map as Map (lookup)
import System.Directory (canonicalizePath)
+import System.FilePath (isRelative)
data Compiler = Compiler
{ compilerId :: CompilerId
@@ -175,7 +179,8 @@ compilerInfo c =
data PackageDB
= GlobalPackageDB
| UserPackageDB
- | SpecificPackageDB FilePath
+ | -- | NB: the path might be relative or it might be absolute
+ SpecificPackageDB FilePath
deriving (Eq, Generic, Ord, Show, Read, Typeable)
instance Binary PackageDB
@@ -206,14 +211,24 @@ registrationPackageDB dbs = case safeLast dbs of
Just p -> p
-- | Make package paths absolute
-absolutePackageDBPaths :: PackageDBStack -> IO PackageDBStack
-absolutePackageDBPaths = traverse absolutePackageDBPath
-
-absolutePackageDBPath :: PackageDB -> IO PackageDB
-absolutePackageDBPath GlobalPackageDB = return GlobalPackageDB
-absolutePackageDBPath UserPackageDB = return UserPackageDB
-absolutePackageDBPath (SpecificPackageDB db) =
- SpecificPackageDB `liftM` canonicalizePath db
+absolutePackageDBPaths
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> PackageDBStack
+ -> IO PackageDBStack
+absolutePackageDBPaths mbWorkDir = traverse $ absolutePackageDBPath mbWorkDir
+
+absolutePackageDBPath
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> PackageDB
+ -> IO PackageDB
+absolutePackageDBPath _ GlobalPackageDB = return GlobalPackageDB
+absolutePackageDBPath _ UserPackageDB = return UserPackageDB
+absolutePackageDBPath mbWorkDir (SpecificPackageDB db) = do
+ let db' =
+ if isRelative db
+ then interpretSymbolicPath mbWorkDir (makeRelativePathEx db)
+ else db
+ SpecificPackageDB <$> canonicalizePath db'
-- ------------------------------------------------------------
diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
index d6bffddf36..0a788af830 100644
--- a/Cabal/src/Distribution/Simple/Configure.hs
+++ b/Cabal/src/Distribution/Simple/Configure.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -131,6 +132,9 @@ import Distribution.Pretty
, pretty
, prettyShow
)
+import Distribution.Simple.Errors
+import Distribution.Types.AnnotatedId
+import Distribution.Utils.Path
import Distribution.Utils.Structured (structuredDecodeOrFailIO, structuredEncode)
import System.Directory
( canonicalizePath
@@ -141,8 +145,6 @@ import System.Directory
)
import System.FilePath
( isAbsolute
- , takeDirectory
- , (</>)
)
import System.IO
( hClose
@@ -165,8 +167,6 @@ import Text.PrettyPrint
import qualified Data.Maybe as M
import qualified Data.Set as Set
import qualified Distribution.Compat.NonEmptySet as NES
-import Distribution.Simple.Errors
-import Distribution.Types.AnnotatedId
type UseExternalInternalDeps = Bool
@@ -180,6 +180,9 @@ data ConfigStateFileError
ConfigStateFileNoParse
| -- | No file!
ConfigStateFileMissing
+ { cfgStateFileErrorCwd :: Maybe (SymbolicPath CWD (Dir Pkg))
+ , cfgStateFileErrorFile :: SymbolicPath Pkg File
+ }
| -- | Mismatched version.
ConfigStateFileBadVersion
PackageIdentifier
@@ -198,7 +201,7 @@ dispConfigStateFileError ConfigStateFileBadHeader =
dispConfigStateFileError ConfigStateFileNoParse =
text "Saved package config file is corrupt."
<+> text "Re-run the 'configure' command."
-dispConfigStateFileError ConfigStateFileMissing =
+dispConfigStateFileError ConfigStateFileMissing{} =
text "Run the 'configure' command first."
dispConfigStateFileError (ConfigStateFileBadVersion oldCabal oldCompiler _) =
text "Saved package config file is outdated:"
@@ -228,12 +231,14 @@ instance Exception ConfigStateFileError
-- missing, if the file cannot be read, or if the file was created by an older
-- version of Cabal.
getConfigStateFile
- :: FilePath
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg File
-- ^ The file path of the @setup-config@ file.
-> IO LocalBuildInfo
-getConfigStateFile filename = do
+getConfigStateFile mbWorkDir setupConfigFile = do
+ let filename = interpretSymbolicPath mbWorkDir setupConfigFile
exists <- doesFileExist filename
- unless exists $ throwIO ConfigStateFileMissing
+ unless exists $ throwIO $ ConfigStateFileMissing mbWorkDir setupConfigFile
-- Read the config file into a strict ByteString to avoid problems with
-- lazy I/O, then convert to lazy because the binary package needs that.
contents <- BS.readFile filename
@@ -258,48 +263,60 @@ getConfigStateFile filename = do
-- | Read the 'localBuildInfoFile', returning either an error or the local build
-- info.
tryGetConfigStateFile
- :: FilePath
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory.
+ -> SymbolicPath Pkg File
-- ^ The file path of the @setup-config@ file.
-> IO (Either ConfigStateFileError LocalBuildInfo)
-tryGetConfigStateFile = try . getConfigStateFile
+tryGetConfigStateFile mbWorkDir = try . getConfigStateFile mbWorkDir
-- | Try to read the 'localBuildInfoFile'.
tryGetPersistBuildConfig
- :: FilePath
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory.
+ -> SymbolicPath Pkg (Dir Dist)
-- ^ The @dist@ directory path.
-> IO (Either ConfigStateFileError LocalBuildInfo)
-tryGetPersistBuildConfig = try . getPersistBuildConfig
+tryGetPersistBuildConfig mbWorkDir = try . getPersistBuildConfig mbWorkDir
-- | Read the 'localBuildInfoFile'. Throw an exception if the file is
-- missing, if the file cannot be read, or if the file was created by an older
-- version of Cabal.
getPersistBuildConfig
- :: FilePath
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory.
+ -> SymbolicPath Pkg (Dir Dist)
-- ^ The @dist@ directory path.
-> IO LocalBuildInfo
-getPersistBuildConfig = getConfigStateFile . localBuildInfoFile
+getPersistBuildConfig mbWorkDir distPref =
+ getConfigStateFile mbWorkDir $ localBuildInfoFile distPref
-- | Try to read the 'localBuildInfoFile'.
maybeGetPersistBuildConfig
- :: FilePath
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory.
+ -> SymbolicPath Pkg (Dir Dist)
-- ^ The @dist@ directory path.
-> IO (Maybe LocalBuildInfo)
-maybeGetPersistBuildConfig =
- liftM (either (const Nothing) Just) . tryGetPersistBuildConfig
+maybeGetPersistBuildConfig mbWorkDir =
+ liftM (either (const Nothing) Just) . tryGetPersistBuildConfig mbWorkDir
-- | After running configure, output the 'LocalBuildInfo' to the
-- 'localBuildInfoFile'.
writePersistBuildConfig
- :: FilePath
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory
+ -> SymbolicPath Pkg (Dir Dist)
-- ^ The @dist@ directory path.
-> LocalBuildInfo
-- ^ The 'LocalBuildInfo' to write.
-> IO ()
-writePersistBuildConfig distPref lbi = do
- createDirectoryIfMissing False distPref
- writeFileAtomic (localBuildInfoFile distPref) $
+writePersistBuildConfig mbWorkDir distPref lbi = do
+ createDirectoryIfMissing False (i distPref)
+ writeFileAtomic (i $ localBuildInfoFile distPref) $
BLC8.unlines [showHeader pkgId, structuredEncode lbi]
where
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
pkgId = localPackage lbi
-- | Identifier of the current Cabal package.
@@ -359,16 +376,22 @@ showHeader pkgId =
-- | Check that localBuildInfoFile is up-to-date with respect to the
-- .cabal file.
-checkPersistBuildConfigOutdated :: FilePath -> FilePath -> IO Bool
-checkPersistBuildConfigOutdated distPref pkg_descr_file =
- pkg_descr_file `moreRecentFile` localBuildInfoFile distPref
+checkPersistBuildConfigOutdated
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg (Dir Dist)
+ -> SymbolicPath Pkg File
+ -> IO Bool
+checkPersistBuildConfigOutdated mbWorkDir distPref pkg_descr_file =
+ i pkg_descr_file `moreRecentFile` i (localBuildInfoFile distPref)
+ where
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
-- | Get the path of @dist\/setup-config@.
localBuildInfoFile
- :: FilePath
+ :: SymbolicPath Pkg (Dir Dist)
-- ^ The @dist@ directory path.
- -> FilePath
-localBuildInfoFile distPref = distPref </> "setup-config"
+ -> SymbolicPath Pkg File
+localBuildInfoFile distPref = distPref </> makeRelativePathEx "setup-config"
-- -----------------------------------------------------------------------------
@@ -380,18 +403,18 @@ localBuildInfoFile distPref = distPref </> "setup-config"
-- from (in order of highest to lowest preference) the override prefix, the
-- \"CABAL_BUILDDIR\" environment variable, or the default prefix.
findDistPref
- :: FilePath
+ :: SymbolicPath Pkg (Dir Dist)
-- ^ default \"dist\" prefix
- -> Setup.Flag FilePath
+ -> Setup.Flag (SymbolicPath Pkg (Dir Dist))
-- ^ override \"dist\" prefix
- -> IO FilePath
+ -> IO (SymbolicPath Pkg (Dir Dist))
findDistPref defDistPref overrideDistPref = do
envDistPref <- liftM parseEnvDistPref (lookupEnv "CABAL_BUILDDIR")
return $ fromFlagOrDefault defDistPref (mappend envDistPref overrideDistPref)
where
parseEnvDistPref env =
case env of
- Just distPref | not (null distPref) -> toFlag distPref
+ Just distPref | not (null distPref) -> toFlag $ makeSymbolicPath distPref
_ -> NoFlag
-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken
@@ -401,9 +424,9 @@ findDistPref defDistPref overrideDistPref = do
-- set. (The @*DistPref@ flags are always set to a definite value before
-- invoking 'UserHooks'.)
findDistPrefOrDefault
- :: Setup.Flag FilePath
+ :: Setup.Flag (SymbolicPath Pkg (Dir Dist))
-- ^ override \"dist\" prefix
- -> IO FilePath
+ -> IO (SymbolicPath Pkg (Dir Dist))
findDistPrefOrDefault = findDistPref defaultDistPref
-- | Perform the \"@.\/setup configure@\" action.
@@ -429,7 +452,7 @@ preConfigurePackage
-> GenericPackageDescription
-> IO (LBC.LocalBuildConfig, Compiler, Platform, ComponentRequestedSpec)
preConfigurePackage cfg g_pkg_descr = do
- let verbosity = fromFlag (configVerbosity cfg)
+ let verbosity = fromFlag $ configVerbosity cfg
-- Determine the component we are configuring, if a user specified
-- one on the command line. We use a fake, flattened version of
@@ -438,11 +461,12 @@ preConfigurePackage cfg g_pkg_descr = do
-- configure everything (the old behavior).
(mb_cname :: Maybe ComponentName) <- do
let flat_pkg_descr = flattenPackageDescription g_pkg_descr
- targets <- readBuildTargets verbosity flat_pkg_descr (configArgs cfg)
+ targets0 = configTargets cfg
+ targets <- readBuildTargets verbosity flat_pkg_descr targets0
-- TODO: bleat if you use the module/file syntax
let targets' = [cname | BuildTargetComponent cname <- targets]
case targets' of
- _ | null (configArgs cfg) -> return Nothing
+ _ | null targets0 -> return Nothing
[cname] -> return (Just cname)
[] -> dieWithException verbosity NoValidComponent
_ -> dieWithException verbosity ConfigureEitherSingleOrAll
@@ -505,12 +529,14 @@ preConfigurePackage cfg g_pkg_descr = do
(lessVerbose verbosity)
-- Where to build the package
- let build_dir :: FilePath -- e.g. dist/build
- build_dir = configFlagsBuildDir cfg
+ let builddir :: SymbolicPath Pkg (Dir Build) -- e.g. dist/build
+ builddir = setupFlagsBuildDir $ configCommonFlags cfg
+ mbWorkDir = flagToMaybe $ configWorkingDir cfg
-- NB: create this directory now so that all configure hooks get
-- to see it. (In practice, the Configure build-type needs it before
-- the postConfPackageHook runs.)
- createDirectoryIfMissingVerbose (lessVerbose verbosity) True build_dir
+ createDirectoryIfMissingVerbose (lessVerbose verbosity) True $
+ interpretSymbolicPath mbWorkDir builddir
lbc <- computeLocalBuildConfig cfg comp programDb00
return (lbc, comp, compPlatform, enabled)
@@ -521,7 +547,8 @@ computeLocalBuildConfig
-> ProgramDb
-> IO LBC.LocalBuildConfig
computeLocalBuildConfig cfg comp programDb = do
- let verbosity = fromFlag (configVerbosity cfg)
+ let common = configCommonFlags cfg
+ verbosity = fromFlag $ setupVerbosity common
-- Decide if we're going to compile with split sections.
split_sections :: Bool <-
if not (fromFlag $ configSplitSections cfg)
@@ -713,7 +740,8 @@ configurePackage
-> PackageDBStack
-> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr)
configurePackage cfg lbc0 pkg_descr00 flags enabled comp platform programDb0 packageDbs = do
- let verbosity = fromFlag (configVerbosity cfg)
+ let common = configCommonFlags cfg
+ verbosity = fromFlag $ setupVerbosity common
-- add extra include/lib dirs as specified in cfg
pkg_descr0 = addExtraIncludeLibDirsFromConfigFlags pkg_descr00 cfg
@@ -807,7 +835,9 @@ finalizeAndConfigurePackage
-> ComponentRequestedSpec
-> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr, PackageInfo)
finalizeAndConfigurePackage cfg lbc0 g_pkg_descr comp platform enabled = do
- let verbosity = fromFlag (configVerbosity cfg)
+ let common = configCommonFlags cfg
+ verbosity = fromFlag $ setupVerbosity common
+ mbWorkDir = flagToMaybe $ setupWorkingDir common
let programDb0 = LBC.withPrograms lbc0
-- What package database(s) to use
@@ -822,6 +852,7 @@ finalizeAndConfigurePackage cfg lbc0 g_pkg_descr comp platform enabled = do
getInstalledPackages
(lessVerbose verbosity)
comp
+ mbWorkDir
packageDbs
programDb0
@@ -987,15 +1018,14 @@ finalCheckPackage
hookedBuildInfo
(PackageInfo{internalPackageSet, promisedDepsSet, installedPackageSet, requiredDepsMap}) =
do
- let verbosity = fromFlag (configVerbosity cfg)
+ let common = configCommonFlags cfg
+ verbosity = fromFlag $ setupVerbosity common
+ cabalFileDir = packageRoot common
use_external_internal_deps =
case enabled of
OneComponentRequestedSpec{} -> True
ComponentRequestedSpec{} -> False
- let cabalFileDir =
- maybe "." takeDirectory $
- flagToMaybe (configCabalFilePath cfg)
checkCompilerProblems verbosity comp pkg_descr enabled
checkPackageProblems
verbosity
@@ -1085,7 +1115,8 @@ configureComponents
(PackageInfo{promisedDepsSet, installedPackageSet})
externalPkgDeps =
do
- let verbosity = fromFlag (configVerbosity cfg)
+ let common = configCommonFlags cfg
+ verbosity = fromFlag $ setupVerbosity common
use_external_internal_deps =
case enabled of
OneComponentRequestedSpec{} -> True
@@ -1739,7 +1770,7 @@ data DependencyResolution
| -- | An internal dependency ('PackageId' should be a library name)
-- which we are going to have to build. (The
-- 'PackageId' here is a hack to get a modest amount of
- -- polymorphism out of the 'Package' typeclass.)
+ -- polymorphism out of the Pkg' typeclass.)
InternalDependency PackageId
-- | Test for a package dependency and record the version we have installed.
@@ -1859,11 +1890,12 @@ reportFailedDependencies verbosity failed =
getInstalledPackages
:: Verbosity
-> Compiler
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDBStack
-- ^ The stack of package databases.
-> ProgramDb
-> IO InstalledPackageIndex
-getInstalledPackages verbosity comp packageDBs progdb = do
+getInstalledPackages verbosity comp mbWorkDir packageDBs progdb = do
when (null packageDBs) $
dieWithException verbosity NoPackageDatabaseSpecified
@@ -1871,15 +1903,16 @@ getInstalledPackages verbosity comp packageDBs progdb = do
-- do not check empty packagedbs (ghc-pkg would error out)
packageDBs' <- filterM packageDBExists packageDBs
case compilerFlavor comp of
- GHC -> GHC.getInstalledPackages verbosity comp packageDBs' progdb
- GHCJS -> GHCJS.getInstalledPackages verbosity packageDBs' progdb
+ GHC -> GHC.getInstalledPackages verbosity comp mbWorkDir packageDBs' progdb
+ GHCJS -> GHCJS.getInstalledPackages verbosity mbWorkDir packageDBs' progdb
UHC -> UHC.getInstalledPackages verbosity comp packageDBs' progdb
HaskellSuite{} ->
HaskellSuite.getInstalledPackages verbosity packageDBs' progdb
flv ->
dieWithException verbosity $ HowToFindInstalledPackages flv
where
- packageDBExists (SpecificPackageDB path) = do
+ packageDBExists (SpecificPackageDB path0) = do
+ let path = interpretSymbolicPath mbWorkDir $ makeSymbolicPath path0
exists <- doesPathExist path
unless exists $
warn verbosity $
@@ -1900,31 +1933,34 @@ getInstalledPackages verbosity comp packageDBs progdb = do
getPackageDBContents
:: Verbosity
-> Compiler
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDB
-> ProgramDb
-> IO InstalledPackageIndex
-getPackageDBContents verbosity comp packageDB progdb = do
+getPackageDBContents verbosity comp mbWorkDir packageDB progdb = do
info verbosity "Reading installed packages..."
case compilerFlavor comp of
- GHC -> GHC.getPackageDBContents verbosity packageDB progdb
- GHCJS -> GHCJS.getPackageDBContents verbosity packageDB progdb
+ GHC -> GHC.getPackageDBContents verbosity mbWorkDir packageDB progdb
+ GHCJS -> GHCJS.getPackageDBContents verbosity mbWorkDir packageDB progdb
-- For other compilers, try to fall back on 'getInstalledPackages'.
- _ -> getInstalledPackages verbosity comp [packageDB] progdb
+ _ -> getInstalledPackages verbosity comp mbWorkDir [packageDB] progdb
-- | A set of files (or directories) that can be monitored to detect when
-- there might have been a change in the installed packages.
getInstalledPackagesMonitorFiles
:: Verbosity
-> Compiler
+ -> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack
-> ProgramDb
-> Platform
-> IO [FilePath]
-getInstalledPackagesMonitorFiles verbosity comp packageDBs progdb platform =
+getInstalledPackagesMonitorFiles verbosity comp mbWorkDir packageDBs progdb platform =
case compilerFlavor comp of
GHC ->
GHC.getInstalledPackagesMonitorFiles
verbosity
+ mbWorkDir
platform
progdb
packageDBs
@@ -1948,8 +1984,9 @@ getInstalledPackagesById
-> [UnitId]
-- ^ The unit ids to lookup in the installed packages
-> IO [InstalledPackageInfo]
-getInstalledPackagesById verbosity LocalBuildInfo{compiler = comp, withPackageDB = pkgDb, withPrograms = progDb} mkException unitids = do
- ipindex <- getInstalledPackages verbosity comp pkgDb progDb
+getInstalledPackagesById verbosity lbi@LocalBuildInfo{compiler = comp, withPackageDB = pkgDb, withPrograms = progDb} mkException unitids = do
+ let mbWorkDir = mbWorkDirLBI lbi
+ ipindex <- getInstalledPackages verbosity comp mbWorkDir pkgDb progDb
mapM
( \uid -> case lookupUnitId ipindex uid of
Nothing -> dieWithException verbosity (mkException uid)
@@ -2240,11 +2277,11 @@ ccLdOptionsBuildInfo cflags ldflags ldflags_static =
(extraLibsStatic') = filter ("-l" `isPrefixOf`) ldflags_static
(extraLibDirsStatic') = filter ("-L" `isPrefixOf`) ldflags_static
in mempty
- { includeDirs = map (drop 2) includeDirs'
+ { includeDirs = map (makeSymbolicPath . drop 2) includeDirs'
, extraLibs = map (drop 2) extraLibs'
- , extraLibDirs = map (drop 2) extraLibDirs'
+ , extraLibDirs = map (makeSymbolicPath . drop 2) extraLibDirs'
, extraLibsStatic = map (drop 2) extraLibsStatic'
- , extraLibDirsStatic = map (drop 2) extraLibDirsStatic'
+ , extraLibDirsStatic = map (makeSymbolicPath . drop 2) extraLibDirsStatic'
, ccOptions = cflags'
, ldOptions = ldflags''
}
@@ -2257,12 +2294,14 @@ configCompilerAuxEx
-> IO (Compiler, Platform, ProgramDb)
configCompilerAuxEx cfg = do
programDb <- mkProgramDb cfg defaultProgramDb
+ let common = configCommonFlags cfg
+ verbosity = fromFlag $ setupVerbosity common
configCompilerEx
(flagToMaybe $ configHcFlavor cfg)
(flagToMaybe $ configHcPath cfg)
(flagToMaybe $ configHcPkg cfg)
programDb
- (fromFlag (configVerbosity cfg))
+ verbosity
configCompilerEx
:: Maybe CompilerFlavor
@@ -2293,8 +2332,7 @@ checkForeignDeps :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
checkForeignDeps pkg lbi verbosity =
ifBuildsWith
allHeaders
- (commonCcArgs ++ makeLdArgs allLibs) -- I'm feeling
- -- lucky
+ (commonCcArgs ++ makeLdArgs allLibs) -- I'm feeling lucky
(return ())
( do
missingLibs <- findMissingLibs
@@ -2302,7 +2340,7 @@ checkForeignDeps pkg lbi verbosity =
explainErrors missingHdr missingLibs
)
where
- allHeaders = collectField includes
+ allHeaders = collectField (fmap getSymbolicPath . includes)
allLibs =
collectField $
if withFullyStaticExe lbi
@@ -2327,24 +2365,24 @@ checkForeignDeps pkg lbi verbosity =
-- including file. As such we need to take drastic measures
-- and delete the offending file in the source directory.
checkDuplicateHeaders = do
- let relIncDirs = filter (not . isAbsolute) (collectField includeDirs)
+ let relIncDirs = filter (not . isAbsolute) (collectField (fmap getSymbolicPath . includeDirs))
isHeader = isSuffixOf ".h"
genHeaders <- for relIncDirs $ \dir ->
fmap (dir </>) . filter isHeader
- <$> listDirectory (buildDir lbi </> dir) `catchIO` (\_ -> return [])
+ <$> listDirectory (i (buildDir lbi) </> dir) `catchIO` (\_ -> return [])
srcHeaders <- for relIncDirs $ \dir ->
fmap (dir </>) . filter isHeader
- <$> listDirectory (baseDir lbi </> dir) `catchIO` (\_ -> return [])
+ <$> listDirectory (baseDir </> dir) `catchIO` (\_ -> return [])
let commonHeaders = concat genHeaders `intersect` concat srcHeaders
for_ commonHeaders $ \hdr -> do
warn verbosity $
"Duplicate header found in "
- ++ (buildDir lbi </> hdr)
+ ++ (getSymbolicPath (buildDir lbi) </> hdr)
++ " and "
- ++ (baseDir lbi </> hdr)
+ ++ (baseDir </> hdr)
++ "; removing "
- ++ (baseDir lbi </> hdr)
- removeFile (baseDir lbi </> hdr)
+ ++ (baseDir </> hdr)
+ removeFile (baseDir </> hdr)
findOffendingHdr =
ifBuildsWith
@@ -2379,7 +2417,12 @@ checkForeignDeps pkg lbi verbosity =
libExists lib = builds (makeProgram []) (makeLdArgs [lib])
- baseDir lbi' = fromMaybe "." (takeDirectory <$> cabalFilePath lbi')
+ common = configCommonFlags $ configFlags lbi
+ baseDir = packageRoot common
+
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ i = interpretSymbolicPathLBI lbi
+ mbWorkDir = mbWorkDirLBI lbi
commonCppArgs =
platformDefines lbi
@@ -2387,21 +2430,21 @@ checkForeignDeps pkg lbi verbosity =
-- fact that the test performed here should be
-- PER-component (c.f. the "I'm Feeling Lucky"; we
-- should NOT be glomming everything together.)
- ++ ["-I" ++ buildDir lbi </> "autogen"]
+ ++ ["-I" ++ i (buildDir lbi </> makeRelativePathEx "autogen")]
-- `configure' may generate headers in the build directory
- ++ [ "-I" ++ buildDir lbi </> dir
- | dir <- ordNub (collectField includeDirs)
- , not (isAbsolute dir)
+ ++ [ "-I" ++ i (buildDir lbi </> unsafeCoerceSymbolicPath dir)
+ | dir <- mapMaybe symbolicPathRelative_maybe $ ordNub (collectField includeDirs)
]
-- we might also reference headers from the
-- packages directory.
- ++ [ "-I" ++ baseDir lbi </> dir
- | dir <- ordNub (collectField includeDirs)
- , not (isAbsolute dir)
+ ++ [ "-I" ++ baseDir </> getSymbolicPath dir
+ | dir <- mapMaybe symbolicPathRelative_maybe $ ordNub (collectField includeDirs)
]
- ++ [ "-I" ++ dir | dir <- ordNub (collectField includeDirs), isAbsolute dir
+ ++ [ "-I" ++ dir
+ | dir <- ordNub (collectField (fmap getSymbolicPath . includeDirs))
+ , isAbsolute dir
]
- ++ ["-I" ++ baseDir lbi]
+ ++ ["-I" ++ baseDir]
++ collectField cppOptions
++ collectField ccOptions
++ [ "-I" ++ dir
@@ -2428,7 +2471,7 @@ checkForeignDeps pkg lbi verbosity =
]
commonLdArgs =
- [ "-L" ++ dir
+ [ "-L" ++ getSymbolicPath dir
| dir <-
ordNub $
collectField
@@ -2461,20 +2504,22 @@ checkForeignDeps pkg lbi verbosity =
allBi = enabledBuildInfos pkg (componentEnabledSpec lbi)
deps = PackageIndex.topologicalOrder (installedPkgs lbi)
+ builds :: String -> [ProgArg] -> IO Bool
builds program args =
do
- tempDir <- getTemporaryDirectory
- withTempFile tempDir ".c" $ \cName cHnd ->
- withTempFile tempDir "" $ \oNname oHnd -> do
+ tempDir <- makeSymbolicPath <$> getTemporaryDirectory
+ withTempFileCwd mbWorkDir tempDir ".c" $ \cName cHnd ->
+ withTempFileCwd mbWorkDir tempDir "" $ \oNname oHnd -> do
hPutStrLn cHnd program
hClose cHnd
hClose oHnd
_ <-
- getDbProgramOutput
+ getDbProgramOutputCwd
verbosity
+ mbWorkDir
gccProgram
(withPrograms lbi)
- (cName : "-o" : oNname : args)
+ (getSymbolicPath cName : "-o" : getSymbolicPath oNname : args)
return True
`catchIO` (\_ -> return False)
`catchExit` (\_ -> return False)
@@ -2580,7 +2625,7 @@ checkRelocatable verbosity pkg lbi =
-- prefix of the package
depsPrefixRelative = do
pkgr <- GHC.pkgRoot verbosity lbi (registrationPackageDB (withPackageDB lbi))
- traverse_ (doCheck pkgr) ipkgs
+ traverse_ (doCheck $ getSymbolicPath pkgr) ipkgs
where
doCheck pkgr ipkg
| maybe False (== pkgr) (IPI.pkgRoot ipkg) =
diff --git a/Cabal/src/Distribution/Simple/ConfigureScript.hs b/Cabal/src/Distribution/Simple/ConfigureScript.hs
index b7a7f16da2..1257ee3999 100644
--- a/Cabal/src/Distribution/Simple/ConfigureScript.hs
+++ b/Cabal/src/Distribution/Simple/ConfigureScript.hs
@@ -32,16 +32,11 @@ import Distribution.Simple.Setup.Config
import Distribution.Simple.Utils
import Distribution.System (buildPlatform)
import Distribution.Utils.NubList
+import Distribution.Utils.Path
import Distribution.Verbosity
-- Base
-import System.FilePath
- ( dropDrive
- , searchPathSeparator
- , splitDirectories
- , takeDirectory
- , (</>)
- )
+import qualified System.FilePath as FilePath
#ifdef mingw32_HOST_OS
import System.FilePath (normalise, splitDrive)
#endif
@@ -59,7 +54,8 @@ runConfigureScript
-> IO ()
runConfigureScript verbosity flags lbi = do
env <- getEnvironment
- let programDb = withPrograms lbi
+ let commonFlags = configCommonFlags flags
+ programDb = withPrograms lbi
(ccProg, ccFlags) <- configureCCompiler verbosity programDb
ccProgShort <- getShortPathName ccProg
-- The C compiler's compilation and linker flags (e.g.
@@ -69,8 +65,7 @@ runConfigureScript verbosity flags lbi = do
-- We don't try and tell configure which ld to use, as we don't have
-- a way to pass its flags too
configureFile <-
- makeAbsolute $
- fromMaybe "." (takeDirectory <$> cabalFilePath lbi) </> "configure"
+ makeAbsolute $ packageRoot commonFlags </> "configure"
-- autoconf is fussy about filenames, and has a set of forbidden
-- characters that can't appear in the build directory, etc:
-- https://www.gnu.org/software/autoconf/manual/autoconf.html#File-System-Conventions
@@ -86,7 +81,7 @@ runConfigureScript verbosity flags lbi = do
-- paths as well.
let configureFile' = toUnix configureFile
for_ badAutoconfCharacters $ \(c, cname) ->
- when (c `elem` dropDrive configureFile') $
+ when (c `elem` FilePath.dropDrive configureFile') $
warn verbosity $
concat
[ "The path to the './configure' script, '"
@@ -155,7 +150,7 @@ runConfigureScript verbosity flags lbi = do
let cflagsEnv =
maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags)) $
lookup "CFLAGS" env
- spSep = [searchPathSeparator]
+ spSep = [FilePath.searchPathSeparator]
pathEnv =
maybe
(intercalate spSep extraPath)
@@ -177,7 +172,7 @@ runConfigureScript verbosity flags lbi = do
Just sh ->
runProgramInvocation verbosity $
(programInvocation (sh{programOverrideEnv = overEnv}) args')
- { progInvokeCwd = Just (buildDir lbi)
+ { progInvokeCwd = Just (interpretSymbolicPathLBI lbi $ buildDir lbi)
}
Nothing -> dieWithException verbosity NotFoundMsg
where
@@ -191,10 +186,10 @@ toUnix s = let tmp = normalise s
(l, rest) = case splitDrive tmp of
([], x) -> ("/" , x)
(h:_, x) -> ('/':h:"/", x)
- parts = splitDirectories rest
+ parts = FilePath.splitDirectories rest
in l ++ intercalate "/" parts
#else
-toUnix s = intercalate "/" $ splitDirectories s
+toUnix s = intercalate "/" $ FilePath.splitDirectories s
#endif
badAutoconfCharacters :: [(Char, String)]
diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs
index 2c5af36a04..1ca8c97c6c 100644
--- a/Cabal/src/Distribution/Simple/Errors.hs
+++ b/Cabal/src/Distribution/Simple/Errors.hs
@@ -152,8 +152,7 @@ data CabalException
| Couldn'tFindTestProgLibV09 FilePath
| TestCoverageSupportLibV09
| RawSystemStdout String
- | FindFileCwd FilePath
- | FindFileEx FilePath
+ | FindFile FilePath
| FindModuleFileEx ModuleName [Suffix] [FilePath]
| MultipleFilesWithExtension String
| NoDesc
@@ -284,8 +283,7 @@ exceptionCode e = case e of
Couldn'tFindTestProgLibV09{} -> 9012
TestCoverageSupportLibV09{} -> 1076
RawSystemStdout{} -> 3098
- FindFileCwd{} -> 4765
- FindFileEx{} -> 2115
+ FindFile{} -> 2115
FindModuleFileEx{} -> 6663
MultipleFilesWithExtension{} -> 3333
NoDesc{} -> 7654
@@ -725,8 +723,7 @@ exceptionMessage e = case e of
++ "\". Did you build the package first?"
TestCoverageSupportLibV09 -> "Test coverage is only supported for packages with a library component."
RawSystemStdout errors -> errors
- FindFileCwd fileName -> fileName ++ " doesn't exist"
- FindFileEx fileName -> fileName ++ " doesn't exist"
+ FindFile fileName -> fileName ++ " doesn't exist"
FindModuleFileEx mod_name extensions searchPath ->
"Could not find module: "
++ prettyShow mod_name
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index d22c7f6184..e71c20d47b 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -82,6 +83,7 @@ module Distribution.Simple.GHC
import Distribution.Compat.Prelude
import Prelude ()
+import Control.Arrow ((***))
import Control.Monad (forM_)
import Data.List (stripPrefix)
import qualified Data.Map as Map
@@ -95,7 +97,6 @@ import Distribution.Simple.Build.Inputs (PreBuildComponentInputs (..))
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.Errors
-import Distribution.Simple.Flag (Flag (..), toFlag)
import qualified Distribution.Simple.GHC.Build as GHC
import Distribution.Simple.GHC.Build.Utils
import Distribution.Simple.GHC.EnvironmentParser
@@ -110,7 +111,7 @@ import Distribution.Simple.Program.Builtin (runghcProgram)
import Distribution.Simple.Program.GHC
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Strip as Strip
-import Distribution.Simple.Setup.Common (extraCompilationArtifacts)
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Repl
import Distribution.Simple.Utils
import Distribution.System
@@ -118,6 +119,7 @@ import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.ParStrat
import Distribution.Types.TargetInfo
import Distribution.Utils.NubList
+import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
import Language.Haskell.Extension
@@ -130,9 +132,8 @@ import System.Directory
, getDirectoryContents
)
import System.FilePath
- ( takeDirectory
- , (<.>)
- , (</>)
+ ( isRelative
+ , takeDirectory
)
import qualified System.Info
#ifndef mingw32_HOST_OS
@@ -392,24 +393,26 @@ getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
-- | Given a single package DB, return all installed packages.
getPackageDBContents
:: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDB
-> ProgramDb
-> IO InstalledPackageIndex
-getPackageDBContents verbosity packagedb progdb = do
- pkgss <- getInstalledPackages' verbosity [packagedb] progdb
+getPackageDBContents verbosity mbWorkDir packagedb progdb = do
+ pkgss <- getInstalledPackages' verbosity mbWorkDir [packagedb] progdb
toPackageIndex verbosity pkgss progdb
-- | Given a package DB stack, return all installed packages.
getInstalledPackages
:: Verbosity
-> Compiler
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
-getInstalledPackages verbosity comp packagedbs progdb = do
+getInstalledPackages verbosity comp mbWorkDir packagedbs progdb = do
checkPackageDbEnvVar verbosity
checkPackageDbStack verbosity comp packagedbs
- pkgss <- getInstalledPackages' verbosity packagedbs progdb
+ pkgss <- getInstalledPackages' verbosity mbWorkDir packagedbs progdb
index <- toPackageIndex verbosity pkgss progdb
return $! hackRtsPackage index
where
@@ -525,24 +528,26 @@ removeMingwIncludeDir pkg =
-- | Get the packages from specific PackageDBs, not cumulative.
getInstalledPackages'
:: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
-getInstalledPackages' verbosity packagedbs progdb =
+getInstalledPackages' verbosity mbWorkDir packagedbs progdb =
sequenceA
[ do
- pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb
+ pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity mbWorkDir packagedb
return (packagedb, pkgs)
| packagedb <- packagedbs
]
getInstalledPackagesMonitorFiles
:: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> Platform
-> ProgramDb
-> [PackageDB]
-> IO [FilePath]
-getInstalledPackagesMonitorFiles verbosity platform progdb =
+getInstalledPackagesMonitorFiles verbosity mbWorkDir platform progdb =
traverse getPackageDBPath
where
getPackageDBPath :: PackageDB -> IO FilePath
@@ -556,7 +561,11 @@ getInstalledPackagesMonitorFiles verbosity platform progdb =
-- Note that for dir style dbs, we only need to monitor the cache file, not
-- the whole directory. The ghc program itself only reads the cache file
-- so it's safe to only monitor this one file.
- selectMonitorFile path = do
+ selectMonitorFile path0 = do
+ let path =
+ if isRelative path0
+ then interpretSymbolicPath mbWorkDir (makeRelativePathEx path0)
+ else path0
isFileStyle <- doesFileExist path
if isFileStyle
then return path
@@ -577,7 +586,11 @@ buildLib
-> IO ()
buildLib flags numJobs pkg lbi lib clbi =
GHC.build numJobs pkg $
- PreBuildComponentInputs (BuildNormal flags) lbi (TargetInfo clbi (CLib lib))
+ PreBuildComponentInputs
+ { buildingWhat = BuildNormal flags
+ , localBuildInfo = lbi
+ , targetInfo = TargetInfo clbi (CLib lib)
+ }
replLib
:: ReplFlags
@@ -589,7 +602,11 @@ replLib
-> IO ()
replLib flags numJobs pkg lbi lib clbi =
GHC.build numJobs pkg $
- PreBuildComponentInputs (BuildRepl flags) lbi (TargetInfo clbi (CLib lib))
+ PreBuildComponentInputs
+ { buildingWhat = BuildRepl flags
+ , localBuildInfo = lbi
+ , targetInfo = TargetInfo clbi (CLib lib)
+ }
-- | Start a REPL without loading any source files.
startInterpreter
@@ -607,7 +624,7 @@ startInterpreter verbosity progdb comp platform packageDBs = do
}
checkPackageDbStack verbosity comp packageDBs
(ghcProg, _) <- requireProgram verbosity ghcProgram progdb
- runGHC verbosity ghcProg comp platform replOpts
+ runGHC verbosity ghcProg comp platform Nothing replOpts
-- -----------------------------------------------------------------------------
-- Building an executable or foreign library
@@ -623,7 +640,16 @@ buildFLib
-> IO ()
buildFLib v numJobs pkg lbi flib clbi =
GHC.build numJobs pkg $
- PreBuildComponentInputs (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CFLib flib))
+ PreBuildComponentInputs
+ { buildingWhat =
+ BuildNormal $
+ mempty
+ { buildCommonFlags =
+ mempty{setupVerbosity = toFlag v}
+ }
+ , localBuildInfo = lbi
+ , targetInfo = TargetInfo clbi (CFLib flib)
+ }
replFLib
:: ReplFlags
@@ -635,7 +661,11 @@ replFLib
-> IO ()
replFLib replFlags njobs pkg lbi flib clbi =
GHC.build njobs pkg $
- PreBuildComponentInputs (BuildRepl replFlags) lbi (TargetInfo clbi (CFLib flib))
+ PreBuildComponentInputs
+ { buildingWhat = BuildRepl replFlags
+ , localBuildInfo = lbi
+ , targetInfo = TargetInfo clbi (CFLib flib)
+ }
-- | Build an executable with GHC.
buildExe
@@ -648,7 +678,16 @@ buildExe
-> IO ()
buildExe v njobs pkg lbi exe clbi =
GHC.build njobs pkg $
- PreBuildComponentInputs (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CExe exe))
+ PreBuildComponentInputs
+ { buildingWhat =
+ BuildNormal $
+ mempty
+ { buildCommonFlags =
+ mempty{setupVerbosity = toFlag v}
+ }
+ , localBuildInfo = lbi
+ , targetInfo = TargetInfo clbi (CExe exe)
+ }
replExe
:: ReplFlags
@@ -660,7 +699,11 @@ replExe
-> IO ()
replExe replFlags njobs pkg lbi exe clbi =
GHC.build njobs pkg $
- PreBuildComponentInputs (BuildRepl replFlags) lbi (TargetInfo clbi (CExe exe))
+ PreBuildComponentInputs
+ { buildingWhat = BuildRepl replFlags
+ , localBuildInfo = lbi
+ , targetInfo = TargetInfo clbi (CExe exe)
+ }
-- | Extracts a String representing a hash of the ABI of a built
-- library. It can fail if the library has not yet been built.
@@ -676,6 +719,7 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
libBi = libBuildInfo lib
comp = compiler lbi
platform = hostPlatform lbi
+ mbWorkDir = mbWorkDirLBI lbi
vanillaArgs =
(Internal.componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
`mappend` mempty
@@ -714,7 +758,7 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
hash <-
getProgramInvocationOutput
verbosity
- =<< ghcInvocation verbosity ghcProg comp platform ghcArgs
+ =<< ghcInvocation verbosity ghcProg comp platform mbWorkDir ghcArgs
return (takeWhile (not . isSpace) hash)
@@ -879,7 +923,7 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
]
sequence_
[ do
- files <- getDirectoryContents builtDir
+ files <- getDirectoryContents (i builtDir)
let l' =
mkGenericSharedBundledLibName
platform
@@ -887,7 +931,7 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
l
forM_ files $ \file ->
when (l' `isPrefixOf` file) $ do
- isFile <- doesFileExist (builtDir </> file)
+ isFile <- doesFileExist (i $ builtDir </> makeRelativePathEx file)
when isFile $ do
installShared
builtDir
@@ -896,10 +940,14 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
| l <- extraBundledLibs (libBuildInfo lib)
]
where
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ i = interpretSymbolicPathLBI lbi
+
builtDir = componentBuildDir lbi clbi
+ mbWorkDir = mbWorkDirLBI lbi
install isShared srcDir dstDir name = do
- let src = srcDir </> name
+ let src = i $ srcDir </> makeRelativePathEx name
dst = dstDir </> name
createDirectoryIfMissingVerbose verbosity True dstDir
@@ -918,13 +966,15 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
installOrdinary = install False
installShared = install True
- copyModuleFiles ext =
- findModuleFilesEx verbosity [builtDir] [ext] (allLibModules lib clbi)
- >>= installOrdinaryFiles verbosity targetDir
+ copyModuleFiles ext = do
+ files <- findModuleFilesCwd verbosity mbWorkDir [builtDir] [ext] (allLibModules lib clbi)
+ let files' = map (i *** getSymbolicPath) files
+ installOrdinaryFiles verbosity targetDir files'
+ copyDirectoryIfExists :: RelativePath Build (Dir Artifacts) -> IO ()
copyDirectoryIfExists dirName = do
- let src = builtDir </> dirName
- dst = targetDir </> dirName
+ let src = i $ builtDir </> dirName
+ dst = targetDir </> getSymbolicPath dirName
dirExists <- doesDirectoryExist src
when dirExists $ copyDirectoryRecursive verbosity src dst
@@ -977,20 +1027,22 @@ hcPkgInfo progdb =
registerPackage
:: Verbosity
-> ProgramDb
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
-registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
+registerPackage verbosity progdb mbWorkDir packageDbs installedPkgInfo registerOptions =
HcPkg.register
(hcPkgInfo progdb)
verbosity
+ mbWorkDir
packageDbs
installedPkgInfo
registerOptions
-pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
-pkgRoot verbosity lbi = pkgRoot'
+pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO (SymbolicPath CWD (Dir Pkg))
+pkgRoot verbosity lbi = fmap makeSymbolicPath . pkgRoot'
where
pkgRoot' GlobalPackageDB =
let ghcProg = fromMaybe (error "GHC.pkgRoot: no ghc program") $ lookupProgram ghcProgram (withPrograms lbi)
@@ -1006,9 +1058,12 @@ pkgRoot verbosity lbi = pkgRoot'
: prettyShow ver
rootDir = appDir </> subdir
-- We must create the root directory for the user package database if it
- -- does not yet exists. Otherwise '${pkgroot}' will resolve to a
+ -- does not yet exist. Otherwise '${pkgroot}' will resolve to a
-- directory at the time of 'ghc-pkg register', and registration will
-- fail.
createDirectoryIfMissing True rootDir
return rootDir
- pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp)
+ pkgRoot' (SpecificPackageDB fp) =
+ return $
+ takeDirectory $
+ interpretSymbolicPathLBI lbi (unsafeMakeSymbolicPath fp)
diff --git a/Cabal/src/Distribution/Simple/GHC/Build.hs b/Cabal/src/Distribution/Simple/GHC/Build.hs
index cc50e3bdb3..51f7d65033 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+
module Distribution.Simple.GHC.Build where
import Distribution.Compat.Prelude
@@ -13,18 +15,18 @@ import Distribution.Simple.GHC.Build.Link
import Distribution.Simple.GHC.Build.Modules
import Distribution.Simple.GHC.Build.Utils (withDynFLib)
import Distribution.Simple.LocalBuildInfo
-import Distribution.Simple.Program
+import Distribution.Simple.Program.Builtin (ghcProgram)
+import Distribution.Simple.Program.Db (requireProgram)
import Distribution.Simple.Utils
import Distribution.Types.ComponentLocalBuildInfo (componentIsIndefinite)
import Distribution.Types.ParStrat
import Distribution.Utils.NubList (fromNubListR)
-import System.Directory hiding (exeExtension)
-import System.FilePath
+import Distribution.Utils.Path
-{-
-Note [Build Target Dir vs Target Dir]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+import System.FilePath (splitDirectories)
+{- Note [Build Target Dir vs Target Dir]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Where to place the build result (targetDir) and the build artifacts (buildTargetDir).
\* For libraries, targetDir == buildTargetDir, where both the library and
@@ -47,7 +49,7 @@ Furthermore, we need to account for the limit of characters in ghc
invocations that different OSes constrain us to. Cabal invocations can
rapidly reach this limit, in part, due to the long length of cabal v2
prefixes. To minimize the likelihood, we use
-`makeRelativeToCurrentDirectory` to shorten the paths used in invocations
+`tryMakeRelativeToWorkingDir` to shorten the paths used in invocations
(see da6321bb).
However, in executables, we don't do this. It seems that we don't need to do it
@@ -72,33 +74,39 @@ build numJobs pkg_descr pbci = do
isLib = buildIsLib pbci
lbi = localBuildInfo pbci
clbi = buildCLBI pbci
+ mbWorkDir = mbWorkDirLBI lbi
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
-- Create a few directories for building the component
-- See Note [Build Target Dir vs Target Dir]
- let targetDir_absolute = componentBuildDir lbi clbi
- buildTargetDir_absolute
+ let targetDir0 :: SymbolicPath Pkg ('Dir Build)
+ targetDir0 = componentBuildDir lbi clbi
+ buildTargetDir0 :: SymbolicPath Pkg ('Dir Artifacts)
+ buildTargetDir0
-- Libraries use the target dir for building (see above)
- | isLib = targetDir_absolute
+ | isLib = coerceSymbolicPath targetDir0
-- In other cases, use targetDir/<name-of-target-dir>-tmp
- | targetDirName : _ <- reverse $ splitDirectories targetDir_absolute =
- targetDir_absolute </> (targetDirName ++ "-tmp")
+ | targetDirName : _ <- reverse $ splitDirectories $ getSymbolicPath targetDir0 =
+ coerceSymbolicPath targetDir0 </> makeRelativePathEx (targetDirName ++ "-tmp")
| otherwise = error "GHC.build: targetDir is empty"
liftIO $ do
- createDirectoryIfMissingVerbose verbosity True targetDir_absolute
- createDirectoryIfMissingVerbose verbosity True buildTargetDir_absolute
+ createDirectoryIfMissingVerbose verbosity True $ i targetDir0
+ createDirectoryIfMissingVerbose verbosity True $ i buildTargetDir0
-- See Note [Build Target Dir vs Target Dir] as well
- _targetDir <- liftIO $ makeRelativeToCurrentDirectory targetDir_absolute
+ let targetDir = targetDir0 -- NB: no 'makeRelative'
buildTargetDir <-
- -- To preserve the previous behaviour, we don't use relative dirs for
- -- executables. Historically, this isn't needed to reduce the CLI limit
- -- (unlike for libraries) because we link executables with the module names
- -- instead of passing the path to object file -- that's something else we
- -- can now fix after the refactor lands.
if isLib
- then liftIO $ makeRelativeToCurrentDirectory buildTargetDir_absolute
- else return buildTargetDir_absolute
+ then -- NB: this might fail to make the buildTargetDir relative,
+ -- as noted in #9776. Oh well.
+ tryMakeRelativeToWorkingDir mbWorkDir buildTargetDir0
+ else return buildTargetDir0
+ -- To preserve the previous behaviour, we don't use relative dirs for
+ -- executables. Historically, this isn't needed to reduce the CLI limit
+ -- (unlike for libraries) because we link executables with the module names
+ -- instead of passing the path to object file -- that's something else we
+ -- can now fix after the refactor lands.
(ghcProg, _) <- liftIO $ requireProgram verbosity ghcProgram (withPrograms lbi)
@@ -135,6 +143,12 @@ build numJobs pkg_descr pbci = do
-- We need a separate build and link phase, and C sources must be compiled
-- after Haskell modules, because C sources may depend on stub headers
-- generated from compiling Haskell modules (#842, #3294).
- buildOpts <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir_absolute wantedWays pbci
+ buildOpts <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays pbci
extraSources <- buildAllExtraSources ghcProg buildTargetDir pbci
- linkOrLoadComponent ghcProg pkg_descr (fromNubListR extraSources) (buildTargetDir, targetDir_absolute) (wantedWays, buildOpts) pbci
+ linkOrLoadComponent
+ ghcProg
+ pkg_descr
+ (fromNubListR extraSources)
+ (buildTargetDir, targetDir)
+ (wantedWays, buildOpts)
+ pbci
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
index 07ad6ac31d..fc204cda30 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.GHC.Build.ExtraSources where
@@ -16,26 +18,26 @@ import Distribution.Types.BuildInfo
import Distribution.Types.Component
import Distribution.Types.TargetInfo
+import Distribution.Simple.Build.Inputs
import Distribution.Simple.GHC.Build.Utils
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program.Types
import Distribution.System (Arch (JavaScript), Platform (..))
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.Executable
+import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity)
-import Distribution.Simple.Build.Inputs
-
-- | An action that builds all the extra build sources of a component, i.e. C,
-- C++, Js, Asm, C-- sources.
buildAllExtraSources
:: ConfiguredProgram
-- ^ The GHC configured program
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
-- ^ The build directory for this target
-> PreBuildComponentInputs
-- ^ The context and component being built in it.
- -> IO (NubListR FilePath)
+ -> IO (NubListR (SymbolicPath Pkg File))
-- ^ Returns the (nubbed) list of extra sources that were built
buildAllExtraSources =
mconcat
@@ -53,33 +55,43 @@ buildCSources
, buildCmmSources
:: ConfiguredProgram
-- ^ The GHC configured program
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
-- ^ The build directory for this target
-> PreBuildComponentInputs
-- ^ The context and component being built in it.
- -> IO (NubListR FilePath)
+ -> IO (NubListR (SymbolicPath Pkg File))
-- ^ Returns the list of extra sources that were built
buildCSources =
buildExtraSources
"C Sources"
Internal.componentCcGhcOptions
True
- ( \c ->
- cSources (componentBuildInfo c)
- ++ case c of
- CExe exe | isC (modulePath exe) -> [modulePath exe]
- _otherwise -> []
+ ( \c -> do
+ let cFiles = cSources (componentBuildInfo c)
+ case c of
+ CExe exe
+ | let mainPath = getSymbolicPath $ modulePath exe
+ , isC mainPath ->
+ cFiles ++ [makeSymbolicPath mainPath]
+ -- NB: Main.hs is relative to hs-source-dirs, but Main.c
+ -- is relative to the package.
+ _otherwise -> cFiles
)
buildCxxSources =
buildExtraSources
"C++ Sources"
Internal.componentCxxGhcOptions
True
- ( \c ->
- cxxSources (componentBuildInfo c)
- ++ case c of
- CExe exe | isCxx (modulePath exe) -> [modulePath exe]
- _otherwise -> []
+ ( \c -> do
+ let cxxFiles = cxxSources (componentBuildInfo c)
+ case c of
+ CExe exe
+ | let mainPath = getSymbolicPath $ modulePath exe
+ , isCxx mainPath ->
+ do cxxFiles ++ [makeSymbolicPath mainPath]
+ -- NB: Main.hs is relative to hs-source-dirs, but Main.c++
+ -- is relative to the package.
+ _otherwise -> cxxFiles
)
buildJsSources ghcProg buildTargetDir = do
Platform hostArch _ <- hostPlatform <$> localBuildInfo
@@ -118,7 +130,14 @@ buildCmmSources =
buildExtraSources
:: String
-- ^ String describing the extra sources being built, for printing.
- -> (Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> FilePath -> GhcOptions)
+ -> ( Verbosity
+ -> LocalBuildInfo
+ -> BuildInfo
+ -> ComponentLocalBuildInfo
+ -> SymbolicPath Pkg (Dir Artifacts)
+ -> SymbolicPath Pkg File
+ -> GhcOptions
+ )
-- ^ Function to determine the @'GhcOptions'@ for the
-- invocation of GHC when compiling these extra sources (e.g.
-- @'Internal.componentCxxGhcOptions'@,
@@ -127,7 +146,7 @@ buildExtraSources
-- ^ Some types of build sources should not be built in the dynamic way, namely, JS sources.
-- I'm not entirely sure this remains true after we migrate to supporting GHC's JS backend rather than GHCJS.
-- Boolean for "do we allow building these sources the dynamic way?"
- -> (Component -> [FilePath])
+ -> (Component -> [SymbolicPath Pkg File])
-- ^ View the extra sources of a component, typically from
-- the build info (e.g. @'asmSources'@, @'cSources'@).
-- @'Executable'@ components might additionally add the
@@ -135,21 +154,21 @@ buildExtraSources
-- if it should be compiled as the rest of them.
-> ConfiguredProgram
-- ^ The GHC configured program
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
-- ^ The build directory for this target
-> PreBuildComponentInputs
-- ^ The context and component being built in it.
- -> IO (NubListR FilePath)
+ -> IO (NubListR (SymbolicPath Pkg File))
-- ^ Returns the list of extra sources that were built
buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcProg buildTargetDir =
- \PreBuildComponentInputs{buildingWhat, localBuildInfo = lbi, targetInfo} ->
+ \PreBuildComponentInputs{buildingWhat, localBuildInfo = lbi, targetInfo} -> do
let
bi = componentBuildInfo (targetComponent targetInfo)
verbosity = buildingWhatVerbosity buildingWhat
clbi = targetCLBI targetInfo
-
+ mbWorkDir = mbWorkDirLBI lbi
+ i = interpretSymbolicPath mbWorkDir
sources = viewSources (targetComponent targetInfo)
-
comp = compiler lbi
platform = hostPlatform lbi
-- Instead of keeping this logic here, we really just want to
@@ -161,6 +180,7 @@ buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcP
forceSharedLib = doingTH && isGhcDynamic
runGhcProg = runGHC verbosity ghcProg comp platform
+ buildAction :: SymbolicPath Pkg File -> IO ()
buildAction sourceFile = do
let baseSrcOpts =
componentSourceGhcOptions
@@ -191,13 +211,15 @@ buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcP
-- consider this a user error. However, we should strive to
-- add a warning if this occurs.
odir = fromFlag (ghcOptObjDir vanillaSrcOpts)
+
+ compileIfNeeded :: GhcOptions -> IO ()
compileIfNeeded opts = do
- needsRecomp <- checkNeedsRecompilation sourceFile opts
- when needsRecomp $ runGhcProg opts
+ needsRecomp <- checkNeedsRecompilation mbWorkDir sourceFile opts
+ when needsRecomp $ runGhcProg mbWorkDir opts
-- TODO: This whole section can be streamlined to the
-- wantedWays+neededWays logic used in Build/Modules.hs
- createDirectoryIfMissingVerbose verbosity True odir
+ createDirectoryIfMissingVerbose verbosity True (i odir)
case targetComponent targetInfo of
-- For libraries, we compile extra objects in the three ways: vanilla, shared, and profiled.
-- We suffix shared objects with .dyn_o and profiled ones with .p_o.
@@ -232,11 +254,10 @@ buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcP
compileIfNeeded sharedSrcOpts
| otherwise ->
compileIfNeeded vanillaSrcOpts
- in
- -- build any sources
- if (null sources || componentIsIndefinite clbi)
- then return mempty
- else do
- info verbosity ("Building " ++ description ++ "...")
- traverse_ buildAction sources
- return (toNubListR sources)
+ -- build any sources
+ if (null sources || componentIsIndefinite clbi)
+ then return mempty
+ else do
+ info verbosity ("Building " ++ description ++ "...")
+ traverse_ buildAction sources
+ return (toNubListR sources)
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
index f25c60c887..9f454e0ea5 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
@@ -1,4 +1,7 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
module Distribution.Simple.GHC.Build.Link where
@@ -35,15 +38,27 @@ import qualified Distribution.Simple.Program.Ar as Ar
import Distribution.Simple.Program.GHC
import qualified Distribution.Simple.Program.Ld as Ld
import Distribution.Simple.Setup.Common
+import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Repl
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Utils.NubList
+import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
+
import System.Directory
+ ( createDirectoryIfMissing
+ , doesDirectoryExist
+ , doesFileExist
+ , removeFile
+ , renameFile
+ )
import System.FilePath
+ ( isRelative
+ , replaceExtension
+ )
-- | Links together the object files of the Haskell modules and extra sources
-- using the context in which the component is being built.
@@ -54,11 +69,11 @@ linkOrLoadComponent
-- ^ The configured GHC program that will be used for linking
-> PackageDescription
-- ^ The package description containing the component being built
- -> [FilePath]
+ -> [SymbolicPath Pkg File]
-- ^ The full list of extra build sources (all C, C++, Js,
-- Asm, and Cmm sources), which were compiled to object
-- files.
- -> (FilePath, FilePath)
+ -> (SymbolicPath Pkg (Dir Artifacts), SymbolicPath Pkg (Dir Build))
-- ^ The build target dir, and the target dir.
-- See Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build
-> (Set.Set BuildWay, BuildWay -> GhcOptions)
@@ -77,13 +92,21 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (
lbi = localBuildInfo pbci
bi = buildBI pbci
clbi = buildCLBI pbci
+ mbWorkDir = mbWorkDirLBI lbi
+
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ i = interpretSymbolicPathLBI lbi
-- ensure extra lib dirs exist before passing to ghc
- cleanedExtraLibDirs <- liftIO $ filterM doesDirectoryExist (extraLibDirs bi)
- cleanedExtraLibDirsStatic <- liftIO $ filterM doesDirectoryExist (extraLibDirsStatic bi)
+ cleanedExtraLibDirs <- liftIO $ filterM (doesDirectoryExist . i) (extraLibDirs bi)
+ cleanedExtraLibDirsStatic <- liftIO $ filterM (doesDirectoryExist . i) (extraLibDirsStatic bi)
let
- extraSourcesObjs = map (`replaceExtension` objExtension) extraSources
+ extraSourcesObjs :: [RelativePath Artifacts File]
+ extraSourcesObjs =
+ [ makeRelativePathEx $ getSymbolicPath src `replaceExtension` objExtension
+ | src <- extraSources
+ ]
-- TODO: Shouldn't we use withStaticLib for libraries and something else
-- for foreign libs in the three cases where we use `withFullyStaticExe` below?
@@ -109,9 +132,13 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (
if withFullyStaticExe lbi
then cleanedExtraLibDirsStatic
else cleanedExtraLibDirs
- , ghcOptLinkFrameworks = toNubListR $ PD.frameworks bi
+ , ghcOptLinkFrameworks = toNubListR $ map getSymbolicPath $ PD.frameworks bi
, ghcOptLinkFrameworkDirs = toNubListR $ PD.extraFrameworkDirs bi
- , ghcOptInputFiles = toNubListR [buildTargetDir </> x | x <- extraSourcesObjs]
+ , ghcOptInputFiles =
+ toNubListR
+ [ coerceSymbolicPath $ buildTargetDir </> obj
+ | obj <- extraSourcesObjs
+ ]
, ghcOptNoLink = Flag False
, ghcOptRPaths = rpaths
}
@@ -155,7 +182,7 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (
runReplOrWriteFlags ghcProg lbi replFlags replOpts (pkgName (PD.package pkg_descr)) target
_otherwise ->
let
- runGhcProg = runGHC verbosity ghcProg comp platform
+ runGhcProg = runGHC verbosity ghcProg comp platform mbWorkDir
platform = hostPlatform lbi
comp = compiler lbi
in
@@ -174,9 +201,9 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (
-- | Link a library component
linkLibrary
- :: FilePath
+ :: SymbolicPath Pkg (Dir Artifacts)
-- ^ The library target build directory
- -> [FilePath]
+ -> [SymbolicPath Pkg (Dir Lib)]
-- ^ The list of extra lib dirs that exist (aka "cleaned")
-> PackageDescription
-- ^ The package description containing this library
@@ -186,7 +213,7 @@ linkLibrary
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
- -> [FilePath]
+ -> [SymbolicPath Pkg File]
-- ^ Extra build sources (that were compiled to objects)
-> NubListR FilePath
-- ^ A list with the runtime-paths (rpaths), or empty if not linking dynamically
@@ -195,6 +222,9 @@ linkLibrary
-> IO ()
linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg lib lbi clbi extraSources rpaths wantedWays = do
let
+ common = configCommonFlags $ configFlags lbi
+ mbWorkDir = flagToMaybe $ setupWorkingDir common
+
compiler_id = compilerId comp
comp = compiler lbi
ghcVersion = compilerVersion comp
@@ -202,16 +232,16 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li
uid = componentUnitId clbi
libBi = libBuildInfo lib
Platform _hostArch hostOS = hostPlatform lbi
- vanillaLibFilePath = buildTargetDir </> mkLibName uid
- profileLibFilePath = buildTargetDir </> mkProfLibName uid
+ vanillaLibFilePath = buildTargetDir </> makeRelativePathEx (mkLibName uid)
+ profileLibFilePath = buildTargetDir </> makeRelativePathEx (mkProfLibName uid)
sharedLibFilePath =
buildTargetDir
- </> mkSharedLibName (hostPlatform lbi) compiler_id uid
+ </> makeRelativePathEx (mkSharedLibName (hostPlatform lbi) compiler_id uid)
staticLibFilePath =
buildTargetDir
- </> mkStaticLibName (hostPlatform lbi) compiler_id uid
- ghciLibFilePath = buildTargetDir </> Internal.mkGHCiLibName uid
- ghciProfLibFilePath = buildTargetDir </> Internal.mkGHCiProfLibName uid
+ </> makeRelativePathEx (mkStaticLibName (hostPlatform lbi) compiler_id uid)
+ ghciLibFilePath = buildTargetDir </> makeRelativePathEx (Internal.mkGHCiLibName uid)
+ ghciProfLibFilePath = buildTargetDir </> makeRelativePathEx (Internal.mkGHCiProfLibName uid)
libInstallPath =
libdir $
absoluteComponentInstallDirs
@@ -223,6 +253,7 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li
libInstallPath
</> mkSharedLibName (hostPlatform lbi) compiler_id uid
+ getObjFiles :: BuildWay -> IO [SymbolicPath Pkg File]
getObjFiles way =
mconcat
[ Internal.getHaskellObjects
@@ -233,20 +264,34 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li
buildTargetDir
(buildWayPrefix way ++ objExtension)
True
- , pure $
- map (buildTargetDir </>) $
- map ((`replaceExtension` (buildWayPrefix way ++ objExtension))) extraSources
+ , pure $ map (srcObjPath way) extraSources
, catMaybes
<$> sequenceA
- [ findFileWithExtension
+ [ findFileCwdWithExtension
+ mbWorkDir
[Suffix $ buildWayPrefix way ++ objExtension]
[buildTargetDir]
- (ModuleName.toFilePath x ++ "_stub")
+ xPath
| ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files
, x <- allLibModules lib clbi
+ , let xPath :: RelativePath Artifacts File
+ xPath = makeRelativePathEx $ ModuleName.toFilePath x ++ "_stub"
]
]
+ -- Get the @.o@ path from a source path (e.g. @.hs@),
+ -- in the library target build directory.
+ srcObjPath :: BuildWay -> SymbolicPath Pkg File -> SymbolicPath Pkg File
+ srcObjPath way srcPath =
+ case symbolicPathRelative_maybe objPath of
+ -- Absolute path: should already be in the target build directory
+ -- (e.g. a preprocessed file)
+ -- TODO: assert this?
+ Nothing -> objPath
+ Just objRelPath -> coerceSymbolicPath buildTargetDir </> objRelPath
+ where
+ objPath = srcPath `replaceExtensionSymbolicPath` (buildWayPrefix way ++ objExtension)
+
-- I'm fairly certain that, just like the executable, we can keep just the
-- module input list, and point to the right sources dir (as is already
-- done), and GHC will pick up the right suffix (p_ for profile, dyn_ when
@@ -291,11 +336,12 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li
-- After the relocation lib is created we invoke ghc -shared
-- with the dependencies spelled out as -package arguments
-- and ghc invokes the linker with the proper library paths
+ ghcSharedLinkArgs :: [SymbolicPath Pkg File] -> GhcOptions
ghcSharedLinkArgs dynObjectFiles =
ghcBaseLinkArgs
{ ghcOptShared = toFlag True
, ghcOptDynLinkMode = toFlag GhcDynamicOnly
- , ghcOptInputFiles = toNubListR dynObjectFiles
+ , ghcOptInputFiles = toNubListR $ map coerceSymbolicPath dynObjectFiles
, ghcOptOutputFile = toFlag sharedLibFilePath
, -- For dynamic libs, Mac OS/X needs to know the install location
-- at build time. This only applies to GHC < 7.8 - see the
@@ -307,7 +353,7 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li
else mempty
, ghcOptLinkLibs = extraLibs libBi
, ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
- , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi
+ , ghcOptLinkFrameworks = toNubListR $ map getSymbolicPath $ PD.frameworks libBi
, ghcOptLinkFrameworkDirs =
toNubListR $ PD.extraFrameworkDirs libBi
, ghcOptRPaths = rpaths
@@ -315,7 +361,7 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li
ghcStaticLinkArgs staticObjectFiles =
ghcBaseLinkArgs
{ ghcOptStaticLib = toFlag True
- , ghcOptInputFiles = toNubListR staticObjectFiles
+ , ghcOptInputFiles = toNubListR $ map coerceSymbolicPath staticObjectFiles
, ghcOptOutputFile = toFlag staticLibFilePath
, ghcOptLinkLibs = extraLibs libBi
, -- TODO: Shouldn't this use cleanedExtraLibDirsStatic instead?
@@ -370,7 +416,7 @@ linkExecutable
-> (Set.Set BuildWay, BuildWay -> GhcOptions)
-- ^ The wanted build ways and corresponding GhcOptions that were
-- used to compile the modules in that way.
- -> FilePath
+ -> SymbolicPath Pkg (Dir Build)
-- ^ The target dir (2024-01:note: not the same as build target
-- dir, see Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build)
-> UnqualComponentName
@@ -396,10 +442,12 @@ linkExecutable linkerOpts (wantedWays, buildOpts) targetDir targetName runGhcPro
-- Work around old GHCs not relinking in this
-- situation, see #3294
- let target = targetDir </> exeTargetName (hostPlatform lbi) targetName
+ let target =
+ targetDir </> makeRelativePathEx (exeTargetName (hostPlatform lbi) targetName)
when (compilerVersion comp < mkVersion [7, 7]) $ do
- e <- doesFileExist target
- when e (removeFile target)
+ let targetPath = interpretSymbolicPathLBI lbi target
+ e <- doesFileExist targetPath
+ when e (removeFile targetPath)
runGhcProg linkOpts{ghcOptOutputFile = toFlag target}
-- | Link a foreign library component
@@ -412,7 +460,7 @@ linkFLib
-> (Set.Set BuildWay, BuildWay -> GhcOptions)
-- ^ The wanted build ways and corresponding GhcOptions that were
-- used to compile the modules in that way.
- -> FilePath
+ -> SymbolicPath Pkg (Dir Build)
-- ^ The target dir (2024-01:note: not the same as build target
-- dir, see Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build)
-> (GhcOptions -> IO ())
@@ -432,7 +480,7 @@ linkFLib flib bi lbi linkerOpts (wantedWays, buildOpts) targetDir runGhcProg = d
| otherwise =
mempty
{ ghcOptLinkLibs = rtsOptLinkLibs
- , ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo
+ , ghcOptLinkLibPath = toNubListR $ map makeSymbolicPath $ rtsLibPaths rtsInfo
}
where
threaded = hasThreaded bi
@@ -460,7 +508,7 @@ linkFLib flib bi lbi linkerOpts (wantedWays, buildOpts) targetDir runGhcProg = d
{ ghcOptLinkNoHsMain = toFlag True
, ghcOptShared = toFlag True
, ghcOptFPic = toFlag True
- , ghcOptLinkModDefFiles = toNubListR $ foreignLibModDefFile flib
+ , ghcOptLinkModDefFiles = toNubListR $ fmap getSymbolicPath $ foreignLibModDefFile flib
}
ForeignLibNativeStatic ->
-- this should be caught by buildFLib
@@ -476,8 +524,10 @@ linkFLib flib bi lbi linkerOpts (wantedWays, buildOpts) targetDir runGhcProg = d
-- There should not be more than one wanted way when building an flib
assert (Set.size wantedWays == 1) $
forM_ wantedWays $ \way -> do
- runGhcProg (linkOpts way){ghcOptOutputFile = toFlag (targetDir </> buildName)}
- renameFile (targetDir </> buildName) (targetDir </> flibTargetName lbi flib)
+ let outFile = targetDir </> makeRelativePathEx buildName
+ runGhcProg (linkOpts way){ghcOptOutputFile = toFlag outFile}
+ let i = interpretSymbolicPathLBI lbi
+ renameFile (i outFile) (i targetDir </> flibTargetName lbi flib)
-- | Calculate the RPATHs for the component we are building.
--
@@ -534,7 +584,9 @@ getRPaths pbci = do
OSX -> "@loader_path"
_ -> "$ORIGIN"
relPath p = if isRelative p then hostPref </> p else p
- rpaths = toNubListR (map relPath libraryPaths) <> toNubListR (extraLibDirs bi)
+ rpaths =
+ toNubListR (map relPath libraryPaths)
+ <> toNubListR (map getSymbolicPath $ extraLibDirs bi)
return rpaths
else return mempty
@@ -628,10 +680,12 @@ runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target =
clbi = targetCLBI target
comp = compiler lbi
platform = hostPlatform lbi
+ common = configCommonFlags $ configFlags lbi
+ mbWorkDir = mbWorkDirLBI lbi
+ verbosity = fromFlag $ setupVerbosity common
in case replOptionsFlagOutput (replReplOptions rflags) of
- NoFlag -> runGHC (fromFlag $ replVerbosity rflags) ghcProg comp platform ghcOpts
+ NoFlag -> runGHC verbosity ghcProg comp platform mbWorkDir ghcOpts
Flag out_dir -> do
- src_dir <- getCurrentDirectory
let uid = componentUnitId clbi
this_unit = prettyShow uid
reexported_modules = [mn | LibComponentLocalBuildInfo{} <- [clbi], IPI.ExposedModule mn (Just{}) <- componentExposedModules clbi]
@@ -639,7 +693,9 @@ runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target =
extra_opts =
concat $
[ ["-this-package-name", prettyShow pkg_name]
- , ["-working-dir", src_dir]
+ , case mbWorkDir of
+ Nothing -> []
+ Just wd -> ["-working-dir", getSymbolicPath wd]
]
++ [ ["-reexported-module", prettyShow m] | m <- reexported_modules
]
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs b/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs
index 0a6c408ee4..9c9e55a03b 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
module Distribution.Simple.GHC.Build.Modules (buildHaskellModules, BuildWay (..), buildWayPrefix) where
@@ -34,7 +36,8 @@ import Distribution.Types.ParStrat
import Distribution.Types.TestSuite
import Distribution.Types.TestSuiteInterface
import Distribution.Utils.NubList
-import System.FilePath
+import Distribution.Utils.Path
+import System.FilePath ()
{-
Note [Building Haskell Modules accounting for TH]
@@ -96,7 +99,7 @@ buildHaskellModules
-- ^ The GHC configured program
-> PD.PackageDescription
-- ^ The package description
- -> FilePath
+ -> SymbolicPath Pkg ('Dir Artifacts)
-- ^ The path to the build directory for this target, which
-- has already been created.
-> Set.Set BuildWay
@@ -119,6 +122,7 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays pbci = d
bi = buildBI pbci
what = buildingWhat pbci
comp = buildCompiler pbci
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
-- If this component will be loaded into a repl, we don't compile the modules at all.
forRepl
@@ -133,13 +137,14 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays pbci = d
let isCoverageEnabled = if isLib then libCoverage lbi else exeCoverage lbi
hpcdir way
| forRepl = mempty -- HPC is not supported in ghci
- | isCoverageEnabled = Flag $ Hpc.mixDir (buildTargetDir </> extraCompilationArtifacts) way
+ | isCoverageEnabled = Flag $ Hpc.mixDir (coerceSymbolicPath $ coerceSymbolicPath buildTargetDir </> extraCompilationArtifacts) way
| otherwise = mempty
(inputFiles, inputModules) <- componentInputs buildTargetDir pkg_descr pbci
let
- runGhcProg = runGHC verbosity ghcProg comp platform
+ mbWorkDir = mbWorkDirLBI lbi
+ runGhcProg = runGHC verbosity ghcProg comp platform mbWorkDir
platform = hostPlatform lbi
-- See Note [Building Haskell Modules accounting for TH]
@@ -161,12 +166,12 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays pbci = d
, ghcOptInputFiles =
toNubListR $
if PD.package pkg_descr == fakePackageId
- then filter isHaskell inputFiles
+ then filter (isHaskell . getSymbolicPath) inputFiles
else inputFiles
, ghcOptInputScripts =
toNubListR $
if PD.package pkg_descr == fakePackageId
- then filter (not . isHaskell) inputFiles
+ then filter (not . isHaskell . getSymbolicPath) inputFiles
else []
, ghcOptExtra = buildWayExtraHcOptions way GHC bi
, ghcOptHiSuffix = optSuffixFlag (buildWayPrefix way) "hi"
@@ -257,7 +262,7 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays pbci = d
-- static and dynamically linked executables. We copy
-- the modules interfaces so they are available under
-- both ways.
- copyDirectoryRecursive verbosity dynDir vanillaDir
+ copyDirectoryRecursive verbosity (i dynDir) (i vanillaDir)
_ -> return ()
in
-- REVIEW:ADD? info verbosity "Building Haskell Sources..."
@@ -295,40 +300,39 @@ buildWayExtraHcOptions = \case
-- The "input files" are either the path to the main Haskell module, or a repl
-- script (that does not necessarily have an extension).
componentInputs
- :: FilePath
+ :: SymbolicPath Pkg (Dir Artifacts)
-- ^ Target build dir
-> PD.PackageDescription
-> PreBuildComponentInputs
-- ^ The context and component being built in it.
- -> IO ([FilePath], [ModuleName])
+ -> IO ([SymbolicPath Pkg File], [ModuleName])
-- ^ The Haskell input files, and the Haskell modules
-componentInputs buildTargetDir pkg_descr pbci = do
- let
- verbosity = buildVerbosity pbci
- component = buildComponent pbci
- clbi = buildCLBI pbci
-
+componentInputs buildTargetDir pkg_descr pbci =
case component of
CLib lib ->
pure ([], allLibModules lib clbi)
CFLib flib ->
pure ([], foreignLibModules flib)
CExe Executable{buildInfo = bi', modulePath} ->
- exeLikeInputs verbosity bi' modulePath
+ exeLikeInputs bi' modulePath
CTest TestSuite{testBuildInfo = bi', testInterface = TestSuiteExeV10 _ mainFile} ->
- exeLikeInputs verbosity bi' mainFile
+ exeLikeInputs bi' mainFile
CBench Benchmark{benchmarkBuildInfo = bi', benchmarkInterface = BenchmarkExeV10 _ mainFile} ->
- exeLikeInputs verbosity bi' mainFile
+ exeLikeInputs bi' mainFile
CTest TestSuite{} -> error "testSuiteExeV10AsExe: wrong kind"
CBench Benchmark{} -> error "benchmarkExeV10asExe: wrong kind"
where
- exeLikeInputs verbosity bnfo modulePath = liftIO $ do
- main <- findExecutableMain verbosity buildTargetDir (bnfo, modulePath)
+ verbosity = buildVerbosity pbci
+ component = buildComponent pbci
+ clbi = buildCLBI pbci
+ mbWorkDir = mbWorkDirLBI $ localBuildInfo pbci
+ exeLikeInputs bnfo modulePath = liftIO $ do
+ main <- findExecutableMain verbosity mbWorkDir buildTargetDir (bnfo, modulePath)
let mainModName = exeMainModuleName bnfo
otherModNames = otherModules bnfo
-- Scripts have fakePackageId and are always Haskell but can have any extension.
- if isHaskell main || PD.package pkg_descr == fakePackageId
+ if isHaskell (getSymbolicPath main) || PD.package pkg_descr == fakePackageId
then
if PD.specVersion pkg_descr < CabalSpecV2_0 && (mainModName `elem` otherModNames)
then do
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Utils.hs b/Cabal/src/Distribution/Simple/GHC/Build/Utils.hs
index e5161e343d..fb8bd21351 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build/Utils.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build/Utils.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RankNTypes #-}
+
module Distribution.Simple.GHC.Build.Utils where
import Distribution.Compat.Prelude
@@ -17,27 +20,28 @@ import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.LocalBuildInfo
-import Distribution.Utils.Path (getSymbolicPath)
+ ( LocalBuildInfo (hostPlatform)
+ )
+import Distribution.Utils.Path
import Distribution.Verbosity
import System.FilePath
( replaceExtension
, takeExtension
- , (<.>)
- , (</>)
)
-- | Find the path to the entry point of an executable (typically specified in
-- @main-is@, and found in @hs-source-dirs@).
findExecutableMain
:: Verbosity
- -> FilePath
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg (Dir build)
-- ^ Build directory
- -> (BuildInfo, FilePath)
+ -> (BuildInfo, RelativePath Source File)
-- ^ The build info and module path of an executable-like component (Exe, Test, Bench)
- -> IO FilePath
+ -> IO (SymbolicPath Pkg File)
-- ^ The path to the main source file.
-findExecutableMain verbosity bdir (bnfo, modPath) =
- findFileEx verbosity (bdir : map getSymbolicPath (hsSourceDirs bnfo)) modPath
+findExecutableMain verbosity mbWorkDir buildDir (bnfo, modPath) =
+ findFileCwd verbosity mbWorkDir (coerceSymbolicPath buildDir : hsSourceDirs bnfo) modPath
-- | Does this compiler support the @-dynamic-too@ option
supportsDynamicToo :: Compiler -> Bool
@@ -72,18 +76,31 @@ isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"]
-- | Returns True if the modification date of the given source file is newer than
-- the object file we last compiled for it, or if no object file exists yet.
-checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
-checkNeedsRecompilation filename opts = filename `moreRecentFile` oname
+checkNeedsRecompilation
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg File
+ -> GhcOptions
+ -> IO Bool
+checkNeedsRecompilation mbWorkDir filename opts =
+ i filename `moreRecentFile` oname
where
- oname = getObjectFileName filename opts
+ oname = getObjectFileName mbWorkDir filename opts
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
-- | Finds the object file name of the given source file
-getObjectFileName :: FilePath -> GhcOptions -> FilePath
-getObjectFileName filename opts = oname
+getObjectFileName
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg File
+ -> GhcOptions
+ -> FilePath
+getObjectFileName mbWorkDir filename opts = oname
where
- odir = fromFlag (ghcOptObjDir opts)
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
+ odir = i $ fromFlag (ghcOptObjDir opts)
oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts)
- oname = odir </> replaceExtension filename oext
+ -- NB: the filepath might be absolute, e.g. if it is the path to
+ -- an autogenerated .hs file.
+ oname = odir </> replaceExtension (getSymbolicPath filename) oext
-- | Target name for a foreign library (the actual file name)
--
diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs
index 43e329fa66..a4b75cdb6d 100644
--- a/Cabal/src/Distribution/Simple/GHC/Internal.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -79,7 +80,7 @@ import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Types.UnitId
-import Distribution.Utils.NubList (toNubListR)
+import Distribution.Utils.NubList (NubListR, toNubListR)
import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version (Version)
@@ -90,8 +91,6 @@ import System.FilePath
( takeDirectory
, takeExtension
, takeFileName
- , (<.>)
- , (</>)
)
import System.IO (hClose, hPutStrLn)
@@ -127,6 +126,7 @@ configureToolchain _implInfo ghcProg ghcInfo =
{ programFindLocation = findProg stripProgramName extraStripPath
}
where
+ compilerDir, base_dir, mingwBinDir :: FilePath
compilerDir = takeDirectory (programPath ghcProg)
base_dir = takeDirectory compilerDir
mingwBinDir = base_dir </> "mingw" </> "bin"
@@ -338,13 +338,33 @@ getExtensions verbosity implInfo ghcProg = do
else extensions0
return extensions1
+includePaths
+ :: LocalBuildInfo
+ -> BuildInfo
+ -> ComponentLocalBuildInfo
+ -> SymbolicPath Pkg p
+ -> NubListR (SymbolicPath Pkg (Dir Include))
+includePaths lbi bi clbi odir =
+ toNubListR $
+ [ coerceSymbolicPath $ autogenComponentModulesDir lbi clbi
+ , coerceSymbolicPath $ autogenPackageModulesDir lbi
+ , coerceSymbolicPath odir
+ ]
+ -- includes relative to the package
+ ++ includeDirs bi
+ -- potential includes generated by `configure'
+ -- in the build directory
+ ++ [ buildDir lbi </> dir
+ | dir <- mapMaybe (symbolicPathRelative_maybe . unsafeCoerceSymbolicPath) $ includeDirs bi
+ ]
+
componentCcGhcOptions
:: Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
+ -> SymbolicPath Pkg File
-> GhcOptions
componentCcGhcOptions verbosity lbi bi clbi odir filename =
mempty
@@ -353,17 +373,7 @@ componentCcGhcOptions verbosity lbi bi clbi odir filename =
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
, ghcOptInputFiles = toNubListR [filename]
- , ghcOptCppIncludePath =
- toNubListR $
- [ autogenComponentModulesDir lbi clbi
- , autogenPackageModulesDir lbi
- , odir
- ]
- -- includes relative to the package
- ++ includeDirs bi
- -- potential includes generated by `configure'
- -- in the build directory
- ++ [buildDir lbi </> dir | dir <- includeDirs bi]
+ , ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
, ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi
@@ -392,8 +402,8 @@ componentCxxGhcOptions
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
+ -> SymbolicPath Pkg File
-> GhcOptions
componentCxxGhcOptions verbosity lbi bi clbi odir filename =
mempty
@@ -402,17 +412,7 @@ componentCxxGhcOptions verbosity lbi bi clbi odir filename =
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
, ghcOptInputFiles = toNubListR [filename]
- , ghcOptCppIncludePath =
- toNubListR $
- [ autogenComponentModulesDir lbi clbi
- , autogenPackageModulesDir lbi
- , odir
- ]
- -- includes relative to the package
- ++ includeDirs bi
- -- potential includes generated by `configure'
- -- in the build directory
- ++ [buildDir lbi </> dir | dir <- includeDirs bi]
+ , ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
, ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi
@@ -441,8 +441,8 @@ componentAsmGhcOptions
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
+ -> SymbolicPath Pkg File
-> GhcOptions
componentAsmGhcOptions verbosity lbi bi clbi odir filename =
mempty
@@ -451,17 +451,7 @@ componentAsmGhcOptions verbosity lbi bi clbi odir filename =
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
, ghcOptInputFiles = toNubListR [filename]
- , ghcOptCppIncludePath =
- toNubListR $
- [ autogenComponentModulesDir lbi clbi
- , autogenPackageModulesDir lbi
- , odir
- ]
- -- includes relative to the package
- ++ includeDirs bi
- -- potential includes generated by `configure'
- -- in the build directory
- ++ [buildDir lbi </> dir | dir <- includeDirs bi]
+ , ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
, ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi
@@ -485,8 +475,8 @@ componentJsGhcOptions
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
+ -> SymbolicPath Pkg File
-> GhcOptions
componentJsGhcOptions verbosity lbi bi clbi odir filename =
mempty
@@ -495,17 +485,7 @@ componentJsGhcOptions verbosity lbi bi clbi odir filename =
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
, ghcOptInputFiles = toNubListR [filename]
- , ghcOptCppIncludePath =
- toNubListR $
- [ autogenComponentModulesDir lbi clbi
- , autogenPackageModulesDir lbi
- , odir
- ]
- -- includes relative to the package
- ++ includeDirs bi
- -- potential includes generated by `configure'
- -- in the build directory
- ++ [buildDir lbi </> dir | dir <- includeDirs bi]
+ , ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
, ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi
@@ -517,7 +497,7 @@ componentGhcOptions
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
+ -> SymbolicPath Pkg (Dir build)
-> GhcOptions
componentGhcOptions verbosity lbi bi clbi odir =
let implInfo = getImplInfo $ compiler lbi
@@ -561,35 +541,25 @@ componentGhcOptions verbosity lbi bi clbi odir =
, ghcOptSourcePathClear = toFlag True
, ghcOptSourcePath =
toNubListR $
- map getSymbolicPath (hsSourceDirs bi)
- ++ [odir]
+ (hsSourceDirs bi)
+ ++ [coerceSymbolicPath odir]
++ [autogenComponentModulesDir lbi clbi]
++ [autogenPackageModulesDir lbi]
- , ghcOptCppIncludePath =
- toNubListR $
- [ autogenComponentModulesDir lbi clbi
- , autogenPackageModulesDir lbi
- , odir
- ]
- -- includes relative to the package
- ++ includeDirs bi
- -- potential includes generated by `configure'
- -- in the build directory
- ++ [buildDir lbi </> dir | dir <- includeDirs bi]
+ , ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptCppOptions = cppOptions bi
, ghcOptCppIncludes =
toNubListR $
- [autogenComponentModulesDir lbi clbi </> cppHeaderName]
- , ghcOptFfiIncludes = toNubListR $ includes bi
- , ghcOptObjDir = toFlag odir
- , ghcOptHiDir = toFlag odir
- , ghcOptHieDir = bool NoFlag (toFlag $ odir </> extraCompilationArtifacts </> "hie") $ flagHie implInfo
- , ghcOptStubDir = toFlag odir
- , ghcOptOutputDir = toFlag odir
+ [coerceSymbolicPath (autogenComponentModulesDir lbi clbi </> makeRelativePathEx cppHeaderName)]
+ , ghcOptFfiIncludes = toNubListR $ map getSymbolicPath $ includes bi
+ , ghcOptObjDir = toFlag $ coerceSymbolicPath odir
+ , ghcOptHiDir = toFlag $ coerceSymbolicPath odir
+ , ghcOptHieDir = bool NoFlag (toFlag $ coerceSymbolicPath odir </> (extraCompilationArtifacts </> makeRelativePathEx "hie")) $ flagHie implInfo
+ , ghcOptStubDir = toFlag $ coerceSymbolicPath odir
+ , ghcOptOutputDir = toFlag $ coerceSymbolicPath odir
, ghcOptOptimisation = toGhcOptimisation (withOptimization lbi)
, ghcOptDebugInfo = toFlag (withDebugInfo lbi)
, ghcOptExtra = hcOptions GHC bi
- , ghcOptExtraPath = toNubListR $ exe_paths
+ , ghcOptExtraPath = toNubListR exe_paths
, ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi))
, -- Unsupported extensions have already been checked by configure
ghcOptExtensions = toNubListR $ usedExtensions bi
@@ -613,8 +583,8 @@ componentCmmGhcOptions
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
+ -> SymbolicPath Pkg File
-> GhcOptions
componentCmmGhcOptions verbosity lbi bi clbi odir filename =
mempty
@@ -623,21 +593,11 @@ componentCmmGhcOptions verbosity lbi bi clbi odir filename =
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
, ghcOptInputFiles = toNubListR [filename]
- , ghcOptCppIncludePath =
- toNubListR $
- [ autogenComponentModulesDir lbi clbi
- , autogenPackageModulesDir lbi
- , odir
- ]
- -- includes relative to the package
- ++ includeDirs bi
- -- potential includes generated by `configure'
- -- in the build directory
- ++ [buildDir lbi </> dir | dir <- includeDirs bi]
+ , ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptCppOptions = cppOptions bi
, ghcOptCppIncludes =
toNubListR $
- [autogenComponentModulesDir lbi clbi </> cppHeaderName]
+ [autogenComponentModulesDir lbi clbi </> makeRelativePathEx cppHeaderName]
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
, ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi
@@ -679,20 +639,20 @@ getHaskellObjects
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
-> String
-> Bool
- -> IO [FilePath]
+ -> IO [SymbolicPath Pkg File]
getHaskellObjects _implInfo lib lbi clbi pref wanted_obj_ext allow_split_objs
| splitObjs lbi && allow_split_objs = do
let splitSuffix = "_" ++ wanted_obj_ext ++ "_split"
dirs =
- [ pref </> (ModuleName.toFilePath x ++ splitSuffix)
+ [ pref </> makeRelativePathEx (ModuleName.toFilePath x ++ splitSuffix)
| x <- allLibModules lib clbi
]
- objss <- traverse getDirectoryContents dirs
+ objss <- traverse (getDirectoryContents . i) dirs
let objs =
- [ dir </> obj
+ [ dir </> makeRelativePathEx obj
| (objs', dir) <- zip objss dirs
, obj <- objs'
, let obj_ext = takeExtension obj
@@ -701,9 +661,11 @@ getHaskellObjects _implInfo lib lbi clbi pref wanted_obj_ext allow_split_objs
return objs
| otherwise =
return
- [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext
+ [ pref </> makeRelativePathEx (ModuleName.toFilePath x <.> wanted_obj_ext)
| x <- allLibModules lib clbi
]
+ where
+ i = interpretSymbolicPathLBI lbi
-- | Create the required packaged arguments, but filtering out package arguments which
-- aren't yet built, but promised. This filtering is used when compiling C/Cxx/Asm files,
diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs
index 4e14bc04d5..973230ee3c 100644
--- a/Cabal/src/Distribution/Simple/GHCJS.hs
+++ b/Cabal/src/Distribution/Simple/GHCJS.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
@@ -84,6 +85,7 @@ import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity)
import Distribution.Version
+import Control.Arrow ((***))
import Control.Monad (msum)
import Data.Char (isLower)
import qualified Data.Map as Map
@@ -100,8 +102,6 @@ import System.FilePath
, replaceExtension
, takeDirectory
, takeExtension
- , (<.>)
- , (</>)
)
import qualified System.Info
@@ -313,23 +313,25 @@ getGhcInfo verbosity ghcjsProg = Internal.getGhcInfo verbosity implInfo ghcjsPro
-- | Given a single package DB, return all installed packages.
getPackageDBContents
:: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDB
-> ProgramDb
-> IO InstalledPackageIndex
-getPackageDBContents verbosity packagedb progdb = do
- pkgss <- getInstalledPackages' verbosity [packagedb] progdb
+getPackageDBContents verbosity mbWorkDir packagedb progdb = do
+ pkgss <- getInstalledPackages' verbosity mbWorkDir [packagedb] progdb
toPackageIndex verbosity pkgss progdb
-- | Given a package DB stack, return all installed packages.
getInstalledPackages
:: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
-getInstalledPackages verbosity packagedbs progdb = do
+getInstalledPackages verbosity mbWorkDir packagedbs progdb = do
checkPackageDbEnvVar verbosity
checkPackageDbStack verbosity packagedbs
- pkgss <- getInstalledPackages' verbosity packagedbs progdb
+ pkgss <- getInstalledPackages' verbosity mbWorkDir packagedbs progdb
index <- toPackageIndex verbosity pkgss progdb
return $! index
@@ -402,13 +404,14 @@ checkPackageDbStack verbosity _ =
getInstalledPackages'
:: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
-getInstalledPackages' verbosity packagedbs progdb =
+getInstalledPackages' verbosity mbWorkDir packagedbs progdb =
sequenceA
[ do
- pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb
+ pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity mbWorkDir packagedb
return (packagedb, pkgs)
| packagedb <- packagedbs
]
@@ -417,10 +420,11 @@ getInstalledPackages' verbosity packagedbs progdb =
getInstalledPackagesMonitorFiles
:: Verbosity
-> Platform
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> ProgramDb
-> [PackageDB]
-> IO [FilePath]
-getInstalledPackagesMonitorFiles verbosity platform progdb =
+getInstalledPackagesMonitorFiles verbosity platform mbWorkDir progdb =
traverse getPackageDBPath
where
getPackageDBPath :: PackageDB -> IO FilePath
@@ -434,7 +438,11 @@ getInstalledPackagesMonitorFiles verbosity platform progdb =
-- Note that for dir style dbs, we only need to monitor the cache file, not
-- the whole directory. The ghc program itself only reads the cache file
-- so it's safe to only monitor this one file.
- selectMonitorFile path = do
+ selectMonitorFile path0 = do
+ let path =
+ if isRelative path0
+ then interpretSymbolicPath mbWorkDir (makeRelativePathEx path0)
+ else path0
isFileStyle <- doesFileExist path
if isFileStyle
then return path
@@ -499,9 +507,15 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
implInfo = getImplInfo comp
platform@(Platform _hostArch _hostOS) = hostPlatform lbi
has_code = not (componentIsIndefinite clbi)
+ mbWorkDir = mbWorkDirLBI lbi
+
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ i = interpretSymbolicPathLBI lbi
+ u :: SymbolicPathX allowAbs Pkg to -> FilePath
+ u = getSymbolicPath
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
- let runGhcjsProg = runGHC verbosity ghcjsProg comp platform
+ let runGhcjsProg = runGHC verbosity ghcjsProg comp platform mbWorkDir
let libBi = libBuildInfo lib
@@ -518,15 +532,15 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
let isCoverageEnabled = libCoverage lbi
hpcdir way
| forRepl = mempty -- HPC is not supported in ghci
- | isCoverageEnabled = toFlag $ Hpc.mixDir (libTargetDir </> extraCompilationArtifacts) way
+ | isCoverageEnabled = toFlag $ Hpc.mixDir (coerceSymbolicPath libTargetDir </> coerceSymbolicPath extraCompilationArtifacts) way
| otherwise = mempty
- createDirectoryIfMissingVerbose verbosity True libTargetDir
+ createDirectoryIfMissingVerbose verbosity True $ i libTargetDir
-- TODO: do we need to put hs-boot files into place for mutually recursive
-- modules?
let cLikeFiles = fromNubListR $ toNubListR (cSources libBi) <> toNubListR (cxxSources libBi)
jsSrcs = jsSources libBi
- cObjs = map (`replaceExtension` objExtension) cLikeFiles
+ cObjs = map ((`replaceExtensionSymbolicPath` objExtension)) cLikeFiles
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
linkJsLibOpts =
mempty
@@ -534,9 +548,9 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
[ "-link-js-lib"
, getHSLibraryName uid
, "-js-lib-outputdir"
- , libTargetDir
+ , u libTargetDir
]
- ++ jsSrcs
+ ++ map u jsSrcs
}
vanillaOptsNoJsLib =
baseOpts
@@ -605,7 +619,7 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
-- static and dynamically linked executables. We copy
-- the modules interfaces so they are available under
-- both ways.
- copyDirectoryRecursive verbosity dynDir vanillaDir
+ copyDirectoryRecursive verbosity (i dynDir) (i vanillaDir)
_ -> return ()
else
if isGhcjsDynamic
@@ -690,11 +704,11 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
info verbosity "Linking..."
let cSharedObjs =
map
- (`replaceExtension` ("dyn_" ++ objExtension))
+ ((`replaceExtensionSymbolicPath` ("dyn_" ++ objExtension)))
(cSources libBi ++ cxxSources libBi)
compiler_id = compilerId (compiler lbi)
- sharedLibFilePath = libTargetDir </> mkSharedLibName (hostPlatform lbi) compiler_id uid
- staticLibFilePath = libTargetDir </> mkStaticLibName (hostPlatform lbi) compiler_id uid
+ sharedLibFilePath = libTargetDir </> makeRelativePathEx (mkSharedLibName (hostPlatform lbi) compiler_id uid)
+ staticLibFilePath = libTargetDir </> makeRelativePathEx (mkStaticLibName (hostPlatform lbi) compiler_id uid)
let stubObjs = []
stubSharedObjs = []
@@ -722,7 +736,7 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
lib
lbi
clbi
- libTargetDir
+ (coerceSymbolicPath libTargetDir)
objExtension
True
hSharedObjs <-
@@ -733,7 +747,7 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
lib
lbi
clbi
- libTargetDir
+ (coerceSymbolicPath libTargetDir)
("dyn_" ++ objExtension)
False
else return []
@@ -743,11 +757,11 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
let staticObjectFiles =
hObjs
- ++ map (libTargetDir </>) cObjs
+ ++ map (makeSymbolicPath . (getSymbolicPath libTargetDir </>) . getSymbolicPath) cObjs
++ stubObjs
dynamicObjectFiles =
hSharedObjs
- ++ map (libTargetDir </>) cSharedObjs
+ ++ map (makeSymbolicPath . (getSymbolicPath libTargetDir </>) . getSymbolicPath) cSharedObjs
++ stubSharedObjs
-- After the relocation lib is created we invoke ghc -shared
-- with the dependencies spelled out as -package arguments
@@ -789,7 +803,7 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
Internal.mkGhcOptPackages mempty clbi
, ghcOptLinkLibs = extraLibs libBi
, ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi
- , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi
+ , ghcOptLinkFrameworks = toNubListR $ map getSymbolicPath $ PD.frameworks libBi
, ghcOptLinkFrameworkDirs =
toNubListR $ PD.extraFrameworkDirs libBi
, ghcOptRPaths = rpaths
@@ -863,7 +877,7 @@ startInterpreter verbosity progdb comp platform packageDBs = do
}
checkPackageDbStack verbosity packageDBs
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram progdb
- runGHC verbosity ghcjsProg comp platform replOpts
+ runGHC verbosity ghcjsProg comp platform Nothing replOpts
-- -----------------------------------------------------------------------------
-- Building an executable or foreign library
@@ -1037,7 +1051,7 @@ gbuildNeedDynamic lbi bm =
ForeignLibTypeUnknown ->
cabalBug "unknown foreign lib type"
-gbuildModDefFiles :: GBuildMode -> [FilePath]
+gbuildModDefFiles :: GBuildMode -> [RelativePath Source File]
gbuildModDefFiles (GBuildExe _) = []
gbuildModDefFiles (GReplExe _ _) = []
gbuildModDefFiles (GBuildFLib flib) = foreignLibModDefFile flib
@@ -1103,21 +1117,22 @@ decodeMainIsArg arg
--
-- Used to correctly build and link sources.
data BuildSources = BuildSources
- { cSourcesFiles :: [FilePath]
- , cxxSourceFiles :: [FilePath]
- , inputSourceFiles :: [FilePath]
+ { cSourcesFiles :: [SymbolicPath Pkg File]
+ , cxxSourceFiles :: [SymbolicPath Pkg File]
+ , inputSourceFiles :: [SymbolicPath Pkg File]
, inputSourceModules :: [ModuleName]
}
-- | Locate and return the 'BuildSources' required to build and link.
gbuildSources
:: Verbosity
+ -> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageId
-> CabalSpecVersion
- -> FilePath
+ -> SymbolicPath Pkg (Dir Source)
-> GBuildMode
-> IO BuildSources
-gbuildSources verbosity pkgId specVer tmpDir bm =
+gbuildSources verbosity mbWorkDir pkgId specVer tmpDir bm =
case bm of
GBuildExe exe -> exeSources exe
GReplExe _ exe -> exeSources exe
@@ -1126,12 +1141,13 @@ gbuildSources verbosity pkgId specVer tmpDir bm =
where
exeSources :: Executable -> IO BuildSources
exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do
- main <- findFileEx verbosity (tmpDir : map getSymbolicPath (hsSourceDirs bnfo)) modPath
+ main <- findFileCwd verbosity mbWorkDir (tmpDir : hsSourceDirs bnfo) modPath
let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe
otherModNames = exeModules exe
+ haskellMain = isHaskell (getSymbolicPath main)
-- Scripts have fakePackageId and are always Haskell but can have any extension.
- if isHaskell main || pkgId == fakePackageId
+ if haskellMain || pkgId == fakePackageId
then
if specVer < CabalSpecV2_0 && (mainModName `elem` otherModNames)
then do
@@ -1168,7 +1184,7 @@ gbuildSources verbosity pkgId specVer tmpDir bm =
}
else
let (csf, cxxsf)
- | isCxx main = (cSources bnfo, main : cxxSources bnfo)
+ | isCxx (getSymbolicPath main) = (cSources bnfo, main : cxxSources bnfo)
-- if main is not a Haskell source
-- and main is not a C++ source
-- then we assume that it is a C source
@@ -1215,7 +1231,8 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
GBuildFLib{} -> mempty
comp = compiler lbi
platform = hostPlatform lbi
- runGhcProg = runGHC verbosity ghcjsProg comp platform
+ mbWorkDir = mbWorkDirLBI lbi
+ runGhcProg = runGHC verbosity ghcjsProg comp platform mbWorkDir
let (bnfo, threaded) = case bm of
GBuildFLib _ -> popThreadedFlag (gbuildInfo bm)
@@ -1223,10 +1240,14 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
-- the name that GHC really uses (e.g., with .exe on Windows for executables)
let targetName = gbuildTargetName lbi bm
- let targetDir = buildDir lbi </> (gbuildName bm)
- let tmpDir = targetDir </> (gbuildName bm ++ "-tmp")
- createDirectoryIfMissingVerbose verbosity True targetDir
- createDirectoryIfMissingVerbose verbosity True tmpDir
+ targetDir = buildDir lbi </> makeRelativePathEx (gbuildName bm)
+ tmpDir = targetDir </> makeRelativePathEx (gbuildName bm ++ "-tmp")
+
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ i = interpretSymbolicPath mbWorkDir
+
+ createDirectoryIfMissingVerbose verbosity True $ i targetDir
+ createDirectoryIfMissingVerbose verbosity True $ i tmpDir
-- TODO: do we need to put hs-boot files into place for mutually recursive
-- modules? FIX: what about exeName.hi-boot?
@@ -1236,11 +1257,11 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
let isCoverageEnabled = exeCoverage lbi
hpcdir way
| gbuildIsRepl bm = mempty -- HPC is not supported in ghci
- | isCoverageEnabled = toFlag $ Hpc.mixDir (tmpDir </> extraCompilationArtifacts) way
+ | isCoverageEnabled = toFlag $ Hpc.mixDir (tmpDir </> coerceSymbolicPath extraCompilationArtifacts) way
| otherwise = mempty
rpaths <- getRPaths lbi clbi
- buildSources <- gbuildSources verbosity (package pkg_descr) (specVersion pkg_descr) tmpDir bm
+ buildSources <- gbuildSources verbosity mbWorkDir (package pkg_descr) (specVersion pkg_descr) tmpDir bm
let cSrcs = cSourcesFiles buildSources
cxxSrcs = cxxSourceFiles buildSources
@@ -1248,8 +1269,8 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
inputModules = inputSourceModules buildSources
isGhcDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
- cObjs = map (`replaceExtension` objExtension) cSrcs
- cxxObjs = map (`replaceExtension` objExtension) cxxSrcs
+ cObjs = map ((`replaceExtensionSymbolicPath` objExtension)) cSrcs
+ cxxObjs = map ((`replaceExtensionSymbolicPath` objExtension)) cxxSrcs
needDynamic = gbuildNeedDynamic lbi bm
needProfiling = withProfExe lbi
@@ -1267,12 +1288,12 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
, ghcOptInputFiles =
toNubListR $
if package pkg_descr == fakePackageId
- then filter isHaskell inputFiles
+ then filter (isHaskell . getSymbolicPath) inputFiles
else inputFiles
, ghcOptInputScripts =
toNubListR $
if package pkg_descr == fakePackageId
- then filter (not . isHaskell) inputFiles
+ then filter (not . isHaskell . getSymbolicPath) inputFiles
else []
, ghcOptInputModules = toNubListR inputModules
, -- for all executable components (exe/test/bench),
@@ -1327,13 +1348,14 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
, ghcOptLinkLibPath = toNubListR $ extraLibDirs bnfo
, ghcOptLinkFrameworks =
toNubListR $
- PD.frameworks bnfo
+ map getSymbolicPath $
+ PD.frameworks bnfo
, ghcOptLinkFrameworkDirs =
toNubListR $
PD.extraFrameworkDirs bnfo
, ghcOptInputFiles =
toNubListR
- [tmpDir </> x | x <- cObjs ++ cxxObjs]
+ [makeSymbolicPath $ getSymbolicPath tmpDir </> getSymbolicPath x | x <- cObjs ++ cxxObjs]
}
dynLinkerOpts =
mempty
@@ -1449,8 +1471,8 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
-- consider this a user error. However, we should strive to
-- add a warning if this occurs.
odir = fromFlag (ghcOptObjDir opts)
- createDirectoryIfMissingVerbose verbosity True odir
- needsRecomp <- checkNeedsRecompilation filename opts
+ createDirectoryIfMissingVerbose verbosity True (i odir)
+ needsRecomp <- checkNeedsRecompilation mbWorkDir filename opts
when needsRecomp $
runGhcProg opts
| filename <- cxxSrcs
@@ -1491,8 +1513,8 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
| needDynamic = sharedCcOpts
| otherwise = vanillaCcOpts
odir = fromFlag (ghcOptObjDir opts)
- createDirectoryIfMissingVerbose verbosity True odir
- needsRecomp <- checkNeedsRecompilation filename opts
+ createDirectoryIfMissingVerbose verbosity True (i odir)
+ needsRecomp <- checkNeedsRecompilation mbWorkDir filename opts
when needsRecomp $
runGhcProg opts
| filename <- cSrcs
@@ -1516,10 +1538,11 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
info verbosity "Linking..."
-- Work around old GHCs not relinking in this
-- situation, see #3294
- let target = targetDir </> targetName
+ let target = targetDir </> makeRelativePathEx targetName
when (compilerVersion comp < mkVersion [7, 7]) $ do
- e <- doesFileExist target
- when e (removeFile target)
+ let targetPath = i target
+ e <- doesFileExist targetPath
+ when e (removeFile targetPath)
runGhcProg linkOpts{ghcOptOutputFile = toFlag target}
GBuildFLib flib -> do
let rtsInfo = extractRtsInfo lbi
@@ -1543,9 +1566,9 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
{ ghcOptLinkNoHsMain = toFlag True
, ghcOptShared = toFlag True
, ghcOptLinkLibs = rtsOptLinkLibs
- , ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo
+ , ghcOptLinkLibPath = toNubListR $ map makeSymbolicPath $ rtsLibPaths rtsInfo
, ghcOptFPic = toFlag True
- , ghcOptLinkModDefFiles = toNubListR $ gbuildModDefFiles bm
+ , ghcOptLinkModDefFiles = toNubListR $ fmap getSymbolicPath $ gbuildModDefFiles bm
}
ForeignLibNativeStatic ->
-- this should be caught by buildFLib
@@ -1559,8 +1582,9 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
-- @flibBuildName@.
info verbosity "Linking..."
let buildName = flibBuildName lbi flib
- runGhcProg linkOpts{ghcOptOutputFile = toFlag (targetDir </> buildName)}
- renameFile (targetDir </> buildName) (targetDir </> targetName)
+ buildFile = targetDir </> makeRelativePathEx buildName
+ runGhcProg linkOpts{ghcOptOutputFile = toFlag buildFile}
+ renameFile (i buildFile) (i targetDir </> targetName)
data DynamicRtsInfo = DynamicRtsInfo
{ dynRtsVanillaLib :: FilePath
@@ -1629,18 +1653,31 @@ extractRtsInfo lbi =
-- | Returns True if the modification date of the given source file is newer than
-- the object file we last compiled for it, or if no object file exists yet.
-checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
-checkNeedsRecompilation filename opts = filename `moreRecentFile` oname
+checkNeedsRecompilation
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg File
+ -> GhcOptions
+ -> IO Bool
+checkNeedsRecompilation mbWorkDir filename opts =
+ i filename `moreRecentFile` oname
where
- oname = getObjectFileName filename opts
+ oname = getObjectFileName mbWorkDir filename opts
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
-- | Finds the object file name of the given source file
-getObjectFileName :: FilePath -> GhcOptions -> FilePath
-getObjectFileName filename opts = oname
+getObjectFileName
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg File
+ -> GhcOptions
+ -> FilePath
+getObjectFileName mbWorkDir filename opts = oname
where
- odir = fromFlag (ghcOptObjDir opts)
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
+ odir = i $ fromFlag (ghcOptObjDir opts)
oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts)
- oname = odir </> replaceExtension filename oext
+ -- NB: the filepath might be absolute, e.g. if it is the path to
+ -- an autogenerated .hs file.
+ oname = odir </> replaceExtension (getSymbolicPath filename) oext
-- | Calculate the RPATHs for the component we are building.
--
@@ -1730,6 +1767,7 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
libBi = libBuildInfo lib
comp = compiler lbi
platform = hostPlatform lbi
+ mbWorkDir = mbWorkDirLBI lbi
vanillaArgs =
(componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
`mappend` mempty
@@ -1767,7 +1805,7 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
hash <-
getProgramInvocationOutput
verbosity
- =<< ghcInvocation verbosity ghcjsProg comp platform ghcArgs
+ =<< ghcInvocation verbosity ghcjsProg comp platform mbWorkDir ghcArgs
return (takeWhile (not . isSpace) hash)
componentGhcOptions
@@ -1775,7 +1813,7 @@ componentGhcOptions
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
+ -> SymbolicPath Pkg (Dir build)
-> GhcOptions
componentGhcOptions verbosity lbi bi clbi odir =
let opts = Internal.componentGhcOptions verbosity lbi bi clbi odir
@@ -1891,10 +1929,12 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir _pkg lib clbi = do
, f <- "" : extraDynLibFlavours (libBuildInfo lib)
]
where
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
builtDir' = componentBuildDir lbi clbi
+ mbWorkDir = mbWorkDirLBI lbi
install isShared isJS srcDir dstDir name = do
- let src = srcDir </> name
+ let src = i $ srcDir </> makeRelativePathEx name
dst = dstDir </> name
createDirectoryIfMissingVerbose verbosity True dstDir
@@ -1912,9 +1952,10 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir _pkg lib clbi = do
installOrdinary = install False True
installShared = install True True
- copyModuleFiles ext =
- findModuleFilesEx verbosity [builtDir'] [ext] (allLibModules lib clbi)
- >>= installOrdinaryFiles verbosity targetDir
+ copyModuleFiles ext = do
+ files <- findModuleFilesCwd verbosity mbWorkDir [builtDir'] [ext] (allLibModules lib clbi)
+ let files' = map (i *** getSymbolicPath) files
+ installOrdinaryFiles verbosity targetDir files'
compiler_id = compilerId (compiler lbi)
platform = hostPlatform lbi
@@ -1985,14 +2026,16 @@ hcPkgInfo progdb =
registerPackage
:: Verbosity
-> ProgramDb
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
-registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
+registerPackage verbosity progdb mbWorkDir packageDbs installedPkgInfo registerOptions =
HcPkg.register
(hcPkgInfo progdb)
verbosity
+ mbWorkDir
packageDbs
installedPkgInfo
registerOptions
@@ -2020,7 +2063,10 @@ pkgRoot verbosity lbi = pkgRoot'
-- fail.
createDirectoryIfMissing True rootDir
return rootDir
- pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp)
+ pkgRoot' (SpecificPackageDB fp) =
+ return $
+ takeDirectory $
+ interpretSymbolicPathLBI lbi (unsafeMakeSymbolicPath fp)
-- | Get the JavaScript file name and command and arguments to run a
-- program compiled by GHCJS
diff --git a/Cabal/src/Distribution/Simple/Glob.hs b/Cabal/src/Distribution/Simple/Glob.hs
index 9ce97d7555..17ee7a76bc 100644
--- a/Cabal/src/Distribution/Simple/Glob.hs
+++ b/Cabal/src/Distribution/Simple/Glob.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
-----------------------------------------------------------------------------
@@ -45,6 +47,7 @@ import Distribution.Simple.Errors
)
import Distribution.Simple.Glob.Internal
import Distribution.Simple.Utils (dieWithException, warn)
+import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity)
-------------------------------------------------------------------------------
@@ -75,7 +78,12 @@ globMatches input = [a | GlobMatch a <- input]
-- prefix.
--
-- The second 'FilePath' is the glob itself.
-matchDirFileGlob :: Verbosity -> CabalSpecVersion -> FilePath -> FilePath -> IO [FilePath]
+matchDirFileGlob
+ :: Verbosity
+ -> CabalSpecVersion
+ -> Maybe (SymbolicPath CWD (Dir dir))
+ -> SymbolicPathX allowAbs dir file
+ -> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlob v = matchDirFileGlobWithDie v dieWithException
-- | Like 'matchDirFileGlob' but with customizable 'die'
@@ -83,45 +91,48 @@ matchDirFileGlob v = matchDirFileGlobWithDie v dieWithException
-- @since 3.6.0.0
matchDirFileGlobWithDie
:: Verbosity
- -> (Verbosity -> CabalException -> IO [FilePath])
+ -> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
- -> FilePath
- -> FilePath
- -> IO [FilePath]
-matchDirFileGlobWithDie verbosity rip version dir filepath = case parseFileGlob version filepath of
- Left err -> rip verbosity $ MatchDirFileGlob (explainGlobSyntaxError filepath err)
- Right glob -> do
- results <- runDirFileGlob verbosity (Just version) dir glob
- let missingDirectories =
- [missingDir | GlobMissingDirectory missingDir <- results]
- matches = globMatches results
- directoryMatches = [a | GlobMatchesDirectory a <- results]
-
- let errors :: [String]
- errors =
- [ "filepath wildcard '"
- ++ filepath
- ++ "' refers to the directory"
- ++ " '"
- ++ missingDir
- ++ "', which does not exist or is not a directory."
- | missingDir <- missingDirectories
- ]
- ++ [ "filepath wildcard '" ++ filepath ++ "' does not match any files."
- | null matches && null directoryMatches
- -- we don't error out on directory matches, simply warn about them and ignore.
- ]
-
- warns :: [String]
- warns =
- [ "Ignoring directory '" ++ path ++ "'" ++ " listed in a Cabal package field which should only include files (not directories)."
- | path <- directoryMatches
- ]
-
- if null errors
- then do
- unless (null warns) $
- warn verbosity $
- unlines warns
- return matches
- else rip verbosity $ MatchDirFileGlobErrors errors
+ -> Maybe (SymbolicPath CWD (Dir dir))
+ -> SymbolicPathX allowAbs dir file
+ -> IO [SymbolicPathX allowAbs dir file]
+matchDirFileGlobWithDie verbosity rip version mbWorkDir symPath =
+ let rawFilePath = getSymbolicPath symPath
+ dir = maybe "." getSymbolicPath mbWorkDir
+ in case parseFileGlob version rawFilePath of
+ Left err -> rip verbosity $ MatchDirFileGlob (explainGlobSyntaxError rawFilePath err)
+ Right glob -> do
+ results <- runDirFileGlob verbosity (Just version) dir glob
+ let missingDirectories =
+ [missingDir | GlobMissingDirectory missingDir <- results]
+ matches = globMatches results
+ directoryMatches = [a | GlobMatchesDirectory a <- results]
+
+ let errors :: [String]
+ errors =
+ [ "filepath wildcard '"
+ ++ rawFilePath
+ ++ "' refers to the directory"
+ ++ " '"
+ ++ missingDir
+ ++ "', which does not exist or is not a directory."
+ | missingDir <- missingDirectories
+ ]
+ ++ [ "filepath wildcard '" ++ rawFilePath ++ "' does not match any files."
+ | null matches && null directoryMatches
+ -- we don't error out on directory matches, simply warn about them and ignore.
+ ]
+
+ warns :: [String]
+ warns =
+ [ "Ignoring directory '" ++ path ++ "'" ++ " listed in a Cabal package field which should only include files (not directories)."
+ | path <- directoryMatches
+ ]
+
+ if null errors
+ then do
+ unless (null warns) $
+ warn verbosity $
+ unlines warns
+ return $ map unsafeMakeSymbolicPath matches
+ else rip verbosity $ MatchDirFileGlobErrors errors
diff --git a/Cabal/src/Distribution/Simple/Haddock.hs b/Cabal/src/Distribution/Simple/Haddock.hs
index 33d497231a..a63b9195b6 100644
--- a/Cabal/src/Distribution/Simple/Haddock.hs
+++ b/Cabal/src/Distribution/Simple/Haddock.hs
@@ -1,7 +1,10 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
-----------------------------------------------------------------------------
@@ -37,6 +40,7 @@ import qualified Distribution.Simple.GHCJS as GHCJS
import Distribution.Backpack (OpenModule)
import Distribution.Backpack.DescribeUnitId
+import Distribution.Compat.Semigroup (All (..), Any (..))
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import qualified Distribution.ModuleName as ModuleName
@@ -48,6 +52,7 @@ import Distribution.Simple.Build
import Distribution.Simple.BuildPaths
import Distribution.Simple.BuildTarget
import Distribution.Simple.Compiler
+import Distribution.Simple.Errors
import Distribution.Simple.Flag
import Distribution.Simple.Glob (matchDirFileGlob)
import Distribution.Simple.InstallDirs
@@ -59,6 +64,7 @@ import Distribution.Simple.Program.GHC
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import Distribution.Simple.Program.ResponseFile
import Distribution.Simple.Register
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Haddock
import Distribution.Simple.Setup.Hscolour
import Distribution.Simple.Utils
@@ -68,20 +74,20 @@ import Distribution.Types.ExposedModule
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Utils.NubList
+import Distribution.Utils.Path hiding
+ ( Dir
+ )
+import qualified Distribution.Utils.Path as Path
import qualified Distribution.Utils.ShortText as ShortText
+import Distribution.Verbosity
import Distribution.Version
-import Distribution.Verbosity
import Language.Haskell.Extension
-import Distribution.Compat.Semigroup (All (..), Any (..))
-
import Control.Monad
import Data.Either (rights)
-
-import Distribution.Simple.Errors
-import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory)
-import System.FilePath (isAbsolute, normalise, (<.>), (</>))
+import System.Directory (doesDirectoryExist, doesFileExist)
+import System.FilePath (isAbsolute, normalise)
import System.IO (hClose, hPutStrLn, hSetEncoding, utf8)
-- ------------------------------------------------------------------------------
@@ -145,8 +151,10 @@ data HaddockArgs = HaddockArgs
-- | The FilePath of a directory, it's a monoid under '(</>)'.
newtype Directory = Dir {unDir' :: FilePath} deriving (Read, Show, Eq, Ord)
-unDir :: Directory -> FilePath
-unDir = normalise . unDir'
+-- NB: only correct at the top-level, after we have combined monoidally
+-- the top-level output directory with the component subdir.
+unDir :: Directory -> SymbolicPath Pkg (Path.Dir Artifacts)
+unDir = makeSymbolicPath . normalise . unDir'
type Template = String
@@ -216,12 +224,13 @@ haddock pkg_descr _ _ haddockFlags
&& not (fromFlag $ haddockTestSuites haddockFlags)
&& not (fromFlag $ haddockBenchmarks haddockFlags)
&& not (fromFlag $ haddockForeignLibs haddockFlags) =
- warn (fromFlag $ haddockVerbosity haddockFlags) $
+ warn (fromFlag $ setupVerbosity $ haddockCommonFlags haddockFlags) $
"No documentation was generated as this package does not contain "
++ "a library. Perhaps you want to use the --executables, --tests,"
++ " --benchmarks or --foreign-libraries flags."
haddock pkg_descr lbi suffixes flags' = do
- let verbosity = flag haddockVerbosity
+ let verbosity = fromFlag $ haddockVerbosity flags
+ mbWorkDir = flagToMaybe $ haddockWorkingDir flags
comp = compiler lbi
platform = hostPlatform lbi
@@ -279,7 +288,7 @@ haddock pkg_descr lbi suffixes flags' = do
suffixes
(defaultHscolourFlags `mappend` haddockToHscolour flags)
- targets <- readTargetInfos verbosity pkg_descr lbi (haddockArgs flags)
+ targets <- readTargetInfos verbosity pkg_descr lbi (haddockTargets flags)
let
targets' =
@@ -288,7 +297,7 @@ haddock pkg_descr lbi suffixes flags' = do
_ -> targets
internalPackageDB <-
- createInternalPackageDB verbosity lbi (flag haddockDistPref)
+ createInternalPackageDB verbosity lbi (flag $ setupDistPref . haddockCommonFlags)
(\f -> foldM_ f (installedPkgs lbi) targets') $ \index target -> do
let component = targetComponent target
@@ -307,7 +316,7 @@ haddock pkg_descr lbi suffixes flags' = do
let
doExe com = case (compToExe com) of
Just exe -> do
- withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi') "tmp" $
+ withTempDirectoryCwdEx verbosity tmpFileOpts mbWorkDir (buildDir lbi') "tmp" $
\tmp -> do
exeArgs <-
fromExecutable
@@ -321,6 +330,7 @@ haddock pkg_descr lbi suffixes flags' = do
let exeArgs' = commonArgs `mappend` exeArgs
runHaddock
verbosity
+ mbWorkDir
tmpFileOpts
comp
platform
@@ -329,9 +339,8 @@ haddock pkg_descr lbi suffixes flags' = do
exeArgs'
Nothing -> do
warn
- (fromFlag $ haddockVerbosity flags)
+ verbosity
"Unsupported component, skipping..."
- return ()
-- We define 'smsg' once and then reuse it inside the case, so that
-- we don't say we are running Haddock when we actually aren't
-- (e.g., Haddock is not run on non-libraries)
@@ -345,7 +354,7 @@ haddock pkg_descr lbi suffixes flags' = do
(maybeComponentInstantiatedWith clbi)
case component of
CLib lib -> do
- withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $
+ withTempDirectoryCwdEx verbosity tmpFileOpts mbWorkDir (buildDir lbi) "tmp" $
\tmp -> do
smsg
libArgs <-
@@ -358,15 +367,13 @@ haddock pkg_descr lbi suffixes flags' = do
version
lib
let libArgs' = commonArgs `mappend` libArgs
- runHaddock verbosity tmpFileOpts comp platform haddockProg True libArgs'
-
- pwd <- getCurrentDirectory
-
+ runHaddock verbosity mbWorkDir tmpFileOpts comp platform haddockProg True libArgs'
+ inplaceDir <- absoluteWorkingDirLBI lbi
let
ipi =
inplaceInstalledPackageInfo
- pwd
- (flag haddockDistPref)
+ inplaceDir
+ (flag $ setupDistPref . haddockCommonFlags)
pkg_descr
(mkAbiHash "inplace")
lib
@@ -381,6 +388,7 @@ haddock pkg_descr lbi suffixes flags' = do
verbosity
(compiler lbi')
(withPrograms lbi')
+ mbWorkDir
(withPackageDB lbi')
ipi
HcPkg.defaultRegisterOptions
@@ -392,7 +400,7 @@ haddock pkg_descr lbi suffixes flags' = do
when
(flag haddockForeignLibs)
( do
- withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi') "tmp" $
+ withTempDirectoryCwdEx verbosity tmpFileOpts mbWorkDir (buildDir lbi') "tmp" $
\tmp -> do
smsg
flibArgs <-
@@ -405,7 +413,7 @@ haddock pkg_descr lbi suffixes flags' = do
version
flib
let libArgs' = commonArgs `mappend` flibArgs
- runHaddock verbosity tmpFileOpts comp platform haddockProg True libArgs'
+ runHaddock verbosity mbWorkDir tmpFileOpts comp platform haddockProg True libArgs'
)
>> return index
CExe _ -> when (flag haddockExecutables) (smsg >> doExe component) >> return index
@@ -413,8 +421,9 @@ haddock pkg_descr lbi suffixes flags' = do
CBench _ -> when (flag haddockBenchmarks) (smsg >> doExe component) >> return index
for_ (extraDocFiles pkg_descr) $ \fpath -> do
- files <- matchDirFileGlob verbosity (specVersion pkg_descr) "." fpath
- for_ files $ copyFileTo verbosity (unDir $ argOutputDir commonArgs)
+ files <- matchDirFileGlob verbosity (specVersion pkg_descr) mbWorkDir fpath
+ for_ files $
+ copyFileToCwd verbosity mbWorkDir (unDir $ argOutputDir commonArgs)
-- | Execute 'Haddock' configured with 'HaddocksFlags'. It is used to build
-- index and contents for documentation of multiple packages.
@@ -423,13 +432,14 @@ createHaddockIndex
-> ProgramDb
-> Compiler
-> Platform
+ -> Maybe (SymbolicPath CWD (Path.Dir Pkg))
-> HaddockProjectFlags
-> IO ()
-createHaddockIndex verbosity programDb comp platform flags = do
+createHaddockIndex verbosity programDb comp platform mbWorkDir flags = do
let args = fromHaddockProjectFlags flags
(haddockProg, _version) <-
getHaddockProg verbosity programDb comp args (Flag True)
- runHaddock verbosity defaultTempFileOptions comp platform haddockProg False args
+ runHaddock verbosity mbWorkDir defaultTempFileOptions comp platform haddockProg False args
-- ------------------------------------------------------------------------------
-- Contributions to HaddockArgs (see also Doctest.hs for very similar code).
@@ -469,17 +479,18 @@ fromFlags env flags =
, argVerbose =
maybe mempty (Any . (>= deafening))
. flagToMaybe
- $ haddockVerbosity flags
+ $ setupVerbosity commonFlags
, argOutput =
Flag $ case [Html | Flag True <- [haddockHtml flags]]
++ [Hoogle | Flag True <- [haddockHoogle flags]] of
[] -> [Html]
os -> os
- , argOutputDir = maybe mempty Dir . flagToMaybe $ haddockDistPref flags
+ , argOutputDir = maybe mempty (Dir . getSymbolicPath) . flagToMaybe $ setupDistPref commonFlags
, argGhcOptions = mempty{ghcOptExtra = ghcArgs}
}
where
ghcArgs = fromMaybe [] . lookup "ghc" . haddockProgramArgs $ flags
+ commonFlags = haddockCommonFlags flags
fromHaddockProjectFlags :: HaddockProjectFlags -> HaddockArgs
fromHaddockProjectFlags flags =
@@ -522,7 +533,7 @@ componentGhcOptions
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
+ -> SymbolicPath Pkg (Path.Dir build)
-> GhcOptions
componentGhcOptions verbosity lbi bi clbi odir =
let f = case compilerFlavor (compiler lbi) of
@@ -536,13 +547,13 @@ componentGhcOptions verbosity lbi bi clbi odir =
mkHaddockArgs
:: Verbosity
- -> FilePath
+ -> SymbolicPath Pkg (Path.Dir Tmp)
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Maybe PathTemplate
-- ^ template for HTML location
-> Version
- -> [FilePath]
+ -> [SymbolicPath Pkg File]
-> BuildInfo
-> IO HaddockArgs
mkHaddockArgs verbosity tmp lbi clbi htmlTemplate haddockVersion inFiles bi = do
@@ -553,9 +564,9 @@ mkHaddockArgs verbosity tmp lbi clbi htmlTemplate haddockVersion inFiles bi = do
-- haddock stomps on our precious .hi
-- and .o files. Workaround by telling
-- haddock to write them elsewhere.
- ghcOptObjDir = toFlag tmp
- , ghcOptHiDir = toFlag tmp
- , ghcOptStubDir = toFlag tmp
+ ghcOptObjDir = toFlag $ coerceSymbolicPath tmp
+ , ghcOptHiDir = toFlag $ coerceSymbolicPath tmp
+ , ghcOptStubDir = toFlag $ coerceSymbolicPath tmp
}
`mappend` getGhcCppOpts haddockVersion bi
sharedOpts =
@@ -577,13 +588,13 @@ mkHaddockArgs verbosity tmp lbi clbi htmlTemplate haddockVersion inFiles bi = do
return
ifaceArgs
{ argGhcOptions = opts
- , argTargets = inFiles
+ , argTargets = map getSymbolicPath inFiles
, argReexports = getReexports clbi
}
fromLibrary
:: Verbosity
- -> FilePath
+ -> SymbolicPath Pkg (Path.Dir Tmp)
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Maybe PathTemplate
@@ -610,7 +621,7 @@ fromLibrary verbosity tmp lbi clbi htmlTemplate haddockVersion lib = do
fromExecutable
:: Verbosity
- -> FilePath
+ -> SymbolicPath Pkg (Path.Dir Tmp)
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Maybe PathTemplate
@@ -638,7 +649,7 @@ fromExecutable verbosity tmp lbi clbi htmlTemplate haddockVersion exe = do
fromForeignLib
:: Verbosity
- -> FilePath
+ -> SymbolicPath Pkg (Path.Dir Tmp)
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Maybe PathTemplate
@@ -744,6 +755,7 @@ getGhcLibDir verbosity lbi = do
-- | Call haddock with the specified arguments.
runHaddock
:: Verbosity
+ -> Maybe (SymbolicPath CWD (Path.Dir Pkg))
-> TempFileOptions
-> Compiler
-> Platform
@@ -752,7 +764,7 @@ runHaddock
-- ^ require targets
-> HaddockArgs
-> IO ()
-runHaddock verbosity tmpFileOpts comp platform haddockProg requireTargets args
+runHaddock verbosity mbWorkDir tmpFileOpts comp platform haddockProg requireTargets args
| requireTargets && null (argTargets args) =
warn verbosity $
"Haddocks are being requested, but there aren't any modules given "
@@ -762,66 +774,61 @@ runHaddock verbosity tmpFileOpts comp platform haddockProg requireTargets args
fromMaybe
(error "unable to determine haddock version")
(programVersion haddockProg)
- renderArgs verbosity tmpFileOpts haddockVersion comp platform args $
- \(flags, result) -> do
- runProgram verbosity haddockProg flags
-
+ renderArgs verbosity mbWorkDir tmpFileOpts haddockVersion comp platform args $
+ \flags result -> do
+ runProgramCwd verbosity mbWorkDir haddockProg flags
notice verbosity $ "Documentation created: " ++ result
renderArgs
- :: Verbosity
+ :: forall a
+ . Verbosity
+ -> Maybe (SymbolicPath CWD (Path.Dir Pkg))
-> TempFileOptions
-> Version
-> Compiler
-> Platform
-> HaddockArgs
- -> (([String], FilePath) -> IO a)
+ -> ([String] -> FilePath -> IO a)
-> IO a
-renderArgs verbosity tmpFileOpts version comp platform args k = do
+renderArgs verbosity mbWorkDir tmpFileOpts version comp platform args k = do
let haddockSupportsUTF8 = version >= mkVersion [2, 14, 4]
haddockSupportsResponseFiles = version > mkVersion [2, 16, 2]
- createDirectoryIfMissingVerbose verbosity True outputDir
- case argPrologue args of
- Flag prologueText ->
- withTempFileEx tmpFileOpts outputDir "haddock-prologue.txt" $
- \prologueFileName h -> do
- do
- when haddockSupportsUTF8 (hSetEncoding h utf8)
- hPutStrLn h prologueText
- hClose h
- let pflag = "--prologue=" ++ prologueFileName
- renderedArgs = pflag : renderPureArgs version comp platform args
- if haddockSupportsResponseFiles
+ createDirectoryIfMissingVerbose verbosity True (i outputDir)
+ let withPrologueArgs prologueArgs =
+ let renderedArgs = prologueArgs <> renderPureArgs version comp platform args
+ in if haddockSupportsResponseFiles
then
withResponseFile
verbosity
tmpFileOpts
+ mbWorkDir
outputDir
"haddock-response.txt"
(if haddockSupportsUTF8 then Just utf8 else Nothing)
renderedArgs
- (\responseFileName -> k (["@" ++ responseFileName], result))
- else k (renderedArgs, result)
- _ -> do
- let renderedArgs =
- ( case argPrologueFile args of
- Flag pfile -> ["--prologue=" ++ pfile]
- _ -> []
- )
- <> renderPureArgs version comp platform args
- if haddockSupportsResponseFiles
- then
- withResponseFile
- verbosity
- tmpFileOpts
- outputDir
- "haddock-response.txt"
- (if haddockSupportsUTF8 then Just utf8 else Nothing)
- renderedArgs
- (\responseFileName -> k (["@" ++ responseFileName], result))
- else k (renderedArgs, result)
+ (\responseFileName -> k ["@" ++ responseFileName] result)
+ else k renderedArgs result
+ case argPrologue args of
+ Flag prologueText ->
+ withTempFileEx tmpFileOpts mbWorkDir outputDir "haddock-prologue.txt" $
+ \prologueFileName h -> do
+ when haddockSupportsUTF8 (hSetEncoding h utf8)
+ hPutStrLn h prologueText
+ hClose h
+ withPrologueArgs ["--prologue=" ++ u prologueFileName]
+ _ ->
+ withPrologueArgs
+ ( case argPrologueFile args of
+ Flag pfile -> ["--prologue=" ++ pfile]
+ _ -> []
+ )
where
- outputDir = (unDir $ argOutputDir args)
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ i = interpretSymbolicPath mbWorkDir
+ u :: SymbolicPath Pkg to -> FilePath
+ u = interpretSymbolicPathCWD
+
+ outputDir = coerceSymbolicPath $ unDir $ argOutputDir args
isNotArgContents = isNothing (flagToMaybe $ argContents args)
isNotArgIndex = isNothing (flagToMaybe $ argIndex args)
isArgGenIndex = fromFlagOrDefault False (argGenIndex args)
@@ -833,7 +840,7 @@ renderArgs verbosity tmpFileOpts version comp platform args k = do
intercalate ", "
. map
( \o ->
- outputDir
+ i outputDir
</> case o of
Html
| isIndexGenerated ->
@@ -854,7 +861,7 @@ renderArgs verbosity tmpFileOpts version comp platform args k = do
renderPureArgs :: Version -> Compiler -> Platform -> HaddockArgs -> [String]
renderPureArgs version comp platform args =
concat
- [ map (\f -> "--dump-interface=" ++ unDir (argOutputDir args) </> f)
+ [ map (\f -> "--dump-interface=" ++ u (unDir (argOutputDir args)) </> f)
. flagToList
. argInterfaceFile
$ args
@@ -912,7 +919,7 @@ renderPureArgs version comp platform args =
. argOutput
$ args
, renderInterfaces . argInterfaces $ args
- , (: []) . ("--odir=" ++) . unDir . argOutputDir $ args
+ , (: []) . ("--odir=" ++) . u . unDir . argOutputDir $ args
, maybe
[]
( (: [])
@@ -939,6 +946,8 @@ renderPureArgs version comp platform args =
, maybe [] ((: []) . ("--lib=" ++)) . flagToMaybe . argLib $ args
]
where
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ u = interpretSymbolicPathCWD
renderInterfaces = map renderInterface
renderInterface :: (FilePath, Maybe FilePath, Maybe FilePath, Visibility) -> String
@@ -1141,6 +1150,13 @@ hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags =
(orLaterVersion (mkVersion [1, 8]))
(withPrograms lbi)
where
+ common = hscolourCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ distPref = fromFlag $ setupDistPref common
+ mbWorkDir = mbWorkDirLBI lbi
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
+ u :: SymbolicPath Pkg to -> FilePath
+ u = interpretSymbolicPathCWD
go :: ConfiguredProgram -> IO ()
go hscolourProg = do
warn verbosity $
@@ -1150,7 +1166,8 @@ hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags =
setupMessage verbosity "Running hscolour for" (packageId pkg_descr)
createDirectoryIfMissingVerbose verbosity True $
- hscolourPref haddockTarget distPref pkg_descr
+ i $
+ hscolourPref haddockTarget distPref pkg_descr
withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi -> do
let tgt = TargetInfo clbi comp
@@ -1161,23 +1178,21 @@ hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags =
Just exe -> do
let outputDir =
hscolourPref haddockTarget distPref pkg_descr
- </> unUnqualComponentName (exeName exe)
- </> "src"
+ </> makeRelativePathEx (unUnqualComponentName (exeName exe) </> "src")
runHsColour hscolourProg outputDir =<< getExeSourceFiles verbosity lbi exe clbi
Nothing -> do
- warn
- (fromFlag $ hscolourVerbosity flags)
- "Unsupported component, skipping..."
- return ()
+ warn verbosity "Unsupported component, skipping..."
case comp of
CLib lib -> do
- let outputDir = hscolourPref haddockTarget distPref pkg_descr </> "src"
+ let outputDir = hscolourPref haddockTarget distPref pkg_descr </> makeRelativePathEx "src"
runHsColour hscolourProg outputDir =<< getLibSourceFiles verbosity lbi lib clbi
CFLib flib -> do
let outputDir =
hscolourPref haddockTarget distPref pkg_descr
- </> unUnqualComponentName (foreignLibName flib)
- </> "src"
+ </> makeRelativePathEx
+ ( unUnqualComponentName (foreignLibName flib)
+ </> "src"
+ )
runHsColour hscolourProg outputDir =<< getFLibSourceFiles verbosity lbi flib clbi
CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp
CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp
@@ -1185,43 +1200,45 @@ hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags =
stylesheet = flagToMaybe (hscolourCSS flags)
- verbosity = fromFlag (hscolourVerbosity flags)
- distPref = fromFlag (hscolourDistPref flags)
-
+ runHsColour
+ :: ConfiguredProgram
+ -> SymbolicPath Pkg to
+ -> [(ModuleName.ModuleName, SymbolicPath Pkg to1)]
+ -> IO ()
runHsColour prog outputDir moduleFiles = do
- createDirectoryIfMissingVerbose verbosity True outputDir
+ createDirectoryIfMissingVerbose verbosity True (i outputDir)
case stylesheet of -- copy the CSS file
Nothing
| programVersion prog >= Just (mkVersion [1, 9]) ->
- runProgram
+ runProgramCwd
verbosity
+ mbWorkDir
prog
- ["-print-css", "-o" ++ outputDir </> "hscolour.css"]
+ ["-print-css", "-o" ++ u outputDir </> "hscolour.css"]
| otherwise -> return ()
- Just s -> copyFileVerbose verbosity s (outputDir </> "hscolour.css")
+ Just s -> copyFileVerbose verbosity s (i outputDir </> "hscolour.css")
for_ moduleFiles $ \(m, inFile) ->
- runProgram
+ runProgramCwd
verbosity
+ mbWorkDir
prog
- ["-css", "-anchor", "-o" ++ outFile m, inFile]
+ ["-css", "-anchor", "-o" ++ outFile m, u inFile]
where
outFile m =
- outputDir
+ i outputDir
</> intercalate "-" (ModuleName.components m) <.> "html"
haddockToHscolour :: HaddockFlags -> HscolourFlags
haddockToHscolour flags =
HscolourFlags
- { hscolourCSS = haddockHscolourCss flags
+ { hscolourCommonFlags = haddockCommonFlags flags
+ , hscolourCSS = haddockHscolourCss flags
, hscolourExecutables = haddockExecutables flags
, hscolourTestSuites = haddockTestSuites flags
, hscolourBenchmarks = haddockBenchmarks flags
, hscolourForeignLibs = haddockForeignLibs flags
- , hscolourVerbosity = haddockVerbosity flags
- , hscolourDistPref = haddockDistPref flags
- , hscolourCabalFilePath = haddockCabalFilePath flags
}
-- ------------------------------------------------------------------------------
diff --git a/Cabal/src/Distribution/Simple/HaskellSuite.hs b/Cabal/src/Distribution/Simple/HaskellSuite.hs
index d59c4703fc..d3f43f6590 100644
--- a/Cabal/src/Distribution/Simple/HaskellSuite.hs
+++ b/Cabal/src/Distribution/Simple/HaskellSuite.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -22,7 +23,6 @@ import Distribution.Simple.Program
import Distribution.Simple.Program.Builtin
import Distribution.Simple.Utils
import Distribution.System (Platform)
-import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
import Language.Haskell.Extension
@@ -179,23 +179,23 @@ buildLib verbosity pkg_descr lbi lib clbi = do
let odir = buildDir lbi
bi = libBuildInfo lib
- srcDirs = map getSymbolicPath (hsSourceDirs bi) ++ [odir]
+ srcDirs = map i (hsSourceDirs bi) ++ [i odir]
dbStack = withPackageDB lbi
language = fromMaybe Haskell98 (defaultLanguage bi)
progdb = withPrograms lbi
pkgid = packageId pkg_descr
-
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
runDbProgram verbosity haskellSuiteProgram progdb $
- ["compile", "--build-dir", odir]
+ ["compile", "--build-dir", i odir]
++ concat [["-i", d] | d <- srcDirs]
++ concat
[ ["-I", d]
| d <-
- [ autogenComponentModulesDir lbi clbi
- , autogenPackageModulesDir lbi
- , odir
+ [ i $ autogenComponentModulesDir lbi clbi
+ , i $ autogenPackageModulesDir lbi
+ , i odir
]
- ++ includeDirs bi
+ ++ map i (includeDirs bi)
]
++ [packageDbOpt pkgDb | pkgDb <- dbStack]
++ ["--package-name", prettyShow pkgid]
diff --git a/Cabal/src/Distribution/Simple/Hpc.hs b/Cabal/src/Distribution/Simple/Hpc.hs
index 158051b092..ea1c136805 100644
--- a/Cabal/src/Distribution/Simple/Hpc.hs
+++ b/Cabal/src/Distribution/Simple/Hpc.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
@@ -36,7 +37,11 @@ import Distribution.PackageDescription
)
import qualified Distribution.PackageDescription as PD
import Distribution.Pretty
-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..))
+import Distribution.Simple.LocalBuildInfo
+ ( LocalBuildInfo (..)
+ , interpretSymbolicPathLBI
+ , mbWorkDirLBI
+ )
import Distribution.Simple.Program
( hpcProgram
, requireProgramVersion
@@ -44,10 +49,11 @@ import Distribution.Simple.Program
import Distribution.Simple.Program.Hpc (markup, union)
import Distribution.Simple.Utils (notice)
import Distribution.Types.UnqualComponentName
+import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity ())
import Distribution.Version (anyVersion)
+
import System.Directory (createDirectoryIfMissing, doesFileExist)
-import System.FilePath
-- -------------------------------------------------------------------------
-- Haskell Program Coverage
@@ -56,12 +62,12 @@ data Way = Vanilla | Prof | Dyn
deriving (Bounded, Enum, Eq, Read, Show)
hpcDir
- :: FilePath
+ :: SymbolicPath Pkg (Dir Dist)
-- ^ \"dist/\" prefix
-> Way
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
-- ^ Directory containing component's HPC .mix files
-hpcDir distPref way = distPref </> "hpc" </> wayDir
+hpcDir distPref way = distPref </> makeRelativePathEx ("hpc" </> wayDir)
where
wayDir = case way of
Vanilla -> "vanilla"
@@ -69,39 +75,39 @@ hpcDir distPref way = distPref </> "hpc" </> wayDir
Dyn -> "dyn"
mixDir
- :: FilePath
+ :: SymbolicPath Pkg (Dir Dist)
-- ^ \"dist/\" prefix
-> Way
- -> FilePath
+ -> SymbolicPath Pkg (Dir Mix)
-- ^ Directory containing test suite's .mix files
-mixDir distPref way = hpcDir distPref way </> "mix"
+mixDir distPref way = hpcDir distPref way </> makeRelativePathEx "mix"
tixDir
- :: FilePath
+ :: SymbolicPath Pkg (Dir Dist)
-- ^ \"dist/\" prefix
-> Way
- -> FilePath
+ -> SymbolicPath Pkg (Dir Tix)
-- ^ Directory containing test suite's .tix files
-tixDir distPref way = hpcDir distPref way </> "tix"
+tixDir distPref way = hpcDir distPref way </> makeRelativePathEx "tix"
-- | Path to the .tix file containing a test suite's sum statistics.
tixFilePath
- :: FilePath
+ :: SymbolicPath Pkg (Dir Dist)
-- ^ \"dist/\" prefix
-> Way
-> FilePath
-- ^ Component name
- -> FilePath
+ -> SymbolicPath Pkg File
-- ^ Path to test suite's .tix file
-tixFilePath distPref way name = tixDir distPref way </> name <.> "tix"
+tixFilePath distPref way name = tixDir distPref way </> makeRelativePathEx (name <.> "tix")
htmlDir
- :: FilePath
+ :: SymbolicPath Pkg (Dir Dist)
-- ^ \"dist/\" prefix
-> Way
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
-- ^ Path to test suite's HTML markup directory
-htmlDir distPref way = hpcDir distPref way </> "html"
+htmlDir distPref way = hpcDir distPref way </> makeRelativePathEx "html"
-- | Attempt to guess the way the test suites in this package were compiled
-- and linked with the library so the correct module interfaces are found.
@@ -114,7 +120,7 @@ guessWay lbi
-- | Haskell Program Coverage information required to produce a valid HPC
-- report through the `hpc markup` call for the package libraries.
data HPCMarkupInfo = HPCMarkupInfo
- { pathsToLibsArtifacts :: [FilePath]
+ { pathsToLibsArtifacts :: [SymbolicPath Pkg (Dir Artifacts)]
-- ^ The paths to the library components whose modules are included in the
-- coverage report
, libsModulesToInclude :: [ModuleName]
@@ -126,14 +132,16 @@ markupPackage
:: Verbosity
-> HPCMarkupInfo
-> LocalBuildInfo
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-- ^ Testsuite \"dist/\" prefix
-> PD.PackageDescription
-> [TestSuite]
-> IO ()
markupPackage verbosity HPCMarkupInfo{pathsToLibsArtifacts, libsModulesToInclude} lbi testDistPref pkg_descr suites = do
let tixFiles = map (tixFilePath testDistPref way) testNames
- tixFilesExist <- traverse doesFileExist tixFiles
+ mbWorkDir = mbWorkDirLBI lbi
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
+ tixFilesExist <- traverse (doesFileExist . i) tixFiles
when (and tixFilesExist) $ do
-- behaviour of 'markup' depends on version, so we need *a* version
-- but no particular one
@@ -165,16 +173,16 @@ markupPackage verbosity HPCMarkupInfo{pathsToLibsArtifacts, libsModulesToInclude
let excluded = concatMap testModules suites ++ [main]
pkgName = prettyShow $ PD.package pkg_descr
summedTixFile = tixFilePath testDistPref way pkgName
- createDirectoryIfMissing True $ takeDirectory summedTixFile
- union hpc verbosity tixFiles summedTixFile excluded
+ createDirectoryIfMissing True $ i $ takeDirectorySymbolicPath summedTixFile
+ union mbWorkDir hpc verbosity tixFiles summedTixFile excluded
return summedTixFile
- markup hpc hpcVer verbosity tixFile mixDirs htmlDir' libsModulesToInclude
+ markup mbWorkDir hpc hpcVer verbosity tixFile mixDirs htmlDir' libsModulesToInclude
notice verbosity $
"Package coverage report written to "
- ++ htmlDir'
+ ++ i htmlDir'
</> "hpc_index.html"
where
way = guessWay lbi
testNames = fmap (unUnqualComponentName . testName) suites
- mixDirs = map (`mixDir` way) pathsToLibsArtifacts
+ mixDirs = map ((`mixDir` way) . coerceSymbolicPath) pathsToLibsArtifacts
diff --git a/Cabal/src/Distribution/Simple/Install.hs b/Cabal/src/Distribution/Simple/Install.hs
index 789845c620..eb72a73fa5 100644
--- a/Cabal/src/Distribution/Simple/Install.hs
+++ b/Cabal/src/Distribution/Simple/Install.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -37,11 +38,9 @@ import Distribution.Simple.Compiler
( CompilerFlavor (..)
, compilerFlavor
)
-import Distribution.Simple.Flag
- ( fromFlag
- )
import Distribution.Simple.Glob (matchDirFileGlob)
import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Copy
( CopyFlags (..)
)
@@ -54,17 +53,19 @@ import Distribution.Simple.Utils
, info
, installDirectoryContents
, installOrdinaryFile
+ , isAbsoluteOnAnyPlatform
, isInSearchPath
, noticeNoWrap
, warn
)
-import Distribution.Utils.Path (getSymbolicPath)
+import Distribution.Utils.Path
import Distribution.Compat.Graph (IsNode (..))
import Distribution.Simple.Errors
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
+import Distribution.Simple.Setup.Common
import qualified Distribution.Simple.UHC as UHC
import System.Directory
@@ -72,10 +73,8 @@ import System.Directory
, doesFileExist
)
import System.FilePath
- ( isRelative
- , takeDirectory
+ ( takeDirectory
, takeFileName
- , (</>)
)
import Distribution.Pretty
@@ -98,7 +97,7 @@ install
-> IO ()
install pkg_descr lbi flags = do
checkHasLibsOrExes
- targets <- readTargetInfos verbosity pkg_descr lbi (copyArgs flags)
+ targets <- readTargetInfos verbosity pkg_descr lbi (copyTargets flags)
copyPackage verbosity pkg_descr lbi distPref copydest
@@ -108,8 +107,9 @@ install pkg_descr lbi flags = do
clbi = targetCLBI target
in copyComponent verbosity pkg_descr lbi comp clbi copydest
where
- distPref = fromFlag (copyDistPref flags)
- verbosity = fromFlag (copyVerbosity flags)
+ common = copyCommonFlags flags
+ distPref = fromFlag $ setupDistPref common
+ verbosity = fromFlag $ setupVerbosity common
copydest = fromFlag (copyDest flags)
checkHasLibsOrExes =
@@ -121,7 +121,7 @@ copyPackage
:: Verbosity
-> PackageDescription
-> LocalBuildInfo
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-> CopyDest
-> IO ()
copyPackage verbosity pkg_descr lbi distPref copydest = do
@@ -134,17 +134,19 @@ copyPackage verbosity pkg_descr lbi distPref copydest = do
, htmldir = htmlPref
, haddockdir = interfacePref
} = absoluteInstallCommandDirs pkg_descr lbi (localUnitId lbi) copydest
+ mbWorkDir = mbWorkDirLBI lbi
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
-- Install (package-global) data files
- installDataFiles verbosity pkg_descr dataPref
+ installDataFiles verbosity mbWorkDir pkg_descr $ makeSymbolicPath dataPref
-- Install (package-global) Haddock files
-- TODO: these should be done per-library
- docExists <- doesDirectoryExist $ haddockPref ForDevelopment distPref pkg_descr
+ docExists <- doesDirectoryExist $ i $ haddockPref ForDevelopment distPref pkg_descr
info
verbosity
( "directory "
- ++ haddockPref ForDevelopment distPref pkg_descr
+ ++ getSymbolicPath (haddockPref ForDevelopment distPref pkg_descr)
++ " does exist: "
++ show docExists
)
@@ -155,7 +157,7 @@ copyPackage verbosity pkg_descr lbi distPref copydest = do
createDirectoryIfMissingVerbose verbosity True htmlPref
installDirectoryContents
verbosity
- (haddockPref ForDevelopment distPref pkg_descr)
+ (i $ haddockPref ForDevelopment distPref pkg_descr)
htmlPref
-- setPermissionsRecursive [Read] htmlPref
-- The haddock interface file actually already got installed
@@ -164,25 +166,26 @@ copyPackage verbosity pkg_descr lbi distPref copydest = do
-- copy in htmlPref first.
let haddockInterfaceFileSrc =
haddockPref ForDevelopment distPref pkg_descr
- </> haddockName pkg_descr
+ </> makeRelativePathEx (haddockName pkg_descr)
haddockInterfaceFileDest = interfacePref </> haddockName pkg_descr
-- We only generate the haddock interface file for libs, So if the
-- package consists only of executables there will not be one:
- exists <- doesFileExist haddockInterfaceFileSrc
+ exists <- doesFileExist $ i haddockInterfaceFileSrc
when exists $ do
createDirectoryIfMissingVerbose verbosity True interfacePref
installOrdinaryFile
verbosity
- haddockInterfaceFileSrc
+ (i haddockInterfaceFileSrc)
haddockInterfaceFileDest
let lfiles = licenseFiles pkg_descr
unless (null lfiles) $ do
createDirectoryIfMissingVerbose verbosity True docPref
- for_ lfiles $ \lfile' -> do
- let lfile :: FilePath
- lfile = getSymbolicPath lfile'
- installOrdinaryFile verbosity lfile (docPref </> takeFileName lfile)
+ for_ lfiles $ \lfile -> do
+ installOrdinaryFile
+ verbosity
+ (i lfile)
+ (docPref </> takeFileName (getSymbolicPath lfile))
-- | Copy files associated with a component.
copyComponent
@@ -199,7 +202,7 @@ copyComponent verbosity pkg_descr lbi (CLib lib) clbi copydest = do
, dynlibdir = dynlibPref
, includedir = incPref
} = absoluteInstallCommandDirs pkg_descr lbi (componentUnitId clbi) copydest
- buildPref = componentBuildDir lbi clbi
+ buildPref = interpretSymbolicPathLBI lbi $ componentBuildDir lbi clbi
case libName lib of
LMainLibName -> noticeNoWrap verbosity ("Installing library in " ++ libPref)
@@ -230,7 +233,7 @@ copyComponent verbosity pkg_descr lbi (CFLib flib) clbi copydest = do
{ flibdir = flibPref
, includedir = incPref
} = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest
- buildPref = componentBuildDir lbi clbi
+ buildPref = interpretSymbolicPathLBI lbi $ componentBuildDir lbi clbi
noticeNoWrap verbosity ("Installing foreign library " ++ unUnqualComponentName (foreignLibName flib) ++ " in " ++ flibPref)
installIncludeFiles verbosity (foreignLibBuildInfo flib) lbi buildPref incPref
@@ -243,7 +246,7 @@ copyComponent verbosity pkg_descr lbi (CExe exe) clbi copydest = do
let installDirs = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest
-- the installers know how to find the actual location of the
-- binaries
- buildPref = buildDir lbi
+ buildPref = interpretSymbolicPathLBI lbi $ buildDir lbi
uid = componentUnitId clbi
pkgid = packageId pkg_descr
binPref
@@ -280,29 +283,43 @@ copyComponent _ _ _ (CBench _) _ _ = return ()
copyComponent _ _ _ (CTest _) _ _ = return ()
-- | Install the files listed in data-files
-installDataFiles :: Verbosity -> PackageDescription -> FilePath -> IO ()
-installDataFiles verbosity pkg_descr destDataDir =
+installDataFiles
+ :: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> PackageDescription
+ -> SymbolicPath Pkg (Dir DataDir)
+ -> IO ()
+installDataFiles verbosity mbWorkDir pkg_descr destDataDir =
flip traverse_ (dataFiles pkg_descr) $ \glob -> do
- let srcDataDirRaw = dataDir pkg_descr
- srcDataDir =
- if null srcDataDirRaw
- then "."
- else srcDataDirRaw
+ let srcDataDirRaw = getSymbolicPath $ dataDir pkg_descr
+ srcDataDir :: Maybe (SymbolicPath CWD (Dir DataDir))
+ srcDataDir
+ | null srcDataDirRaw =
+ Nothing
+ | isAbsoluteOnAnyPlatform srcDataDirRaw =
+ Just $ makeSymbolicPath srcDataDirRaw
+ | otherwise =
+ Just $ fromMaybe sameDirectory mbWorkDir </> makeRelativePathEx srcDataDirRaw
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
files <- matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir glob
for_ files $ \file' -> do
- let src = srcDataDir </> file'
- dst = destDataDir </> file'
+ let src = i (dataDir pkg_descr </> file')
+ dst = i (destDataDir </> file')
createDirectoryIfMissingVerbose verbosity True (takeDirectory dst)
installOrdinaryFile verbosity src dst
-- | Install the files listed in install-includes for a library
installIncludeFiles :: Verbosity -> BuildInfo -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
installIncludeFiles verbosity libBi lbi buildPref destIncludeDir = do
- let relincdirs = "." : filter isRelative (includeDirs libBi)
+ let relincdirs = sameDirectory : mapMaybe symbolicPathRelative_maybe (includeDirs libBi)
incdirs =
- [baseDir lbi </> dir | dir <- relincdirs]
- ++ [buildPref </> dir | dir <- relincdirs]
- incs <- traverse (findInc incdirs) (installIncludes libBi)
+ [ root </> getSymbolicPath dir
+ | -- NB: both baseDir and buildPref are already interpreted,
+ -- so we don't need to interpret these paths in the call to findInc.
+ dir <- relincdirs
+ , root <- [baseDir lbi, buildPref]
+ ]
+ incs <- traverse (findInc incdirs . getSymbolicPath) (installIncludes libBi)
sequence_
[ do
createDirectoryIfMissingVerbose verbosity True destDir
@@ -312,7 +329,7 @@ installIncludeFiles verbosity libBi lbi buildPref destIncludeDir = do
destDir = takeDirectory destFile
]
where
- baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi')
+ baseDir lbi' = packageRoot $ configCommonFlags $ configFlags lbi'
findInc [] file = dieWithException verbosity $ CantFindIncludeFile file
findInc (dir : dirs) file = do
let path = dir </> file
diff --git a/Cabal/src/Distribution/Simple/InstallDirs.hs b/Cabal/src/Distribution/Simple/InstallDirs.hs
index 6321eabdb2..b478aefe51 100644
--- a/Cabal/src/Distribution/Simple/InstallDirs.hs
+++ b/Cabal/src/Distribution/Simple/InstallDirs.hs
@@ -344,6 +344,8 @@ data CopyDest
CopyToDb FilePath
deriving (Eq, Show, Generic)
+-- TODO: are these paths absolute or relative? Relative to what?
+
instance Binary CopyDest
instance Structured CopyDest
diff --git a/Cabal/src/Distribution/Simple/LocalBuildInfo.hs b/Cabal/src/Distribution/Simple/LocalBuildInfo.hs
index 8659764d0c..35681ee590 100644
--- a/Cabal/src/Distribution/Simple/LocalBuildInfo.hs
+++ b/Cabal/src/Distribution/Simple/LocalBuildInfo.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -29,9 +30,12 @@ module Distribution.Simple.LocalBuildInfo
-- * Convenience accessors
, buildDir
- , cabalFilePath
+ , packageRoot
, progPrefix
, progSuffix
+ , interpretSymbolicPathLBI
+ , mbWorkDirLBI
+ , absoluteWorkingDirLBI
-- * Buildable package components
, Component (..)
@@ -91,6 +95,7 @@ import Distribution.Package
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Simple.Compiler
+import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs hiding
( absoluteInstallDirs
, prefixRelativeInstallDirs
@@ -98,35 +103,66 @@ import Distribution.Simple.InstallDirs hiding
)
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.PackageIndex
+import Distribution.Simple.Setup.Common
+import Distribution.Simple.Setup.Config
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Data.List (stripPrefix)
-import System.FilePath
-
-import System.Directory (canonicalizePath, doesDirectoryExist)
+import qualified System.Directory as Directory
+ ( canonicalizePath
+ , doesDirectoryExist
+ )
-- -----------------------------------------------------------------------------
-- Configuration information of buildable components
-componentBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
+componentBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir Build)
-- For now, we assume that libraries/executables/test-suites/benchmarks
-- are only ever built once. With Backpack, we need a special case for
-- libraries so that we can handle building them multiple times.
componentBuildDir lbi clbi =
- buildDir lbi
- </> case componentLocalName clbi of
- CLibName LMainLibName ->
- if prettyShow (componentUnitId clbi) == prettyShow (componentComponentId clbi)
- then ""
- else prettyShow (componentUnitId clbi)
- CLibName (LSubLibName s) ->
- if prettyShow (componentUnitId clbi) == prettyShow (componentComponentId clbi)
- then unUnqualComponentName s
- else prettyShow (componentUnitId clbi)
- CFLibName s -> unUnqualComponentName s
- CExeName s -> unUnqualComponentName s
- CTestName s -> unUnqualComponentName s
- CBenchName s -> unUnqualComponentName s
+ (buildDir lbi </>) $
+ makeRelativePathEx $
+ case componentLocalName clbi of
+ CLibName LMainLibName ->
+ if prettyShow (componentUnitId clbi) == prettyShow (componentComponentId clbi)
+ then ""
+ else prettyShow (componentUnitId clbi)
+ CLibName (LSubLibName s) ->
+ if prettyShow (componentUnitId clbi) == prettyShow (componentComponentId clbi)
+ then unUnqualComponentName s
+ else prettyShow (componentUnitId clbi)
+ CFLibName s -> unUnqualComponentName s
+ CExeName s -> unUnqualComponentName s
+ CTestName s -> unUnqualComponentName s
+ CBenchName s -> unUnqualComponentName s
+
+-- | Interpret a symbolic path with respect to the working directory
+-- stored in 'LocalBuildInfo'.
+--
+-- Use this before directly interacting with the file system.
+--
+-- NB: when invoking external programs (such as @GHC@), it is preferable to set
+-- the working directory of the process rather than calling this function, as
+-- this function will turn relative paths into absolute paths if the working
+-- directory is an absolute path. This can degrade error messages, or worse,
+-- break the behaviour entirely (because the program might expect certain paths
+-- to be relative).
+--
+-- See Note [Symbolic paths] in Distribution.Utils.Path
+interpretSymbolicPathLBI :: LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
+interpretSymbolicPathLBI lbi =
+ interpretSymbolicPath (mbWorkDirLBI lbi)
+
+-- | Retrieve an optional working directory from 'LocalBuildInfo'.
+mbWorkDirLBI :: LocalBuildInfo -> Maybe (SymbolicPath CWD (Dir Pkg))
+mbWorkDirLBI =
+ flagToMaybe . setupWorkingDir . configCommonFlags . configFlags
+
+-- | Absolute path to the current working directory.
+absoluteWorkingDirLBI :: LocalBuildInfo -> IO FilePath
+absoluteWorkingDirLBI lbi = absoluteWorkingDir (mbWorkDirLBI lbi)
-- | Perform the action on each enabled 'library' in the package
-- description with the 'ComponentLocalBuildInfo'.
@@ -272,7 +308,7 @@ depLibraryPaths
internalLibs = map getLibDir internalCLBIs
-}
getLibDir sub_clbi
- | inplace = componentBuildDir lbi sub_clbi
+ | inplace = interpretSymbolicPathLBI lbi $ componentBuildDir lbi sub_clbi
| otherwise = dynlibdir (absoluteComponentInstallDirs pkgDescr lbi (componentUnitId sub_clbi) NoCopyDest)
-- Why do we go through all the trouble of a hand-crafting
@@ -318,9 +354,9 @@ depLibraryPaths
-- 'canonicalizePath' fails on UNIX when the directory does not exists.
-- So just don't canonicalize when it doesn't exist.
canonicalizePathNoFail p = do
- exists <- doesDirectoryExist p
+ exists <- Directory.doesDirectoryExist p
if exists
- then canonicalizePath p
+ then Directory.canonicalizePath p
else return p
-- | Get all module names that needed to be built by GHC; i.e., all
diff --git a/Cabal/src/Distribution/Simple/PackageDescription.hs b/Cabal/src/Distribution/Simple/PackageDescription.hs
index 440059db7c..d0ee9d9f86 100644
--- a/Cabal/src/Distribution/Simple/PackageDescription.hs
+++ b/Cabal/src/Distribution/Simple/PackageDescription.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+
-----------------------------------------------------------------------------
-- |
@@ -37,15 +39,29 @@ import Distribution.Parsec.Warning
)
import Distribution.Simple.Errors
import Distribution.Simple.Utils (dieWithException, equating, warn)
+import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity, normal)
+import GHC.Stack
import System.Directory (doesFileExist)
import Text.Printf (printf)
-readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription
-readGenericPackageDescription = readAndParseFile parseGenericPackageDescription
+readGenericPackageDescription
+ :: HasCallStack
+ => Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg File
+ -> IO GenericPackageDescription
+readGenericPackageDescription =
+ readAndParseFile parseGenericPackageDescription
-readHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo
-readHookedBuildInfo = readAndParseFile parseHookedBuildInfo
+readHookedBuildInfo
+ :: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ working directory
+ -> SymbolicPath Pkg File
+ -> IO HookedBuildInfo
+readHookedBuildInfo =
+ readAndParseFile parseHookedBuildInfo
-- | Helper combinator to do parsing plumbing for files.
--
@@ -58,16 +74,20 @@ readAndParseFile
-- ^ File contents to final value parser
-> Verbosity
-- ^ Verbosity level
- -> FilePath
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory
+ -> SymbolicPath Pkg File
-- ^ File to read
-> IO a
-readAndParseFile parser verbosity fpath = do
- exists <- doesFileExist fpath
+readAndParseFile parser verbosity mbWorkDir fpath = do
+ let ipath = interpretSymbolicPath mbWorkDir fpath
+ upath = getSymbolicPath fpath
+ exists <- doesFileExist ipath
unless exists $
dieWithException verbosity $
- ErrorParsingFileDoesntExist fpath
- bs <- BS.readFile fpath
- parseString parser verbosity fpath bs
+ ErrorParsingFileDoesntExist upath
+ bs <- BS.readFile ipath
+ parseString parser verbosity upath bs
parseString
:: (BS.ByteString -> ParseResult a)
diff --git a/Cabal/src/Distribution/Simple/PreProcess.hs b/Cabal/src/Distribution/Simple/PreProcess.hs
index 4f69ce6fc0..160b81fd4d 100644
--- a/Cabal/src/Distribution/Simple/PreProcess.hs
+++ b/Cabal/src/Distribution/Simple/PreProcess.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
-----------------------------------------------------------------------------
@@ -51,7 +53,6 @@ import Prelude ()
import Distribution.Backpack.DescribeUnitId
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.ModuleName (ModuleName)
-import qualified Distribution.ModuleName as ModuleName
import Distribution.Package
import Distribution.PackageDescription as PD
import Distribution.Simple.BuildPaths
@@ -71,16 +72,14 @@ import Distribution.Types.PackageName.Magic
import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
+
import System.Directory (doesDirectoryExist, doesFileExist)
import System.FilePath
- ( dropExtensions
- , normalise
+ ( normalise
, replaceExtension
, splitExtension
, takeDirectory
, takeExtensions
- , (<.>)
- , (</>)
)
import System.Info (arch, os)
@@ -89,7 +88,7 @@ import System.Info (arch, os)
-- between modules.
unsorted
:: Verbosity
- -> [FilePath]
+ -> [path]
-> [ModuleName]
-> IO [ModuleName]
unsorted _ _ ms = pure ms
@@ -98,7 +97,10 @@ unsorted _ _ ms = pure ms
-- preprocessor: just takes the path to the build directory and uses
-- this to search for C sources with names that match the
-- preprocessor's output name format.
-type PreProcessorExtras = FilePath -> IO [FilePath]
+type PreProcessorExtras =
+ Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg (Dir Source)
+ -> IO [RelativePath Source File]
mkSimplePreProcessor
:: (FilePath -> FilePath -> Verbosity -> IO ())
@@ -157,58 +159,51 @@ preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers =
case comp of
(CLib lib@Library{libBuildInfo = bi}) -> do
let dirs =
- map getSymbolicPath (hsSourceDirs bi)
+ hsSourceDirs bi
++ [autogenComponentModulesDir lbi clbi, autogenPackageModulesDir lbi]
let hndlrs = localHandlers bi
mods <- orderingFromHandlers verbosity dirs hndlrs (allLibModules lib clbi)
- for_ (map ModuleName.toFilePath mods) $
+ for_ (map moduleNameSymbolicPath mods) $
pre dirs (componentBuildDir lbi clbi) hndlrs
- (CFLib flib@ForeignLib{foreignLibBuildInfo = bi, foreignLibName = nm}) -> do
- let nm' = unUnqualComponentName nm
- let flibDir = buildDir lbi </> nm' </> nm' ++ "-tmp"
+ (CFLib flib@ForeignLib{foreignLibBuildInfo = bi}) -> do
+ let flibDir = flibBuildDir lbi flib
dirs =
- map getSymbolicPath (hsSourceDirs bi)
+ hsSourceDirs bi
++ [ autogenComponentModulesDir lbi clbi
, autogenPackageModulesDir lbi
]
let hndlrs = localHandlers bi
mods <- orderingFromHandlers verbosity dirs hndlrs (foreignLibModules flib)
- for_ (map ModuleName.toFilePath mods) $
+ for_ (map moduleNameSymbolicPath mods) $
pre dirs flibDir hndlrs
- (CExe exe@Executable{buildInfo = bi, exeName = nm}) -> do
- let nm' = unUnqualComponentName nm
- let exeDir = buildDir lbi </> nm' </> nm' ++ "-tmp"
+ (CExe exe@Executable{buildInfo = bi}) -> do
+ let exeDir = exeBuildDir lbi exe
dirs =
- map getSymbolicPath (hsSourceDirs bi)
+ hsSourceDirs bi
++ [ autogenComponentModulesDir lbi clbi
, autogenPackageModulesDir lbi
]
let hndlrs = localHandlers bi
mods <- orderingFromHandlers verbosity dirs hndlrs (otherModules bi)
- for_ (map ModuleName.toFilePath mods) $
+ for_ (map moduleNameSymbolicPath mods) $
pre dirs exeDir hndlrs
- pre (map getSymbolicPath (hsSourceDirs bi)) exeDir (localHandlers bi) $
- dropExtensions (modulePath exe)
- CTest test@TestSuite{testName = nm} -> do
- let nm' = unUnqualComponentName nm
+ pre (hsSourceDirs bi) exeDir (localHandlers bi) $
+ dropExtensionsSymbolicPath (modulePath exe)
+ CTest test@TestSuite{} -> do
+ let testDir = testBuildDir lbi test
case testInterface test of
TestSuiteExeV10 _ f ->
- preProcessTest test f $ buildDir lbi </> nm' </> nm' ++ "-tmp"
+ preProcessTest test f testDir
TestSuiteLibV09 _ _ -> do
- let testDir =
- buildDir lbi
- </> stubName test
- </> stubName test
- ++ "-tmp"
- writeSimpleTestStub test testDir
- preProcessTest test (stubFilePath test) testDir
+ writeSimpleTestStub test (i testDir)
+ preProcessTest test (makeRelativePathEx $ stubFilePath test) testDir
TestSuiteUnsupported tt ->
dieWithException verbosity $ NoSupportForPreProcessingTest tt
- CBench bm@Benchmark{benchmarkName = nm} -> do
- let nm' = unUnqualComponentName nm
+ CBench bm@Benchmark{} -> do
+ let benchDir = benchmarkBuildDir lbi bm
case benchmarkInterface bm of
BenchmarkExeV10 _ f ->
- preProcessBench bm f $ buildDir lbi </> nm' </> nm' ++ "-tmp"
+ preProcessBench bm f benchDir
BenchmarkUnsupported tt ->
dieWithException verbosity $ NoSupportForPreProcessingBenchmark tt
where
@@ -217,8 +212,10 @@ preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers =
builtinCSuffixes = map Suffix cSourceExtensions
builtinSuffixes = builtinHaskellSuffixes ++ builtinCSuffixes
localHandlers bi = [(ext, h bi lbi clbi) | (ext, h) <- handlers]
+ mbWorkDir = mbWorkDirLBI lbi
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
pre dirs dir lhndlrs fp =
- preprocessFile (map unsafeMakeSymbolicPath dirs) dir isSrcDist fp verbosity builtinSuffixes lhndlrs True
+ preprocessFile mbWorkDir dirs dir isSrcDist fp verbosity builtinSuffixes lhndlrs True
preProcessTest test =
preProcessComponent
(testBuildInfo test)
@@ -231,36 +228,37 @@ preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers =
preProcessComponent
:: BuildInfo
-> [ModuleName]
- -> FilePath
- -> FilePath
+ -> RelativePath Source File
+ -> SymbolicPath Pkg (Dir Build)
-> IO ()
- preProcessComponent bi modules exePath dir = do
+ preProcessComponent bi modules exePath outputDir = do
let biHandlers = localHandlers bi
sourceDirs =
- map getSymbolicPath (hsSourceDirs bi)
+ hsSourceDirs bi
++ [ autogenComponentModulesDir lbi clbi
, autogenPackageModulesDir lbi
]
sequence_
[ preprocessFile
- (map unsafeMakeSymbolicPath sourceDirs)
- dir
+ mbWorkDir
+ sourceDirs
+ outputDir
isSrcDist
- (ModuleName.toFilePath modu)
+ (moduleNameSymbolicPath modu)
verbosity
builtinSuffixes
biHandlers
False
| modu <- modules
]
- -- XXX: what we do here (re SymbolicPath dir)
- -- XXX: 2020-10-15 do we rely here on CWD being the PackageDir?
- -- Note we don't fail on missing in this case, because the main file may be generated later (i.e. by a test code generator)
+ -- Note we don't fail on missing in this case, because the main file
+ -- may be generated later (i.e. by a test code generator)
preprocessFile
- (unsafeMakeSymbolicPath dir : hsSourceDirs bi)
- dir
+ mbWorkDir
+ (coerceSymbolicPath outputDir : hsSourceDirs bi)
+ outputDir
isSrcDist
- (dropExtensions $ exePath)
+ (dropExtensionsSymbolicPath $ exePath)
verbosity
builtinSuffixes
biHandlers
@@ -273,13 +271,15 @@ preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers =
-- | Find the first extension of the file that exists, and preprocess it
-- if required.
preprocessFile
- :: [SymbolicPath PackageDir SourceDir]
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ package directory location
+ -> [SymbolicPath Pkg (Dir Source)]
-- ^ source directories
- -> FilePath
+ -> SymbolicPath Pkg (Dir Build)
-- ^ build directory
-> Bool
-- ^ preprocess for sdist
- -> FilePath
+ -> RelativePath Source File
-- ^ module file name
-> Verbosity
-- ^ verbosity
@@ -290,10 +290,10 @@ preprocessFile
-> Bool
-- ^ fail on missing file
-> IO ()
-preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes handlers failOnMissing = do
+preprocessFile mbWorkDir searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes handlers failOnMissing = do
-- look for files in the various source dirs with this module name
-- and a file extension of a known preprocessor
- psrcFiles <- findFileWithExtension' (map fst handlers) (map getSymbolicPath searchLoc) baseFile
+ psrcFiles <- findFileCwdWithExtension' mbWorkDir (map fst handlers) searchLoc baseFile
case psrcFiles of
-- no preprocessor file exists, look for an ordinary source file
-- just to make sure one actually exists at all for this module.
@@ -303,19 +303,19 @@ preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes ha
-- files generate source modules directly into the build dir without
-- the rest of the build system being aware of it (somewhat dodgy)
Nothing -> do
- bsrcFiles <- findFileWithExtension builtinSuffixes (buildLoc : map getSymbolicPath searchLoc) baseFile
+ bsrcFiles <- findFileCwdWithExtension mbWorkDir builtinSuffixes (buildAsSrcLoc : searchLoc) baseFile
case (bsrcFiles, failOnMissing) of
(Nothing, True) ->
dieWithException verbosity $
CantFindSourceForPreProcessFile $
"can't find source for "
- ++ baseFile
+ ++ getSymbolicPath baseFile
++ " in "
++ intercalate ", " (map getSymbolicPath searchLoc)
_ -> return ()
-- found a pre-processable file in one of the source dirs
Just (psrcLoc, psrcRelFile) -> do
- let (srcStem, ext) = splitExtension psrcRelFile
+ let (srcStem, ext) = splitExtension $ getSymbolicPath psrcRelFile
psrcFile = psrcLoc </> psrcRelFile
pp =
fromMaybe
@@ -333,20 +333,22 @@ preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes ha
when (not forSDist || forSDist && platformIndependent pp) $ do
-- look for existing pre-processed source file in the dest dir to
-- see if we really have to re-run the preprocessor.
- ppsrcFiles <- findFileWithExtension builtinSuffixes [buildLoc] baseFile
+ ppsrcFiles <- findFileCwdWithExtension mbWorkDir builtinSuffixes [buildAsSrcLoc] baseFile
recomp <- case ppsrcFiles of
Nothing -> return True
Just ppsrcFile ->
- psrcFile `moreRecentFile` ppsrcFile
+ i psrcFile `moreRecentFile` i ppsrcFile
when recomp $ do
- let destDir = buildLoc </> dirName srcStem
+ let destDir = i buildLoc </> takeDirectory srcStem
createDirectoryIfMissingVerbose verbosity True destDir
runPreProcessorWithHsBootHack
pp
- (psrcLoc, psrcRelFile)
- (buildLoc, srcStem <.> "hs")
+ (i psrcLoc, getSymbolicPath $ psrcRelFile)
+ (i buildLoc, srcStem <.> "hs")
where
- dirName = takeDirectory
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
+ buildAsSrcLoc :: SymbolicPath Pkg (Dir Source)
+ buildAsSrcLoc = coerceSymbolicPath buildLoc
-- FIXME: This is a somewhat nasty hack. GHC requires that hs-boot files
-- be in the same place as the hs files, so if we put the hs file in dist/
@@ -435,7 +437,7 @@ ppGhcCpp program xHs extraArgs _bi lbi clbi =
program
anyVersion
(withPrograms lbi)
- runProgram verbosity prog $
+ runProgramCwd verbosity (mbWorkDirLBI lbi) prog $
["-E", "-cpp"]
-- This is a bit of an ugly hack. We're going to
-- unlit the file ourselves later on if appropriate,
@@ -443,10 +445,14 @@ ppGhcCpp program xHs extraArgs _bi lbi clbi =
-- double-unlitted. In the future we might switch to
-- using cpphs --unlit instead.
++ (if xHs version then ["-x", "hs"] else [])
- ++ ["-optP-include", "-optP" ++ (autogenComponentModulesDir lbi clbi </> cppHeaderName)]
+ ++ ["-optP-include", "-optP" ++ u (autogenComponentModulesDir lbi clbi </> makeRelativePathEx cppHeaderName)]
++ ["-o", outFile, inFile]
++ extraArgs
}
+ where
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ u :: SymbolicPath Pkg to -> FilePath
+ u = interpretSymbolicPathCWD
ppCpphs :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpphs extraArgs _bi lbi clbi =
@@ -460,17 +466,21 @@ ppCpphs extraArgs _bi lbi clbi =
cpphsProgram
anyVersion
(withPrograms lbi)
- runProgram verbosity cpphsProg $
+ runProgramCwd verbosity (mbWorkDirLBI lbi) cpphsProg $
("-O" ++ outFile)
: inFile
: "--noline"
: "--strip"
: ( if cpphsVersion >= mkVersion [1, 6]
- then ["--include=" ++ (autogenComponentModulesDir lbi clbi </> cppHeaderName)]
+ then ["--include=" ++ u (autogenComponentModulesDir lbi clbi </> makeRelativePathEx cppHeaderName)]
else []
)
++ extraArgs
}
+ where
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ u :: SymbolicPath Pkg to -> FilePath
+ u = interpretSymbolicPathCWD
ppHsc2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHsc2hs bi lbi clbi =
@@ -485,6 +495,7 @@ ppHsc2hs bi lbi clbi =
hsc2hsProgram
anyVersion
(withPrograms lbi)
+ let runHsc2hs = runProgramCwd verbosity mbWorkDir hsc2hsProg
-- See Trac #13896 and https://github.com/haskell/cabal/issues/3122.
let isCross = hostPlatform lbi /= buildPlatform
prependCrossFlags = if isCross then ("-x" :) else id
@@ -495,16 +506,22 @@ ppHsc2hs bi lbi clbi =
withResponseFile
verbosity
defaultTempFileOptions
- (takeDirectory outFile)
+ mbWorkDir
+ (makeSymbolicPath $ takeDirectory outFile)
"hsc2hs-response.txt"
Nothing
pureArgs
( \responseFileName ->
- runProgram verbosity hsc2hsProg (prependCrossFlags ["@" ++ responseFileName])
+ runHsc2hs (prependCrossFlags ["@" ++ responseFileName])
)
- else runProgram verbosity hsc2hsProg (prependCrossFlags pureArgs)
+ else runHsc2hs (prependCrossFlags pureArgs)
}
where
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ u :: SymbolicPathX allowAbs Pkg to -> FilePath
+ u = interpretSymbolicPathCWD
+ mbWorkDir = mbWorkDirLBI lbi
+
-- Returns a list of command line arguments that can either be passed
-- directly, or via a response file.
genPureArgs :: Version -> ConfiguredProgram -> String -> String -> [String]
@@ -528,7 +545,7 @@ ppHsc2hs bi lbi clbi =
]
++ [ "--lflag=" ++ arg
| isOSX
- , opt <- PD.frameworks bi ++ concatMap Installed.frameworks pkgs
+ , opt <- map getSymbolicPath (PD.frameworks bi) ++ concatMap Installed.frameworks pkgs
, arg <- ["-framework", opt]
]
-- Note that on ELF systems, wherever we use -L, we must also use -R
@@ -538,8 +555,10 @@ ppHsc2hs bi lbi clbi =
++ ["--cflag=" ++ opt | opt <- platformDefines lbi]
-- Options from the current package:
- ++ ["--cflag=-I" ++ dir | dir <- PD.includeDirs bi]
- ++ ["--cflag=-I" ++ buildDir lbi </> dir | dir <- PD.includeDirs bi]
+ ++ ["--cflag=-I" ++ u dir | dir <- PD.includeDirs bi]
+ ++ [ "--cflag=-I" ++ u (buildDir lbi </> unsafeCoerceSymbolicPath relDir)
+ | relDir <- mapMaybe symbolicPathRelative_maybe $ PD.includeDirs bi
+ ]
++ [ "--cflag=" ++ opt
| opt <-
PD.ccOptions bi
@@ -555,19 +574,19 @@ ppHsc2hs bi lbi clbi =
]
++ [ "--cflag=" ++ opt
| opt <-
- [ "-I" ++ autogenComponentModulesDir lbi clbi
- , "-I" ++ autogenPackageModulesDir lbi
+ [ "-I" ++ u (autogenComponentModulesDir lbi clbi)
+ , "-I" ++ u (autogenPackageModulesDir lbi)
, "-include"
- , autogenComponentModulesDir lbi clbi </> cppHeaderName
+ , u $ autogenComponentModulesDir lbi clbi </> makeRelativePathEx cppHeaderName
]
]
- ++ [ "--lflag=-L" ++ opt
+ ++ [ "--lflag=-L" ++ u opt
| opt <-
if withFullyStaticExe lbi
then PD.extraLibDirsStatic bi
else PD.extraLibDirs bi
]
- ++ [ "--lflag=-Wl,-R," ++ opt
+ ++ [ "--lflag=-Wl,-R," ++ u opt
| isELF
, opt <-
if withFullyStaticExe lbi
@@ -643,9 +662,10 @@ ppHsc2hs bi lbi clbi =
_ -> error "No (or multiple) ghc rts package is registered!!"
ppHsc2hsExtras :: PreProcessorExtras
-ppHsc2hsExtras buildBaseDir =
- filter ("_hsc.c" `isSuffixOf`)
- `fmap` getDirectoryContentsRecursive buildBaseDir
+ppHsc2hsExtras mbWorkDir buildBaseDir = do
+ fs <- getDirectoryContentsRecursive $ interpretSymbolicPath mbWorkDir buildBaseDir
+ let hscCFiles = filter ("_hsc.c" `isSuffixOf`) fs
+ return $ map makeRelativePathEx hscCFiles
ppC2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs bi lbi clbi =
@@ -663,11 +683,11 @@ ppC2hs bi lbi clbi =
(orLaterVersion (mkVersion [0, 15]))
(withPrograms lbi)
(gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi)
- runProgram verbosity c2hsProg $
+ runProgramCwd verbosity mbWorkDir c2hsProg $
-- Options from the current package:
["--cpp=" ++ programPath gccProg, "--cppopts=-E"]
++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi]
- ++ ["--cppopts=-include" ++ (autogenComponentModulesDir lbi clbi </> cppHeaderName)]
+ ++ ["--cppopts=-include" ++ u (autogenComponentModulesDir lbi clbi </> makeRelativePathEx cppHeaderName)]
++ ["--include=" ++ outBaseDir]
-- Options from dependent packages
++ [ "--cppopts=" ++ opt
@@ -698,11 +718,17 @@ ppC2hs bi lbi clbi =
}
where
pkgs = PackageIndex.topologicalOrder (installedPkgs lbi)
+ mbWorkDir = mbWorkDirLBI lbi
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ u :: SymbolicPath Pkg to -> FilePath
+ u = interpretSymbolicPathCWD
ppC2hsExtras :: PreProcessorExtras
-ppC2hsExtras d =
- filter (\p -> takeExtensions p == ".chs.c")
- `fmap` getDirectoryContentsRecursive d
+ppC2hsExtras mbWorkDir buildBaseDir = do
+ fs <- getDirectoryContentsRecursive $ interpretSymbolicPath mbWorkDir buildBaseDir
+ return $
+ map makeRelativePathEx $
+ filter (\p -> takeExtensions p == ".chs.c") fs
-- TODO: perhaps use this with hsc2hs too
-- TODO: remove cc-options from cpphs for cabal-version: >= 1.10
@@ -713,7 +739,7 @@ getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]
getCppOptions bi lbi =
platformDefines lbi
++ cppOptions bi
- ++ ["-I" ++ dir | dir <- PD.includeDirs bi]
+ ++ ["-I" ++ getSymbolicPath dir | dir <- PD.includeDirs bi]
++ [opt | opt@('-' : c : _) <- PD.ccOptions bi ++ PD.cxxOptions bi, c `elem` "DIU"]
platformDefines :: LocalBuildInfo -> [String]
@@ -866,41 +892,37 @@ preprocessExtras
:: Verbosity
-> Component
-> LocalBuildInfo
- -> IO [FilePath]
+ -> IO [SymbolicPath Pkg File]
preprocessExtras verbosity comp lbi = case comp of
CLib _ -> pp $ buildDir lbi
- (CExe Executable{exeName = nm}) -> do
- let nm' = unUnqualComponentName nm
- pp $ buildDir lbi </> nm' </> nm' ++ "-tmp"
- (CFLib ForeignLib{foreignLibName = nm}) -> do
- let nm' = unUnqualComponentName nm
- pp $ buildDir lbi </> nm' </> nm' ++ "-tmp"
- CTest test -> do
- let nm' = unUnqualComponentName $ testName test
+ (CExe exe@Executable{}) -> pp $ exeBuildDir lbi exe
+ (CFLib flib@ForeignLib{}) -> pp $ flibBuildDir lbi flib
+ CTest test ->
case testInterface test of
- TestSuiteExeV10 _ _ ->
- pp $ buildDir lbi </> nm' </> nm' ++ "-tmp"
- TestSuiteLibV09 _ _ ->
- pp $ buildDir lbi </> stubName test </> stubName test ++ "-tmp"
TestSuiteUnsupported tt ->
dieWithException verbosity $ NoSupportPreProcessingTestExtras tt
- CBench bm -> do
- let nm' = unUnqualComponentName $ benchmarkName bm
+ _ -> pp $ testBuildDir lbi test
+ CBench bm ->
case benchmarkInterface bm of
- BenchmarkExeV10 _ _ ->
- pp $ buildDir lbi </> nm' </> nm' ++ "-tmp"
BenchmarkUnsupported tt ->
dieWithException verbosity $ NoSupportPreProcessingBenchmarkExtras tt
+ _ -> pp $ benchmarkBuildDir lbi bm
where
- pp :: FilePath -> IO [FilePath]
- pp dir = do
- b <- doesDirectoryExist dir
+ pp :: SymbolicPath Pkg (Dir Build) -> IO [SymbolicPath Pkg File]
+ pp builddir = do
+ -- Use the build dir as a source dir.
+ let dir :: SymbolicPath Pkg (Dir Source)
+ dir = coerceSymbolicPath builddir
+ mbWorkDir = mbWorkDirLBI lbi
+ b <- doesDirectoryExist (interpretSymbolicPathLBI lbi dir)
if b
- then
- (map (dir </>) . filter not_sub . concat)
- <$> for
- knownExtrasHandlers
- (withLexicalCallStack (\f -> f dir))
+ then do
+ xs <- for knownExtrasHandlers $ withLexicalCallStack $ \f -> f mbWorkDir dir
+ let not_subs =
+ map (dir </>) $
+ filter (not_sub . getSymbolicPath) $
+ concat xs
+ return not_subs
else pure []
-- TODO: This is a terrible hack to work around #3545 while we don't
-- reorganize the directory layout. Basically, for the main
diff --git a/Cabal/src/Distribution/Simple/PreProcess/Types.hs b/Cabal/src/Distribution/Simple/PreProcess/Types.hs
index 02a5bdbc53..5315d3b1ac 100644
--- a/Cabal/src/Distribution/Simple/PreProcess/Types.hs
+++ b/Cabal/src/Distribution/Simple/PreProcess/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -28,6 +29,7 @@ import Prelude ()
import Distribution.ModuleName (ModuleName)
import Distribution.Pretty
+import Distribution.Utils.Path
import Distribution.Verbosity
import qualified Text.PrettyPrint as Disp
@@ -78,7 +80,7 @@ data PreProcessor = PreProcessor
ppOrdering
:: Verbosity
- -> [FilePath] -- Source directories
+ -> [SymbolicPath Pkg (Dir Source)] -- Source directories
-> [ModuleName] -- Module names
-> IO [ModuleName] -- Sorted modules
diff --git a/Cabal/src/Distribution/Simple/Program.hs b/Cabal/src/Distribution/Simple/Program.hs
index 4514bc0fd9..f5a609f3b7 100644
--- a/Cabal/src/Distribution/Simple/Program.hs
+++ b/Cabal/src/Distribution/Simple/Program.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -51,6 +52,7 @@ module Distribution.Simple.Program
, ProgArg
, ProgramLocation (..)
, runProgram
+ , runProgramCwd
, getProgramOutput
, suppressOverrideArgs
@@ -93,7 +95,9 @@ module Distribution.Simple.Program
, requireProgramVersion
, needProgram
, runDbProgram
+ , runDbProgramCwd
, getDbProgramOutput
+ , getDbProgramOutputCwd
-- * Programs that Cabal knows about
, ghcProgram
@@ -132,6 +136,7 @@ import Distribution.Simple.Program.Find
import Distribution.Simple.Program.Run
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Verbosity
-- | Runs the given configured program.
@@ -146,6 +151,20 @@ runProgram
runProgram verbosity prog args =
runProgramInvocation verbosity (programInvocation prog args)
+-- | Runs the given configured program.
+runProgramCwd
+ :: Verbosity
+ -- ^ Verbosity
+ -> Maybe (SymbolicPath CWD (Dir to))
+ -- ^ Working directory
+ -> ConfiguredProgram
+ -- ^ The program to run
+ -> [ProgArg]
+ -- ^ Any /extra/ arguments to add
+ -> IO ()
+runProgramCwd verbosity mbWorkDir prog args =
+ runProgramInvocation verbosity (programInvocationCwd mbWorkDir prog args)
+
-- | Runs the given configured program and gets the output.
getProgramOutput
:: Verbosity
@@ -169,11 +188,27 @@ runDbProgram
-> [ProgArg]
-- ^ Any /extra/ arguments to add
-> IO ()
-runDbProgram verbosity prog programDb args =
+runDbProgram verbosity prog progDb args =
+ runDbProgramCwd verbosity Nothing prog progDb args
+
+-- | Looks up the given program in the program database and runs it.
+runDbProgramCwd
+ :: Verbosity
+ -- ^ verbosity
+ -> Maybe (SymbolicPath CWD (Dir to))
+ -- ^ working directory
+ -> Program
+ -- ^ The program to run
+ -> ProgramDb
+ -- ^ look up the program here
+ -> [ProgArg]
+ -- ^ Any /extra/ arguments to add
+ -> IO ()
+runDbProgramCwd verbosity mbWorkDir prog programDb args =
case lookupProgram prog programDb of
Nothing ->
dieWithException verbosity $ ProgramNotFound (programName prog)
- Just configuredProg -> runProgram verbosity configuredProg args
+ Just configuredProg -> runProgramCwd verbosity mbWorkDir configuredProg args
-- | Looks up the given program in the program database and runs it.
getDbProgramOutput
@@ -186,7 +221,25 @@ getDbProgramOutput
-> [ProgArg]
-- ^ Any /extra/ arguments to add
-> IO String
-getDbProgramOutput verbosity prog programDb args =
+getDbProgramOutput verb prog progDb args =
+ getDbProgramOutputCwd verb Nothing prog progDb args
+
+-- | Looks up the given program in the program database and runs it.
+getDbProgramOutputCwd
+ :: Verbosity
+ -- ^ verbosity
+ -> Maybe (SymbolicPath CWD (Dir to))
+ -- ^ working directory
+ -> Program
+ -- ^ The program to run
+ -> ProgramDb
+ -- ^ look up the program here
+ -> [ProgArg]
+ -- ^ Any /extra/ arguments to add
+ -> IO String
+getDbProgramOutputCwd verbosity mbWorkDir prog programDb args =
case lookupProgram prog programDb of
Nothing -> dieWithException verbosity $ ProgramNotFound (programName prog)
- Just configuredProg -> getProgramOutput verbosity configuredProg args
+ Just configuredProg ->
+ getProgramInvocationOutput verbosity $
+ programInvocationCwd mbWorkDir configuredProg args
diff --git a/Cabal/src/Distribution/Simple/Program/Ar.hs b/Cabal/src/Distribution/Simple/Program/Ar.hs
index b5d1cfe65e..004b02cca1 100644
--- a/Cabal/src/Distribution/Simple/Program/Ar.hs
+++ b/Cabal/src/Distribution/Simple/Program/Ar.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -25,10 +26,7 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Distribution.Compat.CopyFile (filesEqual)
import Distribution.Simple.Compiler (arDashLSupported, arResponseFilesSupported)
-import Distribution.Simple.Flag
- ( fromFlagOrDefault
- )
-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..))
+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..), mbWorkDirLBI)
import Distribution.Simple.Program
( ProgramInvocation
, arProgram
@@ -39,29 +37,32 @@ import Distribution.Simple.Program.ResponseFile
)
import Distribution.Simple.Program.Run
( multiStageProgramInvocation
- , programInvocation
+ , programInvocationCwd
, runProgramInvocation
)
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Config
( configUseResponseFiles
)
import Distribution.Simple.Utils
( defaultTempFileOptions
, dieWithLocation'
- , withTempDirectory
+ , withTempDirectoryCwd
)
import Distribution.System
( Arch (..)
, OS (..)
, Platform (..)
)
+import Distribution.Utils.Path
import Distribution.Verbosity
( Verbosity
, deafening
, verbose
)
+
import System.Directory (doesFileExist, renameFile)
-import System.FilePath (splitFileName, (</>))
+import System.FilePath (splitFileName)
import System.IO
( Handle
, IOMode (ReadWriteMode)
@@ -75,14 +76,21 @@ import System.IO
createArLibArchive
:: Verbosity
-> LocalBuildInfo
- -> FilePath
- -> [FilePath]
+ -> SymbolicPath Pkg File
+ -> [SymbolicPath Pkg File]
-> IO ()
createArLibArchive verbosity lbi targetPath files = do
- (ar, _) <- requireProgram verbosity arProgram progDb
-
- let (targetDir, targetName) = splitFileName targetPath
- withTempDirectory verbosity targetDir "objs" $ \tmpDir -> do
+ (arProg, _) <- requireProgram verbosity arProgram progDb
+
+ let (targetDir0, targetName0) = splitFileName $ getSymbolicPath targetPath
+ targetDir = makeSymbolicPath targetDir0
+ targetName = makeRelativePathEx targetName0
+ mbWorkDir = mbWorkDirLBI lbi
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ i = interpretSymbolicPath mbWorkDir
+ u :: SymbolicPath Pkg to -> FilePath
+ u = interpretSymbolicPathCWD
+ withTempDirectoryCwd verbosity mbWorkDir targetDir "objs" $ \tmpDir -> do
let tmpPath = tmpDir </> targetName
-- The args to use with "ar" are actually rather subtle and system-dependent.
@@ -105,7 +113,8 @@ createArLibArchive verbosity lbi targetPath files = do
-- When we need to call ar multiple times we use "ar q" and for the last
-- call on OSX we use "ar qs" so that it'll make the index.
- let simpleArgs = case hostOS of
+ let simpleArgs, initialArgs, finalArgs :: [String]
+ simpleArgs = case hostOS of
OSX -> ["-r", "-s"]
_ | dashLSupported -> ["-qL"]
_ -> ["-r"]
@@ -116,12 +125,13 @@ createArLibArchive verbosity lbi targetPath files = do
_ | dashLSupported -> ["-qL"]
_ -> ["-q"]
- extraArgs = verbosityOpts verbosity ++ [tmpPath]
+ extraArgs = verbosityOpts verbosity ++ [u tmpPath]
- simple = programInvocation ar (simpleArgs ++ extraArgs)
- initial = programInvocation ar (initialArgs ++ extraArgs)
+ ar = programInvocationCwd mbWorkDir arProg
+ simple = ar (simpleArgs ++ extraArgs)
+ initial = ar (initialArgs ++ extraArgs)
middle = initial
- final = programInvocation ar (finalArgs ++ extraArgs)
+ final = ar (finalArgs ++ extraArgs)
oldVersionManualOverride =
fromFlagOrDefault False $ configUseResponseFiles $ configFlags lbi
@@ -130,10 +140,9 @@ createArLibArchive verbosity lbi targetPath files = do
dashLSupported =
arDashLSupported (compiler lbi)
- invokeWithResponesFile :: FilePath -> ProgramInvocation
- invokeWithResponesFile atFile =
- programInvocation ar $
- simpleArgs ++ extraArgs ++ ['@' : atFile]
+ invokeWithResponseFile :: FilePath -> ProgramInvocation
+ invokeWithResponseFile atFile =
+ (ar $ simpleArgs ++ extraArgs ++ ['@' : atFile])
if oldVersionManualOverride || responseArgumentsNotSupported
then
@@ -143,18 +152,18 @@ createArLibArchive verbosity lbi targetPath files = do
multiStageProgramInvocation
simple
(initial, middle, final)
- files
+ (map getSymbolicPath files)
]
- else withResponseFile verbosity defaultTempFileOptions tmpDir "ar.rsp" Nothing files $
- \path -> runProgramInvocation verbosity $ invokeWithResponesFile path
+ else withResponseFile verbosity defaultTempFileOptions mbWorkDir tmpDir "ar.rsp" Nothing (map getSymbolicPath files) $
+ \path -> runProgramInvocation verbosity $ invokeWithResponseFile path
unless
( hostArch == Arm -- See #1537
|| hostOS == AIX
)
- $ wipeMetadata verbosity tmpPath -- AIX uses its own "ar" format variant
- equal <- filesEqual tmpPath targetPath
- unless equal $ renameFile tmpPath targetPath
+ $ wipeMetadata verbosity (i tmpPath) -- AIX uses its own "ar" format variant
+ equal <- filesEqual (i tmpPath) (i targetPath)
+ unless equal $ renameFile (i tmpPath) (i targetPath)
where
progDb = withPrograms lbi
Platform hostArch hostOS = hostPlatform lbi
diff --git a/Cabal/src/Distribution/Simple/Program/GHC.hs b/Cabal/src/Distribution/Simple/Program/GHC.hs
index 9fa70feb5a..84d6b0ccfa 100644
--- a/Cabal/src/Distribution/Simple/Program/GHC.hs
+++ b/Cabal/src/Distribution/Simple/Program/GHC.hs
@@ -1,8 +1,10 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
module Distribution.Simple.Program.GHC
( GhcOptions (..)
@@ -33,16 +35,18 @@ import Distribution.Simple.Program.Run
import Distribution.Simple.Program.Types
import Distribution.System
import Distribution.Types.ComponentId
+import Distribution.Types.ParStrat
import Distribution.Utils.NubList
+import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
+
import Language.Haskell.Extension
import Data.List (stripPrefix)
import qualified Data.Map as Map
import Data.Monoid (All (..), Any (..), Endo (..))
import qualified Data.Set as Set
-import Distribution.Types.ParStrat
normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
normaliseGhcArgs (Just ghcVersion) PackageDescription{..} ghcArgs
@@ -398,13 +402,13 @@ data GhcOptions = GhcOptions
, -----------------------
-- Inputs and outputs
- ghcOptInputFiles :: NubListR FilePath
+ ghcOptInputFiles :: NubListR (SymbolicPath Pkg File)
-- ^ The main input files; could be .hs, .hi, .c, .o, depending on mode.
- , ghcOptInputScripts :: NubListR FilePath
+ , ghcOptInputScripts :: NubListR (SymbolicPath Pkg File)
-- ^ Script files with irregular extensions that need -x hs.
, ghcOptInputModules :: NubListR ModuleName
-- ^ The names of input Haskell modules, mainly for @--make@ mode.
- , ghcOptOutputFile :: Flag FilePath
+ , ghcOptOutputFile :: Flag (SymbolicPath Pkg File)
-- ^ Location for output file; the @ghc -o@ flag.
, ghcOptOutputDynFile :: Flag FilePath
-- ^ Location for dynamic output file in 'GhcStaticAndDynamic' mode;
@@ -412,7 +416,7 @@ data GhcOptions = GhcOptions
, ghcOptSourcePathClear :: Flag Bool
-- ^ Start with an empty search path for Haskell source files;
-- the @ghc -i@ flag (@-i@ on its own with no path argument).
- , ghcOptSourcePath :: NubListR FilePath
+ , ghcOptSourcePath :: NubListR (SymbolicPath Pkg (Dir Source))
-- ^ Search path for Haskell source files; the @ghc -i@ flag.
, -------------
-- Packages
@@ -453,13 +457,13 @@ data GhcOptions = GhcOptions
ghcOptLinkLibs :: [FilePath]
-- ^ Names of libraries to link in; the @ghc -l@ flag.
- , ghcOptLinkLibPath :: NubListR FilePath
+ , ghcOptLinkLibPath :: NubListR (SymbolicPath Pkg (Dir Lib))
-- ^ Search path for libraries to link in; the @ghc -L@ flag.
, ghcOptLinkOptions :: [String]
-- ^ Options to pass through to the linker; the @ghc -optl@ flag.
, ghcOptLinkFrameworks :: NubListR String
-- ^ OSX only: frameworks to link in; the @ghc -framework@ flag.
- , ghcOptLinkFrameworkDirs :: NubListR String
+ , ghcOptLinkFrameworkDirs :: NubListR (SymbolicPath Pkg (Dir Framework))
-- ^ OSX only: Search path for frameworks to link in; the
-- @ghc -framework-path@ flag.
, ghcOptLinkRts :: Flag Bool
@@ -482,9 +486,9 @@ data GhcOptions = GhcOptions
-- ^ Options to pass through to the Assembler.
, ghcOptCppOptions :: [String]
-- ^ Options to pass through to CPP; the @ghc -optP@ flag.
- , ghcOptCppIncludePath :: NubListR FilePath
+ , ghcOptCppIncludePath :: NubListR (SymbolicPath Pkg (Dir Include))
-- ^ Search path for CPP includes like header files; the @ghc -I@ flag.
- , ghcOptCppIncludes :: NubListR FilePath
+ , ghcOptCppIncludes :: NubListR (SymbolicPath Pkg File)
-- ^ Extra header files to include at CPP stage; the @ghc -optP-include@ flag.
, ghcOptFfiIncludes :: NubListR FilePath
-- ^ Extra header files to include for old-style FFI; the @ghc -#include@ flag.
@@ -517,7 +521,7 @@ data GhcOptions = GhcOptions
-- ^ Use the \"split object files\" feature; the @ghc -split-objs@ flag.
, ghcOptNumJobs :: Flag ParStrat
-- ^ Run N jobs simultaneously (if possible).
- , ghcOptHPCDir :: Flag FilePath
+ , ghcOptHPCDir :: Flag (SymbolicPath Pkg (Dir Mix))
-- ^ Enable coverage analysis; the @ghc -fhpc -hpcdir@ flags.
, ----------------
-- GHCi
@@ -533,11 +537,11 @@ data GhcOptions = GhcOptions
-- ^ only in 'GhcStaticAndDynamic' mode
, ghcOptDynObjSuffix :: Flag String
-- ^ only in 'GhcStaticAndDynamic' mode
- , ghcOptHiDir :: Flag FilePath
- , ghcOptHieDir :: Flag FilePath
- , ghcOptObjDir :: Flag FilePath
- , ghcOptOutputDir :: Flag FilePath
- , ghcOptStubDir :: Flag FilePath
+ , ghcOptHiDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
+ , ghcOptHieDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
+ , ghcOptObjDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
+ , ghcOptOutputDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
+ , ghcOptStubDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
, --------------------
-- Creating libraries
@@ -552,7 +556,7 @@ data GhcOptions = GhcOptions
ghcOptVerbosity :: Flag Verbosity
-- ^ Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag.
- , ghcOptExtraPath :: NubListR FilePath
+ , ghcOptExtraPath :: NubListR (SymbolicPath Pkg (Dir Build))
-- ^ Put the extra folders in the PATH environment variable we invoke
-- GHC with
, ghcOptCabal :: Flag Bool
@@ -612,27 +616,38 @@ runGHC
-> ConfiguredProgram
-> Compiler
-> Platform
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> GhcOptions
-> IO ()
-runGHC verbosity ghcProg comp platform opts = do
- runProgramInvocation verbosity =<< ghcInvocation verbosity ghcProg comp platform opts
+runGHC verbosity ghcProg comp platform mbWorkDir opts = do
+ runProgramInvocation verbosity
+ =<< ghcInvocation verbosity ghcProg comp platform mbWorkDir opts
ghcInvocation
:: Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> GhcOptions
-> IO ProgramInvocation
-ghcInvocation verbosity ghcProg comp platform opts = do
+ghcInvocation verbosity ghcProg comp platform mbWorkDir opts = do
-- NOTE: GHC is the only program whose path we modify with more values than
-- the standard @extra-prog-path@, namely the folders of the executables in
-- the components, see @componentGhcOptions@.
let envOverrides = programOverrideEnv ghcProg
- extraPath <- getExtraPathEnv verbosity envOverrides (fromNubListR (ghcOptExtraPath opts))
+ extraPath <-
+ getExtraPathEnv verbosity envOverrides $
+ map getSymbolicPath $
+ fromNubListR $
+ ghcOptExtraPath opts
let ghcProg' = ghcProg{programOverrideEnv = envOverrides ++ extraPath}
+ return $
+ programInvocationCwd mbWorkDir ghcProg' $
+ renderGhcOptions comp platform opts
- pure $ programInvocation ghcProg' (renderGhcOptions comp platform opts)
+-- TODO: use the -working-dir GHC flag instead of setting the process
+-- working directory, as this improves error messages.
renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String]
renderGhcOptions comp _platform@(Platform _arch os) opts
@@ -697,7 +712,7 @@ renderGhcOptions comp _platform@(Platform _arch os) opts
, ["-split-objs" | flagBool ghcOptSplitObjs]
, case flagToMaybe (ghcOptHPCDir opts) of
Nothing -> []
- Just hpcdir -> ["-fhpc", "-hpcdir", hpcdir]
+ Just hpcdir -> ["-fhpc", "-hpcdir", u hpcdir]
, if parmakeSupported comp
then case ghcOptNumJobs opts of
NoFlag -> []
@@ -727,25 +742,25 @@ renderGhcOptions comp _platform@(Platform _arch os) opts
, concat [["-hisuf", suf] | suf <- flag ghcOptHiSuffix]
, concat [["-dynosuf", suf] | suf <- flag ghcOptDynObjSuffix]
, concat [["-dynhisuf", suf] | suf <- flag ghcOptDynHiSuffix]
- , concat [["-outputdir", dir] | dir <- flag ghcOptOutputDir]
- , concat [["-odir", dir] | dir <- flag ghcOptObjDir]
- , concat [["-hidir", dir] | dir <- flag ghcOptHiDir]
- , concat [["-hiedir", dir] | dir <- flag ghcOptHieDir]
- , concat [["-stubdir", dir] | dir <- flag ghcOptStubDir]
+ , concat [["-outputdir", u dir] | dir <- flag ghcOptOutputDir]
+ , concat [["-odir", u dir] | dir <- flag ghcOptObjDir]
+ , concat [["-hidir", u dir] | dir <- flag ghcOptHiDir]
+ , concat [["-hiedir", u dir] | dir <- flag ghcOptHieDir]
+ , concat [["-stubdir", u dir] | dir <- flag ghcOptStubDir]
, -----------------------
-- Source search path
["-i" | flagBool ghcOptSourcePathClear]
- , ["-i" ++ dir | dir <- flags ghcOptSourcePath]
+ , ["-i" ++ u dir | dir <- flags ghcOptSourcePath]
, --------------------
--------------------
-- CPP, C, and C++ stuff
- ["-I" ++ dir | dir <- flags ghcOptCppIncludePath]
+ ["-I" ++ u dir | dir <- flags ghcOptCppIncludePath]
, ["-optP" ++ opt | opt <- ghcOptCppOptions opts]
, concat
- [ ["-optP-include", "-optP" ++ inc]
+ [ ["-optP-include", "-optP" ++ u inc]
| inc <- flags ghcOptCppIncludes
]
, ["-optc" ++ opt | opt <- ghcOptCcOptions opts]
@@ -761,7 +776,7 @@ renderGhcOptions comp _platform@(Platform _arch os) opts
["-optl" ++ opt | opt <- ghcOptLinkOptions opts]
, ["-l" ++ lib | lib <- ghcOptLinkLibs opts]
- , ["-L" ++ dir | dir <- flags ghcOptLinkLibPath]
+ , ["-L" ++ u dir | dir <- flags ghcOptLinkLibPath]
, if isOSX
then
concat
@@ -772,7 +787,7 @@ renderGhcOptions comp _platform@(Platform _arch os) opts
, if isOSX
then
concat
- [ ["-framework-path", path]
+ [ ["-framework-path", u path]
| path <- flags ghcOptLinkFrameworkDirs
]
else []
@@ -851,10 +866,10 @@ renderGhcOptions comp _platform@(Platform _arch os) opts
-- Specify the input file(s) first, so that in ghci the `main-is` module is
-- in scope instead of the first module defined in `other-modules`.
- flags ghcOptInputFiles
- , concat [["-x", "hs", script] | script <- flags ghcOptInputScripts]
+ map u $ flags ghcOptInputFiles
+ , concat [["-x", "hs", u script] | script <- flags ghcOptInputScripts]
, [prettyShow modu | modu <- flags ghcOptInputModules]
- , concat [["-o", out] | out <- flag ghcOptOutputFile]
+ , concat [["-o", u out] | out <- flag ghcOptOutputFile]
, concat [["-dyno", out] | out <- flag ghcOptOutputDynFile]
, ---------------
-- Extra
@@ -862,6 +877,9 @@ renderGhcOptions comp _platform@(Platform _arch os) opts
ghcOptExtra opts
]
where
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ u :: SymbolicPath Pkg to -> FilePath
+ u = interpretSymbolicPathCWD
implInfo = getImplInfo comp
isOSX = os == OSX
flag flg = flagToList (flg opts)
diff --git a/Cabal/src/Distribution/Simple/Program/HcPkg.hs b/Cabal/src/Distribution/Simple/Program/HcPkg.hs
index eb3430fb50..710020d9f6 100644
--- a/Cabal/src/Distribution/Simple/Program/HcPkg.hs
+++ b/Cabal/src/Distribution/Simple/Program/HcPkg.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
@@ -58,10 +59,16 @@ import Distribution.Simple.Utils
import Distribution.Types.ComponentId
import Distribution.Types.PackageId
import Distribution.Types.UnitId
+import Distribution.Utils.Path
import Distribution.Verbosity
import Data.List (stripPrefix)
-import System.FilePath as FilePath (isPathSeparator, joinPath, splitDirectories, splitPath, (<.>), (</>))
+import System.FilePath as FilePath
+ ( isPathSeparator
+ , joinPath
+ , splitDirectories
+ , splitPath
+ )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
@@ -103,12 +110,18 @@ init hpi verbosity preferCompat path
-- | Run @hc-pkg@ using a given package DB stack, directly forwarding the
-- provided command-line arguments to it.
-invoke :: HcPkgInfo -> Verbosity -> PackageDBStack -> [String] -> IO ()
-invoke hpi verbosity dbStack extraArgs =
+invoke
+ :: HcPkgInfo
+ -> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> PackageDBStack
+ -> [String]
+ -> IO ()
+invoke hpi verbosity mbWorkDir dbStack extraArgs =
runProgramInvocation verbosity invocation
where
args = packageDbStackOpts hpi dbStack ++ extraArgs
- invocation = programInvocation (hcPkgProgram hpi) args
+ invocation = programInvocationCwd mbWorkDir (hcPkgProgram hpi) args
-- | Additional variations in the behaviour for 'register'.
data RegisterOptions = RegisterOptions
@@ -141,11 +154,12 @@ defaultRegisterOptions =
register
:: HcPkgInfo
-> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
-register hpi verbosity packagedbs pkgInfo registerOptions
+register hpi verbosity mbWorkDir packagedbs pkgInfo registerOptions
| registerMultiInstance registerOptions
, not (nativeMultiInstance hpi || recacheMultiInstance hpi) =
dieWithException verbosity RegMultipleInstancePkg
@@ -166,11 +180,11 @@ register hpi verbosity packagedbs pkgInfo registerOptions
do
let pkgdb = registrationPackageDB packagedbs
writeRegistrationFileDirectly verbosity hpi pkgdb pkgInfo
- recache hpi verbosity pkgdb
+ recache hpi verbosity mbWorkDir pkgdb
| otherwise =
runProgramInvocation
verbosity
- (registerInvocation hpi verbosity packagedbs pkgInfo registerOptions)
+ (registerInvocation hpi verbosity mbWorkDir packagedbs pkgInfo registerOptions)
writeRegistrationFileDirectly
:: Verbosity
@@ -193,39 +207,51 @@ writeRegistrationFileDirectly verbosity _ _ _ =
-- | Call @hc-pkg@ to unregister a package
--
-- > hc-pkg unregister [pkgid] [--user | --global | --package-db]
-unregister :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO ()
-unregister hpi verbosity packagedb pkgid =
+unregister :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageId -> IO ()
+unregister hpi verbosity mbWorkDir packagedb pkgid =
runProgramInvocation
verbosity
- (unregisterInvocation hpi verbosity packagedb pkgid)
+ (unregisterInvocation hpi verbosity mbWorkDir packagedb pkgid)
-- | Call @hc-pkg@ to recache the registered packages.
--
-- > hc-pkg recache [--user | --global | --package-db]
-recache :: HcPkgInfo -> Verbosity -> PackageDB -> IO ()
-recache hpi verbosity packagedb =
+recache :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> IO ()
+recache hpi verbosity mbWorkDir packagedb =
runProgramInvocation
verbosity
- (recacheInvocation hpi verbosity packagedb)
+ (recacheInvocation hpi verbosity mbWorkDir packagedb)
-- | Call @hc-pkg@ to expose a package.
--
-- > hc-pkg expose [pkgid] [--user | --global | --package-db]
-expose :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO ()
-expose hpi verbosity packagedb pkgid =
+expose
+ :: HcPkgInfo
+ -> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> PackageDB
+ -> PackageId
+ -> IO ()
+expose hpi verbosity mbWorkDir packagedb pkgid =
runProgramInvocation
verbosity
- (exposeInvocation hpi verbosity packagedb pkgid)
+ (exposeInvocation hpi verbosity mbWorkDir packagedb pkgid)
-- | Call @hc-pkg@ to retrieve a specific package
--
-- > hc-pkg describe [pkgid] [--user | --global | --package-db]
-describe :: HcPkgInfo -> Verbosity -> PackageDBStack -> PackageId -> IO [InstalledPackageInfo]
-describe hpi verbosity packagedb pid = do
+describe
+ :: HcPkgInfo
+ -> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> PackageDBStack
+ -> PackageId
+ -> IO [InstalledPackageInfo]
+describe hpi verbosity mbWorkDir packagedb pid = do
output <-
getProgramInvocationLBS
verbosity
- (describeInvocation hpi verbosity packagedb pid)
+ (describeInvocation hpi verbosity mbWorkDir packagedb pid)
`catchIO` \_ -> return mempty
case parsePackages output of
@@ -235,20 +261,31 @@ describe hpi verbosity packagedb pid = do
-- | Call @hc-pkg@ to hide a package.
--
-- > hc-pkg hide [pkgid] [--user | --global | --package-db]
-hide :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO ()
-hide hpi verbosity packagedb pkgid =
+hide
+ :: HcPkgInfo
+ -> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> PackageDB
+ -> PackageId
+ -> IO ()
+hide hpi verbosity mbWorkDir packagedb pkgid =
runProgramInvocation
verbosity
- (hideInvocation hpi verbosity packagedb pkgid)
+ (hideInvocation hpi verbosity mbWorkDir packagedb pkgid)
-- | Call @hc-pkg@ to get all the details of all the packages in the given
-- package database.
-dump :: HcPkgInfo -> Verbosity -> PackageDB -> IO [InstalledPackageInfo]
-dump hpi verbosity packagedb = do
+dump
+ :: HcPkgInfo
+ -> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> PackageDB
+ -> IO [InstalledPackageInfo]
+dump hpi verbosity mbWorkDir packagedb = do
output <-
getProgramInvocationLBS
verbosity
- (dumpInvocation hpi verbosity packagedb)
+ (dumpInvocation hpi verbosity mbWorkDir packagedb)
`catchIO` \e ->
dieWithException verbosity $ DumpFailed (programId (hcPkgProgram hpi)) (displayException e)
@@ -364,13 +401,14 @@ setUnitId pkginfo = pkginfo
list
:: HcPkgInfo
-> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDB
-> IO [PackageId]
-list hpi verbosity packagedb = do
+list hpi verbosity mbWorkDir packagedb = do
output <-
getProgramInvocationOutput
verbosity
- (listInvocation hpi verbosity packagedb)
+ (listInvocation hpi verbosity mbWorkDir packagedb)
`catchIO` \_ -> dieWithException verbosity $ ListFailed (programId (hcPkgProgram hpi))
case parsePackageIds output of
@@ -394,12 +432,13 @@ initInvocation hpi verbosity path =
registerInvocation
:: HcPkgInfo
-> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> ProgramInvocation
-registerInvocation hpi verbosity packagedbs pkgInfo registerOptions =
- (programInvocation (hcPkgProgram hpi) (args "-"))
+registerInvocation hpi verbosity mbWorkDir packagedbs pkgInfo registerOptions =
+ (programInvocationCwd mbWorkDir (hcPkgProgram hpi) (args "-"))
{ progInvokeInput = Just $ IODataText $ showInstalledPackageInfo pkgInfo
, progInvokeInputEncoding = IOEncodingUTF8
}
@@ -423,43 +462,47 @@ registerInvocation hpi verbosity packagedbs pkgInfo registerOptions =
unregisterInvocation
:: HcPkgInfo
-> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDB
-> PackageId
-> ProgramInvocation
-unregisterInvocation hpi verbosity packagedb pkgid =
- programInvocation (hcPkgProgram hpi) $
+unregisterInvocation hpi verbosity mbWorkDir packagedb pkgid =
+ programInvocationCwd mbWorkDir (hcPkgProgram hpi) $
["unregister", packageDbOpts hpi packagedb, prettyShow pkgid]
++ verbosityOpts hpi verbosity
recacheInvocation
:: HcPkgInfo
-> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDB
-> ProgramInvocation
-recacheInvocation hpi verbosity packagedb =
- programInvocation (hcPkgProgram hpi) $
+recacheInvocation hpi verbosity mbWorkDir packagedb =
+ programInvocationCwd mbWorkDir (hcPkgProgram hpi) $
["recache", packageDbOpts hpi packagedb]
++ verbosityOpts hpi verbosity
exposeInvocation
:: HcPkgInfo
-> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDB
-> PackageId
-> ProgramInvocation
-exposeInvocation hpi verbosity packagedb pkgid =
- programInvocation (hcPkgProgram hpi) $
+exposeInvocation hpi verbosity mbWorkDir packagedb pkgid =
+ programInvocationCwd mbWorkDir (hcPkgProgram hpi) $
["expose", packageDbOpts hpi packagedb, prettyShow pkgid]
++ verbosityOpts hpi verbosity
describeInvocation
:: HcPkgInfo
-> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDBStack
-> PackageId
-> ProgramInvocation
-describeInvocation hpi verbosity packagedbs pkgid =
- programInvocation (hcPkgProgram hpi) $
+describeInvocation hpi verbosity mbWorkDir packagedbs pkgid =
+ programInvocationCwd mbWorkDir (hcPkgProgram hpi) $
["describe", prettyShow pkgid]
++ packageDbStackOpts hpi packagedbs
++ verbosityOpts hpi verbosity
@@ -467,17 +510,23 @@ describeInvocation hpi verbosity packagedbs pkgid =
hideInvocation
:: HcPkgInfo
-> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDB
-> PackageId
-> ProgramInvocation
-hideInvocation hpi verbosity packagedb pkgid =
- programInvocation (hcPkgProgram hpi) $
+hideInvocation hpi verbosity mbWorkDir packagedb pkgid =
+ programInvocationCwd mbWorkDir (hcPkgProgram hpi) $
["hide", packageDbOpts hpi packagedb, prettyShow pkgid]
++ verbosityOpts hpi verbosity
-dumpInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
-dumpInvocation hpi _verbosity packagedb =
- (programInvocation (hcPkgProgram hpi) args)
+dumpInvocation
+ :: HcPkgInfo
+ -> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> PackageDB
+ -> ProgramInvocation
+dumpInvocation hpi _verbosity mbWorkDir packagedb =
+ (programInvocationCwd mbWorkDir (hcPkgProgram hpi) args)
{ progInvokeOutputEncoding = IOEncodingUTF8
}
where
@@ -488,9 +537,14 @@ dumpInvocation hpi _verbosity packagedb =
-- We use verbosity level 'silent' because it is important that we
-- do not contaminate the output with info/debug messages.
-listInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
-listInvocation hpi _verbosity packagedb =
- (programInvocation (hcPkgProgram hpi) args)
+listInvocation
+ :: HcPkgInfo
+ -> Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> PackageDB
+ -> ProgramInvocation
+listInvocation hpi _verbosity mbWorkDir packagedb =
+ (programInvocationCwd mbWorkDir (hcPkgProgram hpi) args)
{ progInvokeOutputEncoding = IOEncodingUTF8
}
where
diff --git a/Cabal/src/Distribution/Simple/Program/Hpc.hs b/Cabal/src/Distribution/Simple/Program/Hpc.hs
index 0fb210e72e..c508900814 100644
--- a/Cabal/src/Distribution/Simple/Program/Hpc.hs
+++ b/Cabal/src/Distribution/Simple/Program/Hpc.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -19,13 +20,12 @@ module Distribution.Simple.Program.Hpc
import Distribution.Compat.Prelude
import Prelude ()
-import System.Directory (makeRelativeToCurrentDirectory)
-
import Distribution.ModuleName
import Distribution.Pretty
import Distribution.Simple.Program.Run
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
@@ -37,19 +37,20 @@ import Distribution.Version
-- library as a dependency can still work, but those that include the library
-- modules directly (in other-modules) don't.
markup
- :: ConfiguredProgram
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> ConfiguredProgram
-> Version
-> Verbosity
- -> FilePath
+ -> SymbolicPath Pkg File
-- ^ Path to .tix file
- -> [FilePath]
+ -> [SymbolicPath Pkg (Dir Mix)]
-- ^ Paths to .mix file directories
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
-- ^ Path where html output should be located
-> [ModuleName]
-- ^ List of modules to include in the report
-> IO ()
-markup hpc hpcVer verbosity tixFile hpcDirs destDir included = do
+markup mbWorkDir hpc hpcVer verbosity tixFile hpcDirs destDir included = do
hpcDirs' <-
if withinRange hpcVer (orLaterVersion version07)
then return hpcDirs
@@ -69,69 +70,72 @@ markup hpc hpcVer verbosity tixFile hpcDirs destDir included = do
return passedDirs
-- Prior to GHC 8.0, hpc assumes all .mix paths are relative.
- hpcDirs'' <- traverse makeRelativeToCurrentDirectory hpcDirs'
+ hpcDirs'' <- traverse (tryMakeRelativeToWorkingDir mbWorkDir) hpcDirs'
runProgramInvocation
verbosity
- (markupInvocation hpc tixFile hpcDirs'' destDir included)
+ (markupInvocation mbWorkDir hpc tixFile hpcDirs'' destDir included)
where
version07 = mkVersion [0, 7]
(passedDirs, droppedDirs) = splitAt 1 hpcDirs
markupInvocation
- :: ConfiguredProgram
- -> FilePath
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> ConfiguredProgram
+ -> SymbolicPath Pkg File
-- ^ Path to .tix file
- -> [FilePath]
+ -> [SymbolicPath Pkg (Dir Mix)]
-- ^ Paths to .mix file directories
- -> FilePath
+ -> SymbolicPath Pkg (Dir Artifacts)
-- ^ Path where html output should be
-- located
-> [ModuleName]
-- ^ List of modules to include
-> ProgramInvocation
-markupInvocation hpc tixFile hpcDirs destDir included =
+markupInvocation mbWorkDir hpc tixFile hpcDirs destDir included =
let args =
[ "markup"
- , tixFile
- , "--destdir=" ++ destDir
+ , getSymbolicPath tixFile
+ , "--destdir=" ++ getSymbolicPath destDir
]
- ++ map ("--hpcdir=" ++) hpcDirs
+ ++ map (("--hpcdir=" ++) . getSymbolicPath) hpcDirs
++ [ "--include=" ++ prettyShow moduleName
| moduleName <- included
]
- in programInvocation hpc args
+ in programInvocationCwd mbWorkDir hpc args
union
- :: ConfiguredProgram
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> ConfiguredProgram
-> Verbosity
- -> [FilePath]
+ -> [SymbolicPath Pkg File]
-- ^ Paths to .tix files
- -> FilePath
+ -> SymbolicPath Pkg File
-- ^ Path to resultant .tix file
-> [ModuleName]
-- ^ List of modules to exclude from union
-> IO ()
-union hpc verbosity tixFiles outFile excluded =
+union mbWorkDir hpc verbosity tixFiles outFile excluded =
runProgramInvocation
verbosity
- (unionInvocation hpc tixFiles outFile excluded)
+ (unionInvocation mbWorkDir hpc tixFiles outFile excluded)
unionInvocation
- :: ConfiguredProgram
- -> [FilePath]
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -> ConfiguredProgram
+ -> [SymbolicPath Pkg File]
-- ^ Paths to .tix files
- -> FilePath
+ -> SymbolicPath Pkg File
-- ^ Path to resultant .tix file
-> [ModuleName]
-- ^ List of modules to exclude from union
-> ProgramInvocation
-unionInvocation hpc tixFiles outFile excluded =
- programInvocation hpc $
+unionInvocation mbWorkDir hpc tixFiles outFile excluded =
+ programInvocationCwd mbWorkDir hpc $
concat
[ ["sum", "--union"]
- , tixFiles
- , ["--output=" ++ outFile]
+ , map getSymbolicPath tixFiles
+ , ["--output=" ++ getSymbolicPath outFile]
, [ "--exclude=" ++ prettyShow moduleName
| moduleName <- excluded
]
diff --git a/Cabal/src/Distribution/Simple/Program/Ld.hs b/Cabal/src/Distribution/Simple/Program/Ld.hs
index d7449b9396..5c2a33809a 100644
--- a/Cabal/src/Distribution/Simple/Program/Ld.hs
+++ b/Cabal/src/Distribution/Simple/Program/Ld.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -22,14 +23,14 @@ import Distribution.Simple.Compiler (arResponseFilesSupported)
import Distribution.Simple.Flag
( fromFlagOrDefault
)
-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..))
+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..), mbWorkDirLBI)
import Distribution.Simple.Program.ResponseFile
( withResponseFile
)
import Distribution.Simple.Program.Run
( ProgramInvocation
, multiStageProgramInvocation
- , programInvocation
+ , programInvocationCwd
, runProgramInvocation
)
import Distribution.Simple.Program.Types
@@ -41,6 +42,7 @@ import Distribution.Simple.Setup.Config
import Distribution.Simple.Utils
( defaultTempFileOptions
)
+import Distribution.Utils.Path
import Distribution.Verbosity
( Verbosity
)
@@ -48,59 +50,63 @@ import Distribution.Verbosity
import System.Directory
( renameFile
)
-import System.FilePath
- ( takeDirectory
- , (<.>)
- )
-- | Call @ld -r@ to link a bunch of object files together.
combineObjectFiles
:: Verbosity
-> LocalBuildInfo
-> ConfiguredProgram
- -> FilePath
- -> [FilePath]
+ -> SymbolicPath Pkg File
+ -> [SymbolicPath Pkg File]
-> IO ()
-combineObjectFiles verbosity lbi ld target files = do
+combineObjectFiles verbosity lbi ldProg target files = do
-- Unlike "ar", the "ld" tool is not designed to be used with xargs. That is,
-- if we have more object files than fit on a single command line then we
-- have a slight problem. What we have to do is link files in batches into
-- a temp object file and then include that one in the next batch.
- let simpleArgs = ["-r", "-o", target]
+ let
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ u :: SymbolicPath Pkg to -> FilePath
+ u = interpretSymbolicPathCWD
+ i = interpretSymbolicPath mbWorkDir
+ mbWorkDir = mbWorkDirLBI lbi
- initialArgs = ["-r", "-o", target]
- middleArgs = ["-r", "-o", target, tmpfile]
- finalArgs = middleArgs
+ simpleArgs = ["-r", "-o", u target]
+ initialArgs = ["-r", "-o", u target]
+ middleArgs = ["-r", "-o", u target, u tmpfile]
+ finalArgs = middleArgs
- simple = programInvocation ld simpleArgs
- initial = programInvocation ld initialArgs
- middle = programInvocation ld middleArgs
- final = programInvocation ld finalArgs
+ ld = programInvocationCwd (mbWorkDirLBI lbi) ldProg
+ simple = ld simpleArgs
+ initial = ld initialArgs
+ middle = ld middleArgs
+ final = ld finalArgs
- targetDir = takeDirectory target
+ targetDir = takeDirectorySymbolicPath target
- invokeWithResponesFile :: FilePath -> ProgramInvocation
- invokeWithResponesFile atFile =
- programInvocation ld $ simpleArgs ++ ['@' : atFile]
+ invokeWithResponseFile :: FilePath -> ProgramInvocation
+ invokeWithResponseFile atFile =
+ ld $ simpleArgs ++ ['@' : atFile]
- oldVersionManualOverride =
- fromFlagOrDefault False $ configUseResponseFiles $ configFlags lbi
- -- Whether ghc's ar supports response files is a good proxy for
- -- whether ghc's ld supports them as well.
- responseArgumentsNotSupported =
- not (arResponseFilesSupported (compiler lbi))
+ oldVersionManualOverride =
+ fromFlagOrDefault False $ configUseResponseFiles $ configFlags lbi
+ -- Whether ghc's ar supports response files is a good proxy for
+ -- whether ghc's ld supports them as well.
+ responseArgumentsNotSupported =
+ not (arResponseFilesSupported (compiler lbi))
- if oldVersionManualOverride || responseArgumentsNotSupported
- then run $ multiStageProgramInvocation simple (initial, middle, final) files
- else withResponseFile verbosity defaultTempFileOptions targetDir "ld.rsp" Nothing files $
- \path -> runProgramInvocation verbosity $ invokeWithResponesFile path
- where
- tmpfile = target <.> "tmp" -- perhaps should use a proper temp file
run :: [ProgramInvocation] -> IO ()
run [] = return ()
run [inv] = runProgramInvocation verbosity inv
run (inv : invs) = do
runProgramInvocation verbosity inv
- renameFile target tmpfile
+ renameFile (i target) (i tmpfile)
run invs
+
+ if oldVersionManualOverride || responseArgumentsNotSupported
+ then run $ multiStageProgramInvocation simple (initial, middle, final) (map getSymbolicPath files)
+ else withResponseFile verbosity defaultTempFileOptions mbWorkDir targetDir "ld.rsp" Nothing (map getSymbolicPath files) $
+ \path -> runProgramInvocation verbosity $ invokeWithResponseFile path
+ where
+ tmpfile = target <.> "tmp" -- perhaps should use a proper temp file
diff --git a/Cabal/src/Distribution/Simple/Program/ResponseFile.hs b/Cabal/src/Distribution/Simple/Program/ResponseFile.hs
index 8a477d3fdd..ee8271545f 100644
--- a/Cabal/src/Distribution/Simple/Program/ResponseFile.hs
+++ b/Cabal/src/Distribution/Simple/Program/ResponseFile.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
----------------------------------------------------------------------------
@@ -19,14 +21,17 @@ import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Simple.Utils (TempFileOptions, debug, withTempFileEx)
+import Distribution.Utils.Path
import Distribution.Verbosity
withResponseFile
:: Verbosity
-> TempFileOptions
- -> FilePath
- -- ^ Working directory to create response file in.
- -> FilePath
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory
+ -> SymbolicPath Pkg (Dir Response)
+ -- ^ Directory to create response file in.
+ -> String
-- ^ Template for response file name.
-> Maybe TextEncoding
-- ^ Encoding to use for response file contents.
@@ -34,10 +39,14 @@ withResponseFile
-- ^ Arguments to put into response file.
-> (FilePath -> IO a)
-> IO a
-withResponseFile verbosity tmpFileOpts workDir fileNameTemplate encoding arguments f =
- withTempFileEx tmpFileOpts workDir fileNameTemplate $ \responseFileName hf -> do
+withResponseFile verbosity tmpFileOpts mbWorkDir responseDir fileNameTemplate encoding arguments f =
+ withTempFileEx tmpFileOpts mbWorkDir responseDir fileNameTemplate $ \responsePath hf -> do
+ let responseFileName = getSymbolicPath responsePath
traverse_ (hSetEncoding hf) encoding
- let responseContents = unlines $ map escapeResponseFileArg arguments
+ let responseContents =
+ unlines $
+ map escapeResponseFileArg $
+ arguments
hPutStr hf responseContents
hClose hf
debug verbosity $ responseFileName ++ " contents: <<<"
diff --git a/Cabal/src/Distribution/Simple/Program/Run.hs b/Cabal/src/Distribution/Simple/Program/Run.hs
index e9a1298559..88afef0af9 100644
--- a/Cabal/src/Distribution/Simple/Program/Run.hs
+++ b/Cabal/src/Distribution/Simple/Program/Run.hs
@@ -1,6 +1,9 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
-----------------------------------------------------------------------------
@@ -19,6 +22,7 @@ module Distribution.Simple.Program.Run
, emptyProgramInvocation
, simpleProgramInvocation
, programInvocation
+ , programInvocationCwd
, multiStageProgramInvocation
, runProgramInvocation
, getProgramInvocationOutput
@@ -36,6 +40,7 @@ import Distribution.Simple.Errors
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils
import Distribution.Utils.Generic
+import Distribution.Utils.Path
import Distribution.Verbosity
import qualified Data.ByteString.Lazy as LBS
@@ -79,14 +84,20 @@ emptyProgramInvocation =
, progInvokeOutputEncoding = IOEncodingText
}
-simpleProgramInvocation :: FilePath -> [String] -> ProgramInvocation
+simpleProgramInvocation
+ :: FilePath
+ -> [String]
+ -> ProgramInvocation
simpleProgramInvocation path args =
emptyProgramInvocation
{ progInvokePath = path
, progInvokeArgs = args
}
-programInvocation :: ConfiguredProgram -> [String] -> ProgramInvocation
+programInvocation
+ :: ConfiguredProgram
+ -> [String]
+ -> ProgramInvocation
programInvocation prog args =
emptyProgramInvocation
{ progInvokePath = programPath prog
@@ -97,6 +108,17 @@ programInvocation prog args =
, progInvokeEnv = programOverrideEnv prog
}
+programInvocationCwd
+ :: forall to
+ . Maybe (SymbolicPath CWD (Dir to))
+ -> ConfiguredProgram
+ -> [String]
+ -> ProgramInvocation
+programInvocationCwd mbWorkDir prog args =
+ (programInvocation prog args)
+ { progInvokeCwd = fmap getSymbolicPath mbWorkDir
+ }
+
runProgramInvocation :: Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation
verbosity
@@ -107,7 +129,7 @@ runProgramInvocation
, progInvokeCwd = Nothing
, progInvokeInput = Nothing
} =
- rawSystemExit verbosity path args
+ rawSystemExit verbosity Nothing path args
runProgramInvocation
verbosity
ProgramInvocation
diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs
index 4cfc5ba880..78053111a4 100644
--- a/Cabal/src/Distribution/Simple/Register.hs
+++ b/Cabal/src/Distribution/Simple/Register.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -76,14 +77,16 @@ import Distribution.Simple.Flag
import Distribution.Simple.Program
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import Distribution.Simple.Program.Script
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Register
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Utils.MapAccum
+import Distribution.Utils.Path
import Distribution.Verbosity as Verbosity
import Distribution.Version
import System.Directory
-import System.FilePath (isAbsolute, (<.>), (</>))
+import System.FilePath (isAbsolute)
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
@@ -96,34 +99,30 @@ register
-> RegisterFlags
-- ^ Install in the user's database?; verbose
-> IO ()
-register pkg_descr lbi0 flags =
+register pkg_descr lbi0 flags = do
-- Duncan originally asked for us to not register/install files
-- when there was no public library. But with per-component
-- configure, we legitimately need to install internal libraries
-- so that we can get them. So just unconditionally install.
- doRegister
- where
- doRegister = do
- targets <- readTargetInfos verbosity pkg_descr lbi0 (regArgs flags)
-
- -- It's important to register in build order, because ghc-pkg
- -- will complain if a dependency is not registered.
- let componentsToRegister =
- neededTargetsInBuildOrder' pkg_descr lbi0 (map nodeKey targets)
-
- (_, ipi_mbs) <-
- mapAccumM `flip` installedPkgs lbi0 `flip` componentsToRegister $ \index tgt ->
- case targetComponent tgt of
- CLib lib -> do
- let clbi = targetCLBI tgt
- lbi = lbi0{installedPkgs = index}
- ipi <- generateOne pkg_descr lib lbi clbi flags
- return (Index.insert ipi index, Just ipi)
- _ -> return (index, Nothing)
-
- registerAll pkg_descr lbi0 flags (catMaybes ipi_mbs)
- where
- verbosity = fromFlag (regVerbosity flags)
+ let verbosity = fromFlag $ registerVerbosity flags
+ targets <- readTargetInfos verbosity pkg_descr lbi0 $ registerTargets flags
+
+ -- It's important to register in build order, because ghc-pkg
+ -- will complain if a dependency is not registered.
+ let componentsToRegister =
+ neededTargetsInBuildOrder' pkg_descr lbi0 (map nodeKey targets)
+
+ (_, ipi_mbs) <-
+ mapAccumM `flip` installedPkgs lbi0 `flip` componentsToRegister $ \index tgt ->
+ case targetComponent tgt of
+ CLib lib -> do
+ let clbi = targetCLBI tgt
+ lbi = lbi0{installedPkgs = index}
+ ipi <- generateOne pkg_descr lib lbi clbi flags
+ return (Index.insert ipi index, Just ipi)
+ _ -> return (index, Nothing)
+
+ registerAll pkg_descr lbi0 flags (catMaybes ipi_mbs)
generateOne
:: PackageDescription
@@ -134,7 +133,7 @@ generateOne
-> IO InstalledPackageInfo
generateOne pkg lib lbi clbi regFlags =
do
- absPackageDBs <- absolutePackageDBPaths packageDbs
+ absPackageDBs <- absolutePackageDBPaths mbWorkDir packageDbs
installedPkgInfo <-
generateRegistrationInfo
verbosity
@@ -149,6 +148,7 @@ generateOne pkg lib lbi clbi regFlags =
info verbosity (IPI.showInstalledPackageInfo installedPkgInfo)
return installedPkgInfo
where
+ common = registerCommonFlags regFlags
inplace = fromFlag (regInPlace regFlags)
reloc = relocatable lbi
-- FIXME: there's really no guarantee this will work.
@@ -158,8 +158,9 @@ generateOne pkg lib lbi clbi regFlags =
nub $
withPackageDB lbi
++ maybeToList (flagToMaybe (regPackageDB regFlags))
- distPref = fromFlag (regDistPref regFlags)
- verbosity = fromFlag (regVerbosity regFlags)
+ distPref = fromFlag $ setupDistPref common
+ verbosity = fromFlag $ setupVerbosity common
+ mbWorkDir = flagToMaybe $ setupWorkingDir common
registerAll
:: PackageDescription
@@ -195,6 +196,7 @@ registerAll pkg lbi regFlags ipis =
verbosity
(compiler lbi)
(withPrograms lbi)
+ (mbWorkDirLBI lbi)
packageDbs
ipi
HcPkg.defaultRegisterOptions
@@ -214,7 +216,9 @@ registerAll pkg lbi regFlags ipis =
nub $
withPackageDB lbi
++ maybeToList (flagToMaybe (regPackageDB regFlags))
- verbosity = fromFlag (regVerbosity regFlags)
+ common = registerCommonFlags regFlags
+ verbosity = fromFlag (setupVerbosity common)
+ mbWorkDir = mbWorkDirLBI lbi
writeRegistrationFileOrDirectory = do
-- Handles overwriting both directory and file
@@ -245,7 +249,7 @@ registerAll pkg lbi regFlags ipis =
"Registration scripts are not implemented for this compiler"
(compiler lbi)
(withPrograms lbi)
- (writeHcPkgRegisterScript verbosity ipis packageDbs)
+ (writeHcPkgRegisterScript verbosity mbWorkDir ipis packageDbs)
generateRegistrationInfo
:: Verbosity
@@ -255,13 +259,11 @@ generateRegistrationInfo
-> ComponentLocalBuildInfo
-> Bool
-> Bool
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-> PackageDB
-> IO InstalledPackageInfo
generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref packageDb = do
- -- TODO: eliminate pwd!
- pwd <- getCurrentDirectory
-
+ inplaceDir <- absoluteWorkingDirLBI lbi
installedPkgInfo <-
if inplace
then -- NB: With an inplace installation, the user may run './Setup
@@ -270,7 +272,7 @@ generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref packa
return
( inplaceInstalledPackageInfo
- pwd
+ inplaceDir
distPref
pkg
(mkAbiHash "inplace")
@@ -279,7 +281,7 @@ generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref packa
clbi
)
else do
- abi_hash <- abiHash verbosity pkg distPref lbi lib clbi
+ abi_hash <- abiHash verbosity pkg inplaceDir distPref lbi lib clbi
if reloc
then
relocRegistrationInfo
@@ -307,11 +309,12 @@ abiHash
:: Verbosity
-> PackageDescription
-> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO AbiHash
-abiHash verbosity pkg distPref lbi lib clbi =
+abiHash verbosity pkg inplaceDir distPref lbi lib clbi =
case compilerFlavor comp of
GHC -> do
fmap mkAbiHash $ GHC.libAbiHash verbosity pkg lbi' lib clbi
@@ -324,7 +327,7 @@ abiHash verbosity pkg distPref lbi lib clbi =
lbi
{ withPackageDB =
withPackageDB lbi
- ++ [SpecificPackageDB (internalPackageDBPath lbi distPref)]
+ ++ [SpecificPackageDB (inplaceDir </> getSymbolicPath (internalPackageDBPath lbi distPref))]
}
relocRegistrationInfo
@@ -395,16 +398,17 @@ invokeHcPkg
:: Verbosity
-> Compiler
-> ProgramDb
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDBStack
-> [String]
-> IO ()
-invokeHcPkg verbosity comp progdb dbStack extraArgs =
+invokeHcPkg verbosity comp progdb mbWorkDir dbStack extraArgs =
withHcPkg
verbosity
"invokeHcPkg"
comp
progdb
- (\hpi -> HcPkg.invoke hpi verbosity dbStack extraArgs)
+ (\hpi -> HcPkg.invoke hpi verbosity mbWorkDir dbStack extraArgs)
withHcPkg
:: Verbosity
@@ -423,14 +427,15 @@ registerPackage
:: Verbosity
-> Compiler
-> ProgramDb
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
-registerPackage verbosity comp progdb packageDbs installedPkgInfo registerOptions =
+registerPackage verbosity comp progdb mbWorkDir packageDbs installedPkgInfo registerOptions =
case compilerFlavor comp of
- GHC -> GHC.registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions
- GHCJS -> GHCJS.registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions
+ GHC -> GHC.registerPackage verbosity progdb mbWorkDir packageDbs installedPkgInfo registerOptions
+ GHCJS -> GHCJS.registerPackage verbosity progdb mbWorkDir packageDbs installedPkgInfo registerOptions
HaskellSuite{} ->
HaskellSuite.registerPackage verbosity progdb packageDbs installedPkgInfo
_
@@ -441,16 +446,18 @@ registerPackage verbosity comp progdb packageDbs installedPkgInfo registerOption
writeHcPkgRegisterScript
:: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-> [InstalledPackageInfo]
-> PackageDBStack
-> HcPkg.HcPkgInfo
-> IO ()
-writeHcPkgRegisterScript verbosity ipis packageDbs hpi = do
+writeHcPkgRegisterScript verbosity mbWorkDir ipis packageDbs hpi = do
let genScript installedPkgInfo =
let invocation =
HcPkg.registerInvocation
hpi
Verbosity.normal
+ mbWorkDir
packageDbs
installedPkgInfo
HcPkg.defaultRegisterOptions
@@ -531,7 +538,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
, IPI.extraLibrariesStatic = extraLibsStatic bi
, IPI.extraGHCiLibraries = extraGHCiLibs bi
, IPI.includeDirs = absinc ++ adjustRelIncDirs relinc
- , IPI.includes = includes bi
+ , IPI.includes = map getSymbolicPath $ includes bi
, IPI.depends = depends
, IPI.abiDepends = [] -- due to #5465
, IPI.ccOptions = [] -- Note. NOT ccOptions bi!
@@ -539,8 +546,8 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
-- to C compilations in other packages.
, IPI.cxxOptions = [] -- Also. NOT cxxOptions bi!
, IPI.ldOptions = ldOptions bi
- , IPI.frameworks = frameworks bi
- , IPI.frameworkDirs = extraFrameworkDirs bi
+ , IPI.frameworks = map getSymbolicPath $ frameworks bi
+ , IPI.frameworkDirs = map getSymbolicPath $ extraFrameworkDirs bi
, IPI.haddockInterfaces = [haddockdir installDirs </> haddockName pkg]
, IPI.haddockHTMLs = [htmldir installDirs]
, IPI.pkgRoot = Nothing
@@ -555,7 +562,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
-- TODO: unclear what the root cause of the
-- duplication is, but we nub it here for now:
depends = ordNub $ map fst (componentPackageDeps clbi)
- (absinc, relinc) = partition isAbsolute (includeDirs bi)
+ (absinc, relinc) = partition isAbsolute (map getSymbolicPath $ includeDirs bi)
hasModules = not $ null (allLibModules lib clbi)
comp = compiler lbi
hasLibrary =
@@ -570,6 +577,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
hasJsSupport = case hostPlatform lbi of
Platform JavaScript _ -> True
_ -> False
+ extraLibDirs' = map getSymbolicPath $ extraLibDirs bi
libdirsStatic
| hasLibrary = libdir installDirs : extraLibDirsStaticOrFallback
| otherwise = extraLibDirsStaticOrFallback
@@ -578,20 +586,20 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
-- distinction between fully static linking and otherwise.
-- Fall back to the normal library dirs in that case.
extraLibDirsStaticOrFallback = case extraLibDirsStatic bi of
- [] -> extraLibDirs bi
- dirs -> dirs
+ [] -> extraLibDirs'
+ dirs -> map getSymbolicPath dirs
(libdirs, dynlibdirs)
| not hasLibrary =
- (extraLibDirs bi, [])
+ (extraLibDirs', [])
-- the dynamic-library-dirs defaults to the library-dirs if not specified,
-- so this works whether the dynamic-library-dirs field is supported or not
| libraryDynDirSupported comp =
- ( libdir installDirs : extraLibDirs bi
- , dynlibdir installDirs : extraLibDirs bi
+ ( libdir installDirs : extraLibDirs'
+ , dynlibdir installDirs : extraLibDirs'
)
| otherwise =
- (libdir installDirs : dynlibdir installDirs : extraLibDirs bi, [])
+ (libdir installDirs : dynlibdir installDirs : extraLibDirs', [])
-- the compiler doesn't understand the dynamic-library-dirs field so we
-- add the dyn directory to the "normal" list in the library-dirs field
@@ -602,8 +610,8 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
-- This function knows about the layout of in place packages.
inplaceInstalledPackageInfo
:: FilePath
- -- ^ top of the build tree
- -> FilePath
+ -- ^ top of the build tree (absolute path)
+ -> SymbolicPath Pkg (Dir Dist)
-- ^ location of the dist tree
-> PackageDescription
-> AbiHash
@@ -621,22 +629,27 @@ inplaceInstalledPackageInfo inplaceDir distPref pkg abi_hash lib lbi clbi =
clbi
installDirs
where
+ i = interpretSymbolicPath (Just $ makeSymbolicPath inplaceDir) -- See Note [Symbolic paths] in Distribution.Utils.Path
adjustRelativeIncludeDirs = concatMap $ \d ->
- [ inplaceDir </> d -- local include-dir
- , inplaceDir </> libTargetDir </> d -- autogen include-dir
+ [ i $ makeRelativePathEx d -- local include-dir
+ , i $ libTargetDir </> makeRelativePathEx d -- autogen include-dir
]
libTargetDir = componentBuildDir lbi clbi
installDirs =
(absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest)
- { libdir = inplaceDir </> libTargetDir
- , dynlibdir = inplaceDir </> libTargetDir
- , datadir = inplaceDir </> dataDir pkg
- , docdir = inplaceDocdir
+ { libdir = i libTargetDir
+ , dynlibdir = i libTargetDir
+ , datadir =
+ let rawDataDir = dataDir pkg
+ in if null $ getSymbolicPath rawDataDir
+ then i sameDirectory
+ else i rawDataDir
+ , docdir = i inplaceDocdir
, htmldir = inplaceHtmldir
, haddockdir = inplaceHtmldir
}
- inplaceDocdir = inplaceDir </> distPref </> "doc"
- inplaceHtmldir = inplaceDocdir </> "html" </> prettyShow (packageName pkg)
+ inplaceDocdir = distPref </> makeRelativePathEx "doc"
+ inplaceHtmldir = i $ inplaceDocdir </> makeRelativePathEx ("html" </> prettyShow (packageName pkg))
-- | Construct 'InstalledPackageInfo' for the final install location of a
-- library package.
@@ -673,7 +686,7 @@ relocatableInstalledPackageInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
+ -> SymbolicPath CWD ('Dir Pkg)
-> InstalledPackageInfo
relocatableInstalledPackageInfo pkg abi_hash lib lbi clbi pkgroot =
generalInstalledPackageInfo
@@ -693,7 +706,7 @@ relocatableInstalledPackageInfo pkg abi_hash lib lbi clbi pkgroot =
bi = libBuildInfo lib
installDirs =
- fmap (("${pkgroot}" </>) . shortRelativePath pkgroot) $
+ fmap (("${pkgroot}" </>) . shortRelativePath (getSymbolicPath pkgroot)) $
absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest
-- -----------------------------------------------------------------------------
@@ -702,17 +715,20 @@ relocatableInstalledPackageInfo pkg abi_hash lib lbi clbi pkgroot =
unregister :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
unregister pkg lbi regFlags = do
let pkgid = packageId pkg
+ common = registerCommonFlags regFlags
genScript = fromFlag (regGenScript regFlags)
- verbosity = fromFlag (regVerbosity regFlags)
+ verbosity = fromFlag (setupVerbosity common)
packageDb =
fromFlagOrDefault
(registrationPackageDB (withPackageDB lbi))
(regPackageDB regFlags)
+ mbWorkDir = mbWorkDirLBI lbi
unreg hpi =
let invocation =
HcPkg.unregisterInvocation
hpi
Verbosity.normal
+ mbWorkDir
packageDb
pkgid
in if genScript
@@ -734,8 +750,8 @@ unregScriptFileName = case buildOS of
Windows -> "unregister.bat"
_ -> "unregister.sh"
-internalPackageDBPath :: LocalBuildInfo -> FilePath -> FilePath
+internalPackageDBPath :: LocalBuildInfo -> SymbolicPath Pkg (Dir Dist) -> SymbolicPath Pkg (Dir PkgDB)
internalPackageDBPath lbi distPref =
case compilerFlavor (compiler lbi) of
UHC -> UHC.inplacePackageDbPath lbi
- _ -> distPref </> "package.conf.inplace"
+ _ -> distPref </> makeRelativePathEx "package.conf.inplace"
diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs
index cd8f10aff3..861cf16095 100644
--- a/Cabal/src/Distribution/Simple/Setup.hs
+++ b/Cabal/src/Distribution/Simple/Setup.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -38,12 +39,13 @@ module Distribution.Simple.Setup
, emptyGlobalFlags
, defaultGlobalFlags
, globalCommand
+ , CommonSetupFlags (..)
+ , defaultCommonSetupFlags
, ConfigFlags (..)
, emptyConfigFlags
, defaultConfigFlags
, configureCommand
, configPrograms
- , configAbsolutePaths
, readPackageDb
, readPackageDbList
, showPackageDb
@@ -133,12 +135,14 @@ module Distribution.Simple.Setup
, falseArg
, optionVerbosity
, BuildingWhat (..)
+ , buildingWhatCommonFlags
, buildingWhatVerbosity
+ , buildingWhatWorkingDir
, buildingWhatDistPref
) where
import GHC.Generics (Generic)
-import Prelude (FilePath, Show, ($))
+import Prelude (Maybe, Show, (.))
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
@@ -155,9 +159,16 @@ import Distribution.Simple.Setup.Haddock
import Distribution.Simple.Setup.Hscolour
import Distribution.Simple.Setup.Install
import Distribution.Simple.Setup.Register
+ ( RegisterFlags (..)
+ , defaultRegisterFlags
+ , emptyRegisterFlags
+ , registerCommand
+ , unregisterCommand
+ )
import Distribution.Simple.Setup.Repl
import Distribution.Simple.Setup.SDist
import Distribution.Simple.Setup.Test
+import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity)
@@ -176,19 +187,21 @@ data BuildingWhat
BuildHscolour HscolourFlags
deriving (Generic, Show)
+buildingWhatCommonFlags :: BuildingWhat -> CommonSetupFlags
+buildingWhatCommonFlags = \case
+ BuildNormal flags -> buildCommonFlags flags
+ BuildRepl flags -> replCommonFlags flags
+ BuildHaddock flags -> haddockCommonFlags flags
+ BuildHscolour flags -> hscolourCommonFlags flags
+
buildingWhatVerbosity :: BuildingWhat -> Verbosity
-buildingWhatVerbosity = \case
- BuildNormal flags -> fromFlag $ buildVerbosity flags
- BuildRepl flags -> fromFlag $ replVerbosity flags
- BuildHaddock flags -> fromFlag $ haddockVerbosity flags
- BuildHscolour flags -> fromFlag $ hscolourVerbosity flags
+buildingWhatVerbosity = fromFlag . setupVerbosity . buildingWhatCommonFlags
+
+buildingWhatWorkingDir :: BuildingWhat -> Maybe (SymbolicPath CWD (Dir Pkg))
+buildingWhatWorkingDir = flagToMaybe . setupWorkingDir . buildingWhatCommonFlags
-buildingWhatDistPref :: BuildingWhat -> FilePath
-buildingWhatDistPref = \case
- BuildNormal flags -> fromFlag $ buildDistPref flags
- BuildRepl flags -> fromFlag $ replDistPref flags
- BuildHaddock flags -> fromFlag $ haddockDistPref flags
- BuildHscolour flags -> fromFlag $ hscolourDistPref flags
+buildingWhatDistPref :: BuildingWhat -> SymbolicPath Pkg (Dir Dist)
+buildingWhatDistPref = fromFlag . setupDistPref . buildingWhatCommonFlags
-- The test cases kinda have to be rewritten from the ground up... :/
-- hunitTests :: [Test]
diff --git a/Cabal/src/Distribution/Simple/Setup/Benchmark.hs b/Cabal/src/Distribution/Simple/Setup/Benchmark.hs
index 5eac60aee0..36fc446b5a 100644
--- a/Cabal/src/Distribution/Simple/Setup/Benchmark.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Benchmark.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,7 +21,15 @@
-- Definition of the benchmarking command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Benchmark
- ( BenchmarkFlags (..)
+ ( BenchmarkFlags
+ ( BenchmarkCommonFlags
+ , benchmarkVerbosity
+ , benchmarkDistPref
+ , benchmarkCabalFilePath
+ , benchmarkWorkingDir
+ , benchmarkTargets
+ , ..
+ )
, emptyBenchmarkFlags
, defaultBenchmarkFlags
, benchmarkCommand
@@ -29,13 +40,12 @@ import Distribution.Compat.Prelude hiding (get)
import Prelude ()
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
-import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Verbosity
-import Distribution.Simple.Setup.Common
-
-- ------------------------------------------------------------
-- * Benchmark flags
@@ -43,20 +53,42 @@ import Distribution.Simple.Setup.Common
-- ------------------------------------------------------------
data BenchmarkFlags = BenchmarkFlags
- { benchmarkDistPref :: Flag FilePath
- , benchmarkVerbosity :: Flag Verbosity
+ { benchmarkCommonFlags :: !CommonSetupFlags
, benchmarkOptions :: [PathTemplate]
}
deriving (Show, Generic, Typeable)
+pattern BenchmarkCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> BenchmarkFlags
+pattern BenchmarkCommonFlags
+ { benchmarkVerbosity
+ , benchmarkDistPref
+ , benchmarkWorkingDir
+ , benchmarkCabalFilePath
+ , benchmarkTargets
+ } <-
+ ( benchmarkCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = benchmarkVerbosity
+ , setupDistPref = benchmarkDistPref
+ , setupWorkingDir = benchmarkWorkingDir
+ , setupCabalFilePath = benchmarkCabalFilePath
+ , setupTargets = benchmarkTargets
+ }
+ )
+
instance Binary BenchmarkFlags
instance Structured BenchmarkFlags
defaultBenchmarkFlags :: BenchmarkFlags
defaultBenchmarkFlags =
BenchmarkFlags
- { benchmarkDistPref = NoFlag
- , benchmarkVerbosity = Flag normal
+ { benchmarkCommonFlags = defaultCommonSetupFlags
, benchmarkOptions = []
}
@@ -82,43 +114,40 @@ benchmarkCommand =
benchmarkOptions' :: ShowOrParseArgs -> [OptionField BenchmarkFlags]
benchmarkOptions' showOrParseArgs =
- [ optionVerbosity
- benchmarkVerbosity
- (\v flags -> flags{benchmarkVerbosity = v})
- , optionDistPref
- benchmarkDistPref
- (\d flags -> flags{benchmarkDistPref = d})
- showOrParseArgs
- , option
- []
- ["benchmark-options"]
- ( "give extra options to benchmark executables "
- ++ "(name templates can use $pkgid, $compiler, "
- ++ "$os, $arch, $benchmark)"
- )
- benchmarkOptions
- (\v flags -> flags{benchmarkOptions = v})
- ( reqArg'
- "TEMPLATES"
- (map toPathTemplate . splitArgs)
- (const [])
- )
- , option
- []
- ["benchmark-option"]
- ( "give extra option to benchmark executables "
- ++ "(no need to quote options containing spaces, "
- ++ "name template can use $pkgid, $compiler, "
- ++ "$os, $arch, $benchmark)"
- )
- benchmarkOptions
- (\v flags -> flags{benchmarkOptions = v})
- ( reqArg'
- "TEMPLATE"
- (\x -> [toPathTemplate x])
- (map fromPathTemplate)
- )
- ]
+ withCommonSetupOptions
+ benchmarkCommonFlags
+ (\c f -> f{benchmarkCommonFlags = c})
+ showOrParseArgs
+ [ option
+ []
+ ["benchmark-options"]
+ ( "give extra options to benchmark executables "
+ ++ "(name templates can use $pkgid, $compiler, "
+ ++ "$os, $arch, $benchmark)"
+ )
+ benchmarkOptions
+ (\v flags -> flags{benchmarkOptions = v})
+ ( reqArg'
+ "TEMPLATES"
+ (map toPathTemplate . splitArgs)
+ (const [])
+ )
+ , option
+ []
+ ["benchmark-option"]
+ ( "give extra option to benchmark executables "
+ ++ "(no need to quote options containing spaces, "
+ ++ "name template can use $pkgid, $compiler, "
+ ++ "$os, $arch, $benchmark)"
+ )
+ benchmarkOptions
+ (\v flags -> flags{benchmarkOptions = v})
+ ( reqArg'
+ "TEMPLATE"
+ (\x -> [toPathTemplate x])
+ (map fromPathTemplate)
+ )
+ ]
emptyBenchmarkFlags :: BenchmarkFlags
emptyBenchmarkFlags = mempty
diff --git a/Cabal/src/Distribution/Simple/Setup/Build.hs b/Cabal/src/Distribution/Simple/Setup/Build.hs
index aa1fa5e61a..09aad42bdc 100644
--- a/Cabal/src/Distribution/Simple/Setup/Build.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Build.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,7 +21,15 @@
-- Definition of the build command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Build
- ( BuildFlags (..)
+ ( BuildFlags
+ ( BuildCommonFlags
+ , buildVerbosity
+ , buildDistPref
+ , buildCabalFilePath
+ , buildWorkingDir
+ , buildTargets
+ , ..
+ )
, emptyBuildFlags
, defaultBuildFlags
, buildCommand
@@ -32,12 +43,12 @@ import Prelude ()
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Simple.Program
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
import Distribution.Types.DumpBuildInfo
+import Distribution.Utils.Path
import Distribution.Verbosity
-import Distribution.Simple.Setup.Common
-
-- ------------------------------------------------------------
-- * Build flags
@@ -45,33 +56,49 @@ import Distribution.Simple.Setup.Common
-- ------------------------------------------------------------
data BuildFlags = BuildFlags
- { buildProgramPaths :: [(String, FilePath)]
+ { buildCommonFlags :: !CommonSetupFlags
+ , buildProgramPaths :: [(String, FilePath)]
, buildProgramArgs :: [(String, [String])]
- , buildDistPref :: Flag FilePath
- , buildVerbosity :: Flag Verbosity
, buildNumJobs :: Flag (Maybe Int)
, buildUseSemaphore :: Flag String
- , -- TODO: this one should not be here, it's just that the silly
- -- UserHooks stop us from passing extra info in other ways
- buildArgs :: [String]
- , buildCabalFilePath :: Flag FilePath
}
deriving (Read, Show, Generic, Typeable)
+pattern BuildCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> BuildFlags
+pattern BuildCommonFlags
+ { buildVerbosity
+ , buildDistPref
+ , buildWorkingDir
+ , buildCabalFilePath
+ , buildTargets
+ } <-
+ ( buildCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = buildVerbosity
+ , setupDistPref = buildDistPref
+ , setupWorkingDir = buildWorkingDir
+ , setupCabalFilePath = buildCabalFilePath
+ , setupTargets = buildTargets
+ }
+ )
+
instance Binary BuildFlags
instance Structured BuildFlags
defaultBuildFlags :: BuildFlags
defaultBuildFlags =
BuildFlags
- { buildProgramPaths = mempty
+ { buildCommonFlags = defaultCommonSetupFlags
+ , buildProgramPaths = mempty
, buildProgramArgs = []
- , buildDistPref = mempty
- , buildVerbosity = Flag normal
, buildNumJobs = mempty
, buildUseSemaphore = NoFlag
- , buildArgs = []
- , buildCabalFilePath = mempty
}
buildCommand :: ProgramDb -> CommandUI BuildFlags
@@ -110,16 +137,7 @@ buildCommand progDb =
, "COMPONENTS [FLAGS]"
]
, commandDefaultFlags = defaultBuildFlags
- , commandOptions = \showOrParseArgs ->
- [ optionVerbosity
- buildVerbosity
- (\v flags -> flags{buildVerbosity = v})
- , optionDistPref
- buildDistPref
- (\d flags -> flags{buildDistPref = d})
- showOrParseArgs
- ]
- ++ buildOptions progDb showOrParseArgs
+ , commandOptions = buildOptions progDb
}
buildOptions
@@ -127,17 +145,22 @@ buildOptions
-> ShowOrParseArgs
-> [OptionField BuildFlags]
buildOptions progDb showOrParseArgs =
- [ optionNumJobs
- buildNumJobs
- (\v flags -> flags{buildNumJobs = v})
- , option
- []
- ["semaphore"]
- "semaphore"
- buildUseSemaphore
- (\v flags -> flags{buildUseSemaphore = v})
- (reqArg' "SEMAPHORE" Flag flagToList)
- ]
+ withCommonSetupOptions
+ buildCommonFlags
+ (\c f -> f{buildCommonFlags = c})
+ showOrParseArgs
+ ( [ optionNumJobs
+ buildNumJobs
+ (\v flags -> flags{buildNumJobs = v})
+ , option
+ []
+ ["semaphore"]
+ "semaphore"
+ buildUseSemaphore
+ (\v flags -> flags{buildUseSemaphore = v})
+ (reqArg' "SEMAPHORE" Flag flagToList)
+ ]
+ )
++ programDbPaths
progDb
showOrParseArgs
diff --git a/Cabal/src/Distribution/Simple/Setup/Clean.hs b/Cabal/src/Distribution/Simple/Setup/Clean.hs
index 14cb65bae6..6a1974f323 100644
--- a/Cabal/src/Distribution/Simple/Setup/Clean.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Clean.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,7 +21,15 @@
-- Definition of the clean command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Clean
- ( CleanFlags (..)
+ ( CleanFlags
+ ( CleanCommonFlags
+ , cleanVerbosity
+ , cleanDistPref
+ , cleanCabalFilePath
+ , cleanWorkingDir
+ , cleanTargets
+ , ..
+ )
, emptyCleanFlags
, defaultCleanFlags
, cleanCommand
@@ -29,9 +40,9 @@ import Prelude ()
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
-import Distribution.Verbosity
-
import Distribution.Simple.Setup.Common
+import Distribution.Utils.Path
+import Distribution.Verbosity
-- ------------------------------------------------------------
@@ -40,23 +51,43 @@ import Distribution.Simple.Setup.Common
-- ------------------------------------------------------------
data CleanFlags = CleanFlags
- { cleanSaveConf :: Flag Bool
- , cleanDistPref :: Flag FilePath
- , cleanVerbosity :: Flag Verbosity
- , cleanCabalFilePath :: Flag FilePath
+ { cleanCommonFlags :: !CommonSetupFlags
+ , cleanSaveConf :: Flag Bool
}
deriving (Show, Generic, Typeable)
+pattern CleanCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> CleanFlags
+pattern CleanCommonFlags
+ { cleanVerbosity
+ , cleanDistPref
+ , cleanWorkingDir
+ , cleanCabalFilePath
+ , cleanTargets
+ } <-
+ ( cleanCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = cleanVerbosity
+ , setupDistPref = cleanDistPref
+ , setupWorkingDir = cleanWorkingDir
+ , setupCabalFilePath = cleanCabalFilePath
+ , setupTargets = cleanTargets
+ }
+ )
+
instance Binary CleanFlags
instance Structured CleanFlags
defaultCleanFlags :: CleanFlags
defaultCleanFlags =
CleanFlags
- { cleanSaveConf = Flag False
- , cleanDistPref = NoFlag
- , cleanVerbosity = Flag normal
- , cleanCabalFilePath = mempty
+ { cleanCommonFlags = defaultCommonSetupFlags
+ , cleanSaveConf = Flag False
}
cleanCommand :: CommandUI CleanFlags
@@ -71,19 +102,18 @@ cleanCommand =
"Usage: " ++ pname ++ " clean [FLAGS]\n"
, commandDefaultFlags = defaultCleanFlags
, commandOptions = \showOrParseArgs ->
- [ optionVerbosity cleanVerbosity (\v flags -> flags{cleanVerbosity = v})
- , optionDistPref
- cleanDistPref
- (\d flags -> flags{cleanDistPref = d})
- showOrParseArgs
- , option
- "s"
- ["save-configure"]
- "Do not remove the configuration file (dist/setup-config) during cleaning. Saves need to reconfigure."
- cleanSaveConf
- (\v flags -> flags{cleanSaveConf = v})
- trueArg
- ]
+ withCommonSetupOptions
+ cleanCommonFlags
+ (\c f -> f{cleanCommonFlags = c})
+ showOrParseArgs
+ [ option
+ "s"
+ ["save-configure"]
+ "Do not remove the configuration file (dist/setup-config) during cleaning. Saves need to reconfigure."
+ cleanSaveConf
+ (\v flags -> flags{cleanSaveConf = v})
+ trueArg
+ ]
}
emptyCleanFlags :: CleanFlags
diff --git a/Cabal/src/Distribution/Simple/Setup/Common.hs b/Cabal/src/Distribution/Simple/Setup/Common.hs
index 0589838f61..0a1422b327 100644
--- a/Cabal/src/Distribution/Simple/Setup/Common.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Common.hs
@@ -1,6 +1,8 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -18,7 +20,10 @@
-- Common utilities for defining command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Common
- ( CopyDest (..)
+ ( CommonSetupFlags (..)
+ , defaultCommonSetupFlags
+ , withCommonSetupOptions
+ , CopyDest (..)
, configureCCompiler
, configureLinker
, programDbOption
@@ -44,6 +49,7 @@ module Distribution.Simple.Setup.Common
, trueArg
, falseArg
, reqArgFlag
+ , reqSymbolicPathArgFlag
, optionVerbosity
, optionNumJobs
) where
@@ -58,16 +64,92 @@ import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
import Distribution.Simple.Program
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Verbosity
+--------------------------------------------------------------------------------
+
+-- | A datatype that stores common flags for different invocations
+-- of a @Setup@ executable, e.g. configure, build, install.
+data CommonSetupFlags = CommonSetupFlags
+ { setupVerbosity :: !(Flag Verbosity)
+ -- ^ Verbosity
+ , setupWorkingDir :: !(Flag (SymbolicPath CWD (Dir Pkg)))
+ -- ^ Working directory (optional)
+ , setupDistPref :: !(Flag (SymbolicPath Pkg (Dir Dist)))
+ -- ^ Build directory
+ , setupCabalFilePath :: !(Flag (SymbolicPath Pkg File))
+ -- ^ Which Cabal file to use (optional)
+ , setupTargets :: [String]
+ -- ^ Which targets is this Setup invocation relative to?
+ --
+ -- TODO: this one should not be here, it's just that the silly
+ -- UserHooks stop us from passing extra info in other ways
+ }
+ deriving (Eq, Show, Read, Generic)
+
+instance Binary CommonSetupFlags
+instance Structured CommonSetupFlags
+
+instance Semigroup CommonSetupFlags where
+ (<>) = gmappend
+
+instance Monoid CommonSetupFlags where
+ mempty = gmempty
+ mappend = (<>)
+
+defaultCommonSetupFlags :: CommonSetupFlags
+defaultCommonSetupFlags =
+ CommonSetupFlags
+ { setupVerbosity = Flag normal
+ , setupWorkingDir = NoFlag
+ , setupDistPref = NoFlag
+ , setupCabalFilePath = NoFlag
+ , setupTargets = []
+ }
+
+commonSetupOptions :: ShowOrParseArgs -> [OptionField CommonSetupFlags]
+commonSetupOptions showOrParseArgs =
+ [ optionVerbosity
+ setupVerbosity
+ (\v flags -> flags{setupVerbosity = v})
+ , optionDistPref
+ setupDistPref
+ (\d flags -> flags{setupDistPref = d})
+ showOrParseArgs
+ , option
+ ""
+ ["cabal-file"]
+ "use this Cabal file"
+ setupCabalFilePath
+ (\v flags -> flags{setupCabalFilePath = v})
+ (reqSymbolicPathArgFlag "PATH")
+ -- NB: no --working-dir flag, as that value is populated using the
+ -- global flag (see Distribution.Simple.Setup.Global.globalCommand).
+ ]
+
+withCommonSetupOptions
+ :: (flags -> CommonSetupFlags)
+ -> (CommonSetupFlags -> flags -> flags)
+ -> ShowOrParseArgs
+ -> [OptionField flags]
+ -> [OptionField flags]
+withCommonSetupOptions getCommon setCommon showOrParseArgs opts =
+ map fmapOptionField (commonSetupOptions showOrParseArgs) ++ opts
+ where
+ fmapOptionField (OptionField nm descr) =
+ OptionField nm (map (fmapOptDescr getCommon setCommon) descr)
+
+--------------------------------------------------------------------------------
+
-- FIXME Not sure where this should live
-defaultDistPref :: FilePath
-defaultDistPref = "dist"
+defaultDistPref :: SymbolicPath Pkg (Dir Dist)
+defaultDistPref = makeSymbolicPath "dist"
-- | The name of the directory where optional compilation artifacts
-- go, such as ghc plugins and .hie files.
-extraCompilationArtifacts :: FilePath
-extraCompilationArtifacts = "extra-compilation-artifacts"
+extraCompilationArtifacts :: RelativePath Build (Dir Artifacts)
+extraCompilationArtifacts = makeRelativePathEx "extra-compilation-artifacts"
-- | Help text for @test@ and @bench@ commands.
testOrBenchmarkHelpText
@@ -248,8 +330,8 @@ reqArgFlag
reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList
optionDistPref
- :: (flags -> Flag FilePath)
- -> (Flag FilePath -> flags -> flags)
+ :: (flags -> Flag (SymbolicPath Pkg (Dir Dist)))
+ -> (Flag (SymbolicPath Pkg (Dir Dist)) -> flags -> flags)
-> ShowOrParseArgs
-> OptionField flags
optionDistPref get set = \showOrParseArgs ->
@@ -258,16 +340,33 @@ optionDistPref get set = \showOrParseArgs ->
(distPrefFlagName showOrParseArgs)
( "The directory where Cabal puts generated build files "
++ "(default "
- ++ defaultDistPref
+ ++ getSymbolicPath defaultDistPref
++ ")"
)
get
set
- (reqArgFlag "DIR")
+ (reqSymbolicPathArgFlag "DIR")
where
distPrefFlagName ShowArgs = ["builddir"]
distPrefFlagName ParseArgs = ["builddir", "distdir", "distpref"]
+reqSymbolicPathArgFlag
+ :: ArgPlaceHolder
+ -> SFlags
+ -> LFlags
+ -> Description
+ -> (b -> Flag (SymbolicPath from to))
+ -> (Flag (SymbolicPath from to) -> b -> b)
+ -> OptDescr b
+reqSymbolicPathArgFlag title sf lf d get set =
+ reqArgFlag
+ title
+ sf
+ lf
+ d
+ (fmap getSymbolicPath . get)
+ (set . fmap makeSymbolicPath)
+
optionVerbosity
:: (flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags)
diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs
index c2af17b8f9..14e76c7d76 100644
--- a/Cabal/src/Distribution/Simple/Setup/Config.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Config.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,12 +21,19 @@
-- Definition of the configure command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Config
- ( ConfigFlags (..)
+ ( ConfigFlags
+ ( ConfigCommonFlags
+ , configVerbosity
+ , configDistPref
+ , configCabalFilePath
+ , configWorkingDir
+ , configTargets
+ , ..
+ )
, emptyConfigFlags
, defaultConfigFlags
, configureCommand
, configPrograms
- , configAbsolutePaths
, readPackageDb
, readPackageDbList
, showPackageDb
@@ -37,6 +47,8 @@ import Distribution.Compat.Prelude hiding (get)
import Prelude ()
import qualified Distribution.Compat.CharParsing as P
+import Distribution.Compat.Semigroup (Last' (..), Option' (..))
+import Distribution.Compat.Stack
import Distribution.Compiler
import Distribution.ModuleName
import Distribution.PackageDescription
@@ -48,6 +60,7 @@ import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
import Distribution.Simple.Program
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
import Distribution.Types.ComponentId
import Distribution.Types.DumpBuildInfo
@@ -56,13 +69,10 @@ import Distribution.Types.Module
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.UnitId
import Distribution.Utils.NubList
+import Distribution.Utils.Path
import Distribution.Verbosity
-import qualified Text.PrettyPrint as Disp
-
-import Distribution.Compat.Semigroup (Last' (..), Option' (..))
-import Distribution.Compat.Stack
-import Distribution.Simple.Setup.Common
+import qualified Text.PrettyPrint as Disp
-- ------------------------------------------------------------
@@ -76,9 +86,7 @@ import Distribution.Simple.Setup.Common
-- should be updated.
-- IMPORTANT: every time a new flag is added, it should be added to the Eq instance
data ConfigFlags = ConfigFlags
- { -- This is the same hack as in 'buildArgs' and 'copyArgs'.
- -- TODO: Stop using this eventually when 'UserHooks' gets changed
- configArgs :: [String]
+ { configCommonFlags :: !CommonSetupFlags
, -- FIXME: the configPrograms is only here to pass info through to configure
-- because the type of configure is constrained by the UserHooks.
-- when we change UserHooks next we should pass the initial
@@ -137,16 +145,16 @@ data ConfigFlags = ConfigFlags
-- ^ Installation
-- paths
, configScratchDir :: Flag FilePath
- , configExtraLibDirs :: [FilePath]
+ , configExtraLibDirs :: [SymbolicPath Pkg (Dir Lib)]
-- ^ path to search for extra libraries
- , configExtraLibDirsStatic :: [FilePath]
+ , configExtraLibDirsStatic :: [SymbolicPath Pkg (Dir Lib)]
-- ^ path to search for extra
-- libraries when linking
-- fully static executables
- , configExtraFrameworkDirs :: [FilePath]
+ , configExtraFrameworkDirs :: [SymbolicPath Pkg (Dir Framework)]
-- ^ path to search for extra
-- frameworks (OS X only)
- , configExtraIncludeDirs :: [FilePath]
+ , configExtraIncludeDirs :: [SymbolicPath Pkg (Dir Include)]
-- ^ path to search for header files
, configIPID :: Flag String
-- ^ explicit IPID to be used
@@ -156,12 +164,6 @@ data ConfigFlags = ConfigFlags
-- ^ be as deterministic as possible
-- (e.g., invariant over GHC, database,
-- etc). Used by the test suite
- , configDistPref :: Flag FilePath
- -- ^ "dist" prefix
- , configCabalFilePath :: Flag FilePath
- -- ^ Cabal file to use
- , configVerbosity :: Flag Verbosity
- -- ^ verbosity level
, configUserInstall :: Flag Bool
-- ^ The --user\/--global flag
, configPackageDBs :: [Maybe PackageDB]
@@ -229,6 +231,30 @@ data ConfigFlags = ConfigFlags
}
deriving (Generic, Read, Show, Typeable)
+pattern ConfigCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> ConfigFlags
+pattern ConfigCommonFlags
+ { configVerbosity
+ , configDistPref
+ , configWorkingDir
+ , configCabalFilePath
+ , configTargets
+ } <-
+ ( configCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = configVerbosity
+ , setupDistPref = configDistPref
+ , setupWorkingDir = configWorkingDir
+ , setupCabalFilePath = configCabalFilePath
+ , setupTargets = configTargets
+ }
+ )
+
instance Binary ConfigFlags
instance Structured ConfigFlags
@@ -244,7 +270,8 @@ configPrograms =
instance Eq ConfigFlags where
(==) a b =
-- configPrograms skipped: not user specified, has no Eq instance
- equal configProgramPaths
+ equal configCommonFlags
+ && equal configProgramPaths
&& equal configProgramArgs
&& equal configProgramPathExtra
&& equal configHcFlavor
@@ -271,8 +298,6 @@ instance Eq ConfigFlags where
&& equal configExtraIncludeDirs
&& equal configIPID
&& equal configDeterministic
- && equal configDistPref
- && equal configVerbosity
&& equal configUserInstall
&& equal configPackageDBs
&& equal configGHCiLib
@@ -298,18 +323,11 @@ instance Eq ConfigFlags where
where
equal f = on (==) f a b
-configAbsolutePaths :: ConfigFlags -> IO ConfigFlags
-configAbsolutePaths f =
- (\v -> f{configPackageDBs = v})
- `liftM` traverse
- (maybe (return Nothing) (liftM Just . absolutePackageDBPath))
- (configPackageDBs f)
-
{- FOURMOLU_DISABLE -}
defaultConfigFlags :: ProgramDb -> ConfigFlags
defaultConfigFlags progDb =
emptyConfigFlags
- { configArgs = []
+ { configCommonFlags = defaultCommonSetupFlags
, configPrograms_ = Option' (Just (Last' progDb))
, configHcFlavor = maybe NoFlag Flag defaultCompilerFlavor
, configVanillaLib = Flag True
@@ -325,9 +343,6 @@ defaultConfigFlags progDb =
, configOptimization = Flag NormalOptimisation
, configProgPrefix = Flag (toPathTemplate "")
, configProgSuffix = Flag (toPathTemplate "")
- , configDistPref = NoFlag
- , configCabalFilePath = NoFlag
- , configVerbosity = Flag normal
, configUserInstall = Flag False -- TODO: reverse this
#if defined(mingw32_HOST_OS)
-- See #8062 and GHC #21019.
@@ -401,54 +416,44 @@ dispModSubstEntry (k, v) = pretty k <<>> Disp.char '=' <<>> pretty v
configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags]
configureOptions showOrParseArgs =
- [ optionVerbosity
- configVerbosity
- (\v flags -> flags{configVerbosity = v})
- , optionDistPref
- configDistPref
- (\d flags -> flags{configDistPref = d})
- showOrParseArgs
- , option
- []
- ["compiler"]
- "compiler"
- configHcFlavor
- (\v flags -> flags{configHcFlavor = v})
- ( choiceOpt
- [ (Flag GHC, ("g", ["ghc"]), "compile with GHC")
- , (Flag GHCJS, ([], ["ghcjs"]), "compile with GHCJS")
- , (Flag UHC, ([], ["uhc"]), "compile with UHC")
- , -- "haskell-suite" compiler id string will be replaced
- -- by a more specific one during the configure stage
+ withCommonSetupOptions
+ configCommonFlags
+ (\c f -> f{configCommonFlags = c})
+ showOrParseArgs
+ [ option
+ []
+ ["compiler"]
+ "compiler"
+ configHcFlavor
+ (\v flags -> flags{configHcFlavor = v})
+ ( choiceOpt
+ [ (Flag GHC, ("g", ["ghc"]), "compile with GHC")
+ , (Flag GHCJS, ([], ["ghcjs"]), "compile with GHCJS")
+ , (Flag UHC, ([], ["uhc"]), "compile with UHC")
+ , -- "haskell-suite" compiler id string will be replaced
+ -- by a more specific one during the configure stage
- ( Flag (HaskellSuite "haskell-suite")
- , ([], ["haskell-suite"])
- , "compile with a haskell-suite compiler"
- )
- ]
- )
- , option
- ""
- ["cabal-file"]
- "use this Cabal file"
- configCabalFilePath
- (\v flags -> flags{configCabalFilePath = v})
- (reqArgFlag "PATH")
- , option
- "w"
- ["with-compiler"]
- "give the path to a particular compiler"
- configHcPath
- (\v flags -> flags{configHcPath = v})
- (reqArgFlag "PATH")
- , option
- ""
- ["with-hc-pkg"]
- "give the path to the package tool"
- configHcPkg
- (\v flags -> flags{configHcPkg = v})
- (reqArgFlag "PATH")
- ]
+ ( Flag (HaskellSuite "haskell-suite")
+ , ([], ["haskell-suite"])
+ , "compile with a haskell-suite compiler"
+ )
+ ]
+ )
+ , option
+ "w"
+ ["with-compiler"]
+ "give the path to a particular compiler"
+ configHcPath
+ (\v flags -> flags{configHcPath = v})
+ (reqArgFlag "PATH")
+ , option
+ ""
+ ["with-hc-pkg"]
+ "give the path to the package tool"
+ configHcPkg
+ (\v flags -> flags{configHcPkg = v})
+ (reqArgFlag "PATH")
+ ]
++ map liftInstallDirs installDirsOptions
++ [ option
""
@@ -683,7 +688,7 @@ configureOptions showOrParseArgs =
"A list of directories to search for header files"
configExtraIncludeDirs
(\v flags -> flags{configExtraIncludeDirs = v})
- (reqArg' "PATH" (\x -> [x]) id)
+ (reqArg' "PATH" (\x -> [makeSymbolicPath x]) (fmap getSymbolicPath))
, option
""
["deterministic"]
@@ -711,21 +716,21 @@ configureOptions showOrParseArgs =
"A list of directories to search for external libraries"
configExtraLibDirs
(\v flags -> flags{configExtraLibDirs = v})
- (reqArg' "PATH" (\x -> [x]) id)
+ (reqArg' "PATH" (\x -> [makeSymbolicPath x]) (fmap getSymbolicPath))
, option
""
["extra-lib-dirs-static"]
"A list of directories to search for external libraries when linking fully static executables"
configExtraLibDirsStatic
(\v flags -> flags{configExtraLibDirsStatic = v})
- (reqArg' "PATH" (\x -> [x]) id)
+ (reqArg' "PATH" (\x -> [makeSymbolicPath x]) (fmap getSymbolicPath))
, option
""
["extra-framework-dirs"]
"A list of directories to search for external frameworks (OS X only)"
configExtraFrameworkDirs
(\v flags -> flags{configExtraFrameworkDirs = v})
- (reqArg' "PATH" (\x -> [x]) id)
+ (reqArg' "PATH" (\x -> [makeSymbolicPath x]) (fmap getSymbolicPath))
, option
""
["extra-prog-path"]
diff --git a/Cabal/src/Distribution/Simple/Setup/Copy.hs b/Cabal/src/Distribution/Simple/Setup/Copy.hs
index 466263ffed..719592b656 100644
--- a/Cabal/src/Distribution/Simple/Setup/Copy.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Copy.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,7 +21,15 @@
-- Definition of the copy command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Copy
- ( CopyFlags (..)
+ ( CopyFlags
+ ( CopyCommonFlags
+ , copyVerbosity
+ , copyDistPref
+ , copyCabalFilePath
+ , copyWorkingDir
+ , copyTargets
+ , ..
+ )
, emptyCopyFlags
, defaultCopyFlags
, copyCommand
@@ -31,11 +42,11 @@ import Distribution.ReadE
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Verbosity
-import Distribution.Simple.Setup.Common
-
-- ------------------------------------------------------------
-- * Copy flags
@@ -44,28 +55,43 @@ import Distribution.Simple.Setup.Common
-- | Flags to @copy@: (destdir, copy-prefix (backwards compat), verbosity)
data CopyFlags = CopyFlags
- { copyDest :: Flag CopyDest
- , copyDistPref :: Flag FilePath
- , copyVerbosity :: Flag Verbosity
- , -- This is the same hack as in 'buildArgs'. But I (ezyang) don't
- -- think it's a hack, it's the right way to make hooks more robust
- -- TODO: Stop using this eventually when 'UserHooks' gets changed
- copyArgs :: [String]
- , copyCabalFilePath :: Flag FilePath
+ { copyCommonFlags :: !CommonSetupFlags
+ , copyDest :: Flag CopyDest
}
deriving (Show, Generic)
+pattern CopyCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> CopyFlags
+pattern CopyCommonFlags
+ { copyVerbosity
+ , copyDistPref
+ , copyWorkingDir
+ , copyCabalFilePath
+ , copyTargets
+ } <-
+ ( copyCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = copyVerbosity
+ , setupDistPref = copyDistPref
+ , setupWorkingDir = copyWorkingDir
+ , setupCabalFilePath = copyCabalFilePath
+ , setupTargets = copyTargets
+ }
+ )
+
instance Binary CopyFlags
instance Structured CopyFlags
defaultCopyFlags :: CopyFlags
defaultCopyFlags =
CopyFlags
- { copyDest = Flag NoCopyDest
- , copyDistPref = NoFlag
- , copyVerbosity = Flag normal
- , copyArgs = []
- , copyCabalFilePath = mempty
+ { copyCommonFlags = defaultCommonSetupFlags
+ , copyDest = Flag NoCopyDest
}
copyCommand :: CommandUI CopyFlags
@@ -106,41 +132,40 @@ copyCommand =
copyOptions :: ShowOrParseArgs -> [OptionField CopyFlags]
copyOptions showOrParseArgs =
- [ optionVerbosity copyVerbosity (\v flags -> flags{copyVerbosity = v})
- , optionDistPref
- copyDistPref
- (\d flags -> flags{copyDistPref = d})
- showOrParseArgs
- , option
- ""
- ["destdir"]
- "directory to copy files to, prepended to installation directories"
- copyDest
- ( \v flags -> case copyDest flags of
- Flag (CopyToDb _) -> error "Use either 'destdir' or 'target-package-db'."
- _ -> flags{copyDest = v}
- )
- ( reqArg
- "DIR"
- (succeedReadE (Flag . CopyTo))
- (\f -> case f of Flag (CopyTo p) -> [p]; _ -> [])
- )
- , option
- ""
- ["target-package-db"]
- "package database to copy files into. Required when using ${pkgroot} prefix."
- copyDest
- ( \v flags -> case copyDest flags of
- NoFlag -> flags{copyDest = v}
- Flag NoCopyDest -> flags{copyDest = v}
- _ -> error "Use either 'destdir' or 'target-package-db'."
- )
- ( reqArg
- "DATABASE"
- (succeedReadE (Flag . CopyToDb))
- (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])
- )
- ]
+ withCommonSetupOptions
+ copyCommonFlags
+ (\c f -> f{copyCommonFlags = c})
+ showOrParseArgs
+ [ option
+ ""
+ ["destdir"]
+ "directory to copy files to, prepended to installation directories"
+ copyDest
+ ( \v flags -> case copyDest flags of
+ Flag (CopyToDb _) -> error "Use either 'destdir' or 'target-package-db'."
+ _ -> flags{copyDest = v}
+ )
+ ( reqArg
+ "DIR"
+ (succeedReadE (Flag . CopyTo))
+ (\f -> case f of Flag (CopyTo p) -> [p]; _ -> [])
+ )
+ , option
+ ""
+ ["target-package-db"]
+ "package database to copy files into. Required when using ${pkgroot} prefix."
+ copyDest
+ ( \v flags -> case copyDest flags of
+ NoFlag -> flags{copyDest = v}
+ Flag NoCopyDest -> flags{copyDest = v}
+ _ -> error "Use either 'destdir' or 'target-package-db'."
+ )
+ ( reqArg
+ "DATABASE"
+ (succeedReadE (Flag . CopyToDb))
+ (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])
+ )
+ ]
emptyCopyFlags :: CopyFlags
emptyCopyFlags = mempty
diff --git a/Cabal/src/Distribution/Simple/Setup/Global.hs b/Cabal/src/Distribution/Simple/Setup/Global.hs
index c3c8ad9a56..b230289446 100644
--- a/Cabal/src/Distribution/Simple/Setup/Global.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Global.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -30,6 +31,7 @@ import Prelude ()
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Simple.Setup.Common
+import Distribution.Utils.Path
-- ------------------------------------------------------------
@@ -47,6 +49,7 @@ import Distribution.Simple.Setup.Common
data GlobalFlags = GlobalFlags
{ globalVersion :: Flag Bool
, globalNumericVersion :: Flag Bool
+ , globalWorkingDir :: Flag (SymbolicPath CWD (Dir Pkg))
}
deriving (Generic, Typeable)
@@ -55,6 +58,7 @@ defaultGlobalFlags =
GlobalFlags
{ globalVersion = Flag False
, globalNumericVersion = Flag False
+ , globalWorkingDir = NoFlag
}
globalCommand :: [Command action] -> CommandUI GlobalFlags
@@ -108,6 +112,13 @@ globalCommand commands =
globalNumericVersion
(\v flags -> flags{globalNumericVersion = v})
trueArg
+ , option
+ ""
+ ["working-dir"]
+ "Set working directory"
+ globalWorkingDir
+ (\v flags -> flags{globalWorkingDir = v})
+ (reqSymbolicPathArgFlag "DIR")
]
}
diff --git a/Cabal/src/Distribution/Simple/Setup/Haddock.hs b/Cabal/src/Distribution/Simple/Setup/Haddock.hs
index f332a958d0..bcb2c9dbc5 100644
--- a/Cabal/src/Distribution/Simple/Setup/Haddock.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Haddock.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -19,7 +22,15 @@
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Haddock
( HaddockTarget (..)
- , HaddockFlags (..)
+ , HaddockFlags
+ ( HaddockCommonFlags
+ , haddockVerbosity
+ , haddockDistPref
+ , haddockCabalFilePath
+ , haddockWorkingDir
+ , haddockTargets
+ , ..
+ )
, emptyHaddockFlags
, defaultHaddockFlags
, haddockCommand
@@ -42,10 +53,11 @@ import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
import Distribution.Simple.Program
+import Distribution.Simple.Setup.Common
+import Distribution.Utils.Path
import Distribution.Verbosity
-import qualified Text.PrettyPrint as Disp
-import Distribution.Simple.Setup.Common
+import qualified Text.PrettyPrint as Disp
-- ------------------------------------------------------------
@@ -81,7 +93,8 @@ instance Parsec HaddockTarget where
]
data HaddockFlags = HaddockFlags
- { haddockProgramPaths :: [(String, FilePath)]
+ { haddockCommonFlags :: !CommonSetupFlags
+ , haddockProgramPaths :: [(String, FilePath)]
, haddockProgramArgs :: [(String, [String])]
, haddockHoogle :: Flag Bool
, haddockHtml :: Flag Bool
@@ -98,24 +111,45 @@ data HaddockFlags = HaddockFlags
, haddockHscolourCss :: Flag FilePath
, haddockContents :: Flag PathTemplate
, haddockIndex :: Flag PathTemplate
- , haddockDistPref :: Flag FilePath
, haddockKeepTempFiles :: Flag Bool
- , haddockVerbosity :: Flag Verbosity
- , haddockCabalFilePath :: Flag FilePath
, haddockBaseUrl :: Flag String
, haddockLib :: Flag String
, haddockOutputDir :: Flag FilePath
- , haddockArgs :: [String]
}
deriving (Show, Generic, Typeable)
+pattern HaddockCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> HaddockFlags
+pattern HaddockCommonFlags
+ { haddockVerbosity
+ , haddockDistPref
+ , haddockWorkingDir
+ , haddockCabalFilePath
+ , haddockTargets
+ } <-
+ ( haddockCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = haddockVerbosity
+ , setupDistPref = haddockDistPref
+ , setupWorkingDir = haddockWorkingDir
+ , setupCabalFilePath = haddockCabalFilePath
+ , setupTargets = haddockTargets
+ }
+ )
+
instance Binary HaddockFlags
instance Structured HaddockFlags
defaultHaddockFlags :: HaddockFlags
defaultHaddockFlags =
HaddockFlags
- { haddockProgramPaths = mempty
+ { haddockCommonFlags = defaultCommonSetupFlags
+ , haddockProgramPaths = mempty
, haddockProgramArgs = []
, haddockHoogle = Flag False
, haddockHtml = Flag False
@@ -131,15 +165,11 @@ defaultHaddockFlags =
, haddockQuickJump = Flag False
, haddockHscolourCss = NoFlag
, haddockContents = NoFlag
- , haddockDistPref = NoFlag
, haddockKeepTempFiles = Flag False
- , haddockVerbosity = Flag normal
- , haddockCabalFilePath = mempty
, haddockIndex = NoFlag
, haddockBaseUrl = NoFlag
, haddockLib = NoFlag
, haddockOutputDir = NoFlag
- , haddockArgs = mempty
}
haddockCommand :: CommandUI HaddockFlags
@@ -182,176 +212,173 @@ haddockCommand =
haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags]
haddockOptions showOrParseArgs =
- [ optionVerbosity
- haddockVerbosity
- (\v flags -> flags{haddockVerbosity = v})
- , optionDistPref
- haddockDistPref
- (\d flags -> flags{haddockDistPref = d})
- showOrParseArgs
- , option
- ""
- ["keep-temp-files"]
- "Keep temporary files"
- haddockKeepTempFiles
- (\b flags -> flags{haddockKeepTempFiles = b})
- trueArg
- , option
- ""
- ["hoogle"]
- "Generate a hoogle database"
- haddockHoogle
- (\v flags -> flags{haddockHoogle = v})
- trueArg
- , option
- ""
- ["html"]
- "Generate HTML documentation (the default)"
- haddockHtml
- (\v flags -> flags{haddockHtml = v})
- trueArg
- , option
- ""
- ["html-location"]
- "Location of HTML documentation for pre-requisite packages"
- haddockHtmlLocation
- (\v flags -> flags{haddockHtmlLocation = v})
- (reqArgFlag "URL")
- , option
- ""
- ["for-hackage"]
- "Collection of flags to generate documentation suitable for upload to hackage"
- haddockForHackage
- (\v flags -> flags{haddockForHackage = v})
- (noArg (Flag ForHackage))
- , option
- ""
- ["executables"]
- "Run haddock for Executables targets"
- haddockExecutables
- (\v flags -> flags{haddockExecutables = v})
- trueArg
- , option
- ""
- ["tests"]
- "Run haddock for Test Suite targets"
- haddockTestSuites
- (\v flags -> flags{haddockTestSuites = v})
- trueArg
- , option
- ""
- ["benchmarks"]
- "Run haddock for Benchmark targets"
- haddockBenchmarks
- (\v flags -> flags{haddockBenchmarks = v})
- trueArg
- , option
- ""
- ["foreign-libraries"]
- "Run haddock for Foreign Library targets"
- haddockForeignLibs
- (\v flags -> flags{haddockForeignLibs = v})
- trueArg
- , option
- ""
- ["all"]
- "Run haddock for all targets"
- ( \f ->
- allFlags
- [ haddockExecutables f
- , haddockTestSuites f
- , haddockBenchmarks f
- , haddockForeignLibs f
- ]
- )
- ( \v flags ->
- flags
- { haddockExecutables = v
- , haddockTestSuites = v
- , haddockBenchmarks = v
- , haddockForeignLibs = v
- }
- )
- trueArg
- , option
- ""
- ["internal"]
- "Run haddock for internal modules and include all symbols"
- haddockInternal
- (\v flags -> flags{haddockInternal = v})
- trueArg
- , option
- ""
- ["css"]
- "Use PATH as the haddock stylesheet"
- haddockCss
- (\v flags -> flags{haddockCss = v})
- (reqArgFlag "PATH")
- , option
- ""
- ["hyperlink-source", "hyperlink-sources", "hyperlinked-source"]
- "Hyperlink the documentation to the source code"
- haddockLinkedSource
- (\v flags -> flags{haddockLinkedSource = v})
- trueArg
- , option
- ""
- ["quickjump"]
- "Generate an index for interactive documentation navigation"
- haddockQuickJump
- (\v flags -> flags{haddockQuickJump = v})
- trueArg
- , option
- ""
- ["hscolour-css"]
- "Use PATH as the HsColour stylesheet"
- haddockHscolourCss
- (\v flags -> flags{haddockHscolourCss = v})
- (reqArgFlag "PATH")
- , option
- ""
- ["contents-location"]
- "Bake URL in as the location for the contents page"
- haddockContents
- (\v flags -> flags{haddockContents = v})
- ( reqArg'
- "URL"
- (toFlag . toPathTemplate)
- (flagToList . fmap fromPathTemplate)
- )
- , option
- ""
- ["index-location"]
- "Use a separately-generated HTML index"
- haddockIndex
- (\v flags -> flags{haddockIndex = v})
- ( reqArg'
- "URL"
- (toFlag . toPathTemplate)
- (flagToList . fmap fromPathTemplate)
- )
- , option
- ""
- ["base-url"]
- "Base URL for static files."
- haddockBaseUrl
- (\v flags -> flags{haddockBaseUrl = v})
- (reqArgFlag "URL")
- , option
- ""
- ["lib"]
- "location of Haddocks static / auxiliary files"
- haddockLib
- (\v flags -> flags{haddockLib = v})
- (reqArgFlag "DIR")
- , option
- ""
- ["output-dir"]
- "Generate haddock documentation into this directory. This flag is provided as a technology preview and is subject to change in the next releases."
- haddockOutputDir
- (\v flags -> flags{haddockOutputDir = v})
- (reqArgFlag "DIR")
- ]
+ withCommonSetupOptions
+ haddockCommonFlags
+ (\c f -> f{haddockCommonFlags = c})
+ showOrParseArgs
+ [ option
+ ""
+ ["keep-temp-files"]
+ "Keep temporary files"
+ haddockKeepTempFiles
+ (\b flags -> flags{haddockKeepTempFiles = b})
+ trueArg
+ , option
+ ""
+ ["hoogle"]
+ "Generate a hoogle database"
+ haddockHoogle
+ (\v flags -> flags{haddockHoogle = v})
+ trueArg
+ , option
+ ""
+ ["html"]
+ "Generate HTML documentation (the default)"
+ haddockHtml
+ (\v flags -> flags{haddockHtml = v})
+ trueArg
+ , option
+ ""
+ ["html-location"]
+ "Location of HTML documentation for pre-requisite packages"
+ haddockHtmlLocation
+ (\v flags -> flags{haddockHtmlLocation = v})
+ (reqArgFlag "URL")
+ , option
+ ""
+ ["for-hackage"]
+ "Collection of flags to generate documentation suitable for upload to hackage"
+ haddockForHackage
+ (\v flags -> flags{haddockForHackage = v})
+ (noArg (Flag ForHackage))
+ , option
+ ""
+ ["executables"]
+ "Run haddock for Executables targets"
+ haddockExecutables
+ (\v flags -> flags{haddockExecutables = v})
+ trueArg
+ , option
+ ""
+ ["tests"]
+ "Run haddock for Test Suite targets"
+ haddockTestSuites
+ (\v flags -> flags{haddockTestSuites = v})
+ trueArg
+ , option
+ ""
+ ["benchmarks"]
+ "Run haddock for Benchmark targets"
+ haddockBenchmarks
+ (\v flags -> flags{haddockBenchmarks = v})
+ trueArg
+ , option
+ ""
+ ["foreign-libraries"]
+ "Run haddock for Foreign Library targets"
+ haddockForeignLibs
+ (\v flags -> flags{haddockForeignLibs = v})
+ trueArg
+ , option
+ ""
+ ["all"]
+ "Run haddock for all targets"
+ ( \f ->
+ allFlags
+ [ haddockExecutables f
+ , haddockTestSuites f
+ , haddockBenchmarks f
+ , haddockForeignLibs f
+ ]
+ )
+ ( \v flags ->
+ flags
+ { haddockExecutables = v
+ , haddockTestSuites = v
+ , haddockBenchmarks = v
+ , haddockForeignLibs = v
+ }
+ )
+ trueArg
+ , option
+ ""
+ ["internal"]
+ "Run haddock for internal modules and include all symbols"
+ haddockInternal
+ (\v flags -> flags{haddockInternal = v})
+ trueArg
+ , option
+ ""
+ ["css"]
+ "Use PATH as the haddock stylesheet"
+ haddockCss
+ (\v flags -> flags{haddockCss = v})
+ (reqArgFlag "PATH")
+ , option
+ ""
+ ["hyperlink-source", "hyperlink-sources", "hyperlinked-source"]
+ "Hyperlink the documentation to the source code"
+ haddockLinkedSource
+ (\v flags -> flags{haddockLinkedSource = v})
+ trueArg
+ , option
+ ""
+ ["quickjump"]
+ "Generate an index for interactive documentation navigation"
+ haddockQuickJump
+ (\v flags -> flags{haddockQuickJump = v})
+ trueArg
+ , option
+ ""
+ ["hscolour-css"]
+ "Use PATH as the HsColour stylesheet"
+ haddockHscolourCss
+ (\v flags -> flags{haddockHscolourCss = v})
+ (reqArgFlag "PATH")
+ , option
+ ""
+ ["contents-location"]
+ "Bake URL in as the location for the contents page"
+ haddockContents
+ (\v flags -> flags{haddockContents = v})
+ ( reqArg'
+ "URL"
+ (toFlag . toPathTemplate)
+ (flagToList . fmap fromPathTemplate)
+ )
+ , option
+ ""
+ ["index-location"]
+ "Use a separately-generated HTML index"
+ haddockIndex
+ (\v flags -> flags{haddockIndex = v})
+ ( reqArg'
+ "URL"
+ (toFlag . toPathTemplate)
+ (flagToList . fmap fromPathTemplate)
+ )
+ , option
+ ""
+ ["base-url"]
+ "Base URL for static files."
+ haddockBaseUrl
+ (\v flags -> flags{haddockBaseUrl = v})
+ (reqArgFlag "URL")
+ , option
+ ""
+ ["lib"]
+ "location of Haddocks static / auxiliary files"
+ haddockLib
+ (\v flags -> flags{haddockLib = v})
+ (reqArgFlag "DIR")
+ , option
+ ""
+ ["output-dir"]
+ "Generate haddock documentation into this directory. This flag is provided as a technology preview and is subject to change in the next releases."
+ haddockOutputDir
+ (\v flags -> flags{haddockOutputDir = v})
+ (reqArgFlag "DIR")
+ ]
emptyHaddockFlags :: HaddockFlags
emptyHaddockFlags = mempty
diff --git a/Cabal/src/Distribution/Simple/Setup/Hscolour.hs b/Cabal/src/Distribution/Simple/Setup/Hscolour.hs
index 443be76c5d..1c62c2dedc 100644
--- a/Cabal/src/Distribution/Simple/Setup/Hscolour.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Hscolour.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,7 +21,15 @@
-- Definition of the hscolour command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Hscolour
- ( HscolourFlags (..)
+ ( HscolourFlags
+ ( HscolourCommonFlags
+ , hscolourVerbosity
+ , hscolourDistPref
+ , hscolourCabalFilePath
+ , hscolourWorkingDir
+ , hscolourTargets
+ , ..
+ )
, emptyHscolourFlags
, defaultHscolourFlags
, hscolourCommand
@@ -29,9 +40,9 @@ import Prelude ()
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
-import Distribution.Verbosity
-
import Distribution.Simple.Setup.Common
+import Distribution.Utils.Path
+import Distribution.Verbosity
-- ------------------------------------------------------------
@@ -40,17 +51,39 @@ import Distribution.Simple.Setup.Common
-- ------------------------------------------------------------
data HscolourFlags = HscolourFlags
- { hscolourCSS :: Flag FilePath
+ { hscolourCommonFlags :: !CommonSetupFlags
+ , hscolourCSS :: Flag FilePath
, hscolourExecutables :: Flag Bool
, hscolourTestSuites :: Flag Bool
, hscolourBenchmarks :: Flag Bool
, hscolourForeignLibs :: Flag Bool
- , hscolourDistPref :: Flag FilePath
- , hscolourVerbosity :: Flag Verbosity
- , hscolourCabalFilePath :: Flag FilePath
}
deriving (Show, Generic, Typeable)
+pattern HscolourCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> HscolourFlags
+pattern HscolourCommonFlags
+ { hscolourVerbosity
+ , hscolourDistPref
+ , hscolourWorkingDir
+ , hscolourCabalFilePath
+ , hscolourTargets
+ } <-
+ ( hscolourCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = hscolourVerbosity
+ , setupDistPref = hscolourDistPref
+ , setupWorkingDir = hscolourWorkingDir
+ , setupCabalFilePath = hscolourCabalFilePath
+ , setupTargets = hscolourTargets
+ }
+ )
+
instance Binary HscolourFlags
instance Structured HscolourFlags
@@ -60,14 +93,12 @@ emptyHscolourFlags = mempty
defaultHscolourFlags :: HscolourFlags
defaultHscolourFlags =
HscolourFlags
- { hscolourCSS = NoFlag
+ { hscolourCommonFlags = defaultCommonSetupFlags
+ , hscolourCSS = NoFlag
, hscolourExecutables = Flag False
, hscolourTestSuites = Flag False
, hscolourBenchmarks = Flag False
- , hscolourDistPref = NoFlag
, hscolourForeignLibs = Flag False
- , hscolourVerbosity = Flag normal
- , hscolourCabalFilePath = mempty
}
instance Monoid HscolourFlags where
@@ -90,68 +121,65 @@ hscolourCommand =
"Usage: " ++ pname ++ " hscolour [FLAGS]\n"
, commandDefaultFlags = defaultHscolourFlags
, commandOptions = \showOrParseArgs ->
- [ optionVerbosity
- hscolourVerbosity
- (\v flags -> flags{hscolourVerbosity = v})
- , optionDistPref
- hscolourDistPref
- (\d flags -> flags{hscolourDistPref = d})
- showOrParseArgs
- , option
- ""
- ["executables"]
- "Run hscolour for Executables targets"
- hscolourExecutables
- (\v flags -> flags{hscolourExecutables = v})
- trueArg
- , option
- ""
- ["tests"]
- "Run hscolour for Test Suite targets"
- hscolourTestSuites
- (\v flags -> flags{hscolourTestSuites = v})
- trueArg
- , option
- ""
- ["benchmarks"]
- "Run hscolour for Benchmark targets"
- hscolourBenchmarks
- (\v flags -> flags{hscolourBenchmarks = v})
- trueArg
- , option
- ""
- ["foreign-libraries"]
- "Run hscolour for Foreign Library targets"
- hscolourForeignLibs
- (\v flags -> flags{hscolourForeignLibs = v})
- trueArg
- , option
- ""
- ["all"]
- "Run hscolour for all targets"
- ( \f ->
- allFlags
- [ hscolourExecutables f
- , hscolourTestSuites f
- , hscolourBenchmarks f
- , hscolourForeignLibs f
- ]
- )
- ( \v flags ->
- flags
- { hscolourExecutables = v
- , hscolourTestSuites = v
- , hscolourBenchmarks = v
- , hscolourForeignLibs = v
- }
- )
- trueArg
- , option
- ""
- ["css"]
- "Use a cascading style sheet"
- hscolourCSS
- (\v flags -> flags{hscolourCSS = v})
- (reqArgFlag "PATH")
- ]
+ withCommonSetupOptions
+ hscolourCommonFlags
+ (\c f -> f{hscolourCommonFlags = c})
+ showOrParseArgs
+ [ option
+ ""
+ ["executables"]
+ "Run hscolour for Executables targets"
+ hscolourExecutables
+ (\v flags -> flags{hscolourExecutables = v})
+ trueArg
+ , option
+ ""
+ ["tests"]
+ "Run hscolour for Test Suite targets"
+ hscolourTestSuites
+ (\v flags -> flags{hscolourTestSuites = v})
+ trueArg
+ , option
+ ""
+ ["benchmarks"]
+ "Run hscolour for Benchmark targets"
+ hscolourBenchmarks
+ (\v flags -> flags{hscolourBenchmarks = v})
+ trueArg
+ , option
+ ""
+ ["foreign-libraries"]
+ "Run hscolour for Foreign Library targets"
+ hscolourForeignLibs
+ (\v flags -> flags{hscolourForeignLibs = v})
+ trueArg
+ , option
+ ""
+ ["all"]
+ "Run hscolour for all targets"
+ ( \f ->
+ allFlags
+ [ hscolourExecutables f
+ , hscolourTestSuites f
+ , hscolourBenchmarks f
+ , hscolourForeignLibs f
+ ]
+ )
+ ( \v flags ->
+ flags
+ { hscolourExecutables = v
+ , hscolourTestSuites = v
+ , hscolourBenchmarks = v
+ , hscolourForeignLibs = v
+ }
+ )
+ trueArg
+ , option
+ ""
+ ["css"]
+ "Use a cascading style sheet"
+ hscolourCSS
+ (\v flags -> flags{hscolourCSS = v})
+ (reqArgFlag "PATH")
+ ]
}
diff --git a/Cabal/src/Distribution/Simple/Setup/Install.hs b/Cabal/src/Distribution/Simple/Setup/Install.hs
index a0502693ec..eb909612c6 100644
--- a/Cabal/src/Distribution/Simple/Setup/Install.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Install.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,7 +21,15 @@
-- Definition of the install command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Install
- ( InstallFlags (..)
+ ( InstallFlags
+ ( InstallCommonFlags
+ , installVerbosity
+ , installDistPref
+ , installCabalFilePath
+ , installWorkingDir
+ , installTargets
+ , ..
+ )
, emptyInstallFlags
, defaultInstallFlags
, installCommand
@@ -32,11 +43,11 @@ import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Verbosity
-import Distribution.Simple.Setup.Common
-
-- ------------------------------------------------------------
-- * Install flags
@@ -45,28 +56,46 @@ import Distribution.Simple.Setup.Common
-- | Flags to @install@: (package db, verbosity)
data InstallFlags = InstallFlags
- { installPackageDB :: Flag PackageDB
+ { installCommonFlags :: !CommonSetupFlags
+ , installPackageDB :: Flag PackageDB
, installDest :: Flag CopyDest
- , installDistPref :: Flag FilePath
, installUseWrapper :: Flag Bool
, installInPlace :: Flag Bool
- , installVerbosity :: Flag Verbosity
- , -- this is only here, because we can not
- -- change the hooks API.
- installCabalFilePath :: Flag FilePath
}
deriving (Show, Generic)
+pattern InstallCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> InstallFlags
+pattern InstallCommonFlags
+ { installVerbosity
+ , installDistPref
+ , installWorkingDir
+ , installCabalFilePath
+ , installTargets
+ } <-
+ ( installCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = installVerbosity
+ , setupDistPref = installDistPref
+ , setupWorkingDir = installWorkingDir
+ , setupCabalFilePath = installCabalFilePath
+ , setupTargets = installTargets
+ }
+ )
+
defaultInstallFlags :: InstallFlags
defaultInstallFlags =
InstallFlags
- { installPackageDB = NoFlag
+ { installCommonFlags = defaultCommonSetupFlags
+ , installPackageDB = NoFlag
, installDest = Flag NoCopyDest
- , installDistPref = NoFlag
, installUseWrapper = Flag False
, installInPlace = Flag False
- , installVerbosity = Flag normal
- , installCabalFilePath = mempty
}
installCommand :: CommandUI InstallFlags
@@ -84,24 +113,24 @@ installCommand =
, commandUsage = \pname ->
"Usage: " ++ pname ++ " install [FLAGS]\n"
, commandDefaultFlags = defaultInstallFlags
- , commandOptions = \showOrParseArgs -> case showOrParseArgs of
- ShowArgs ->
- filter
- ( (`notElem` ["target-package-db"])
- . optionName
- )
- $ installOptions ShowArgs
- ParseArgs -> installOptions ParseArgs
+ , commandOptions = \showOrParseArgs ->
+ withCommonSetupOptions
+ installCommonFlags
+ (\c f -> f{installCommonFlags = c})
+ showOrParseArgs
+ $ case showOrParseArgs of
+ ShowArgs ->
+ filter
+ ( (`notElem` ["target-package-db"])
+ . optionName
+ )
+ installOptions
+ ParseArgs -> installOptions
}
-installOptions :: ShowOrParseArgs -> [OptionField InstallFlags]
-installOptions showOrParseArgs =
- [ optionVerbosity installVerbosity (\v flags -> flags{installVerbosity = v})
- , optionDistPref
- installDistPref
- (\d flags -> flags{installDistPref = d})
- showOrParseArgs
- , option
+installOptions :: [OptionField InstallFlags]
+installOptions =
+ [ option
""
["inplace"]
"install the package in the install subdirectory of the dist prefix, so it can be used without being installed"
diff --git a/Cabal/src/Distribution/Simple/Setup/Register.hs b/Cabal/src/Distribution/Simple/Setup/Register.hs
index ee1fc0d587..e3eb8d6ac7 100644
--- a/Cabal/src/Distribution/Simple/Setup/Register.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Register.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,7 +21,15 @@
-- Definition of the register command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Register
- ( RegisterFlags (..)
+ ( RegisterFlags
+ ( RegisterCommonFlags
+ , registerVerbosity
+ , registerDistPref
+ , registerCabalFilePath
+ , registerWorkingDir
+ , registerTargets
+ , ..
+ )
, emptyRegisterFlags
, defaultRegisterFlags
, registerCommand
@@ -31,9 +42,9 @@ import Prelude ()
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
-import Distribution.Verbosity
-
import Distribution.Simple.Setup.Common
+import Distribution.Utils.Path
+import Distribution.Verbosity
-- ------------------------------------------------------------
@@ -44,31 +55,48 @@ import Distribution.Simple.Setup.Common
-- | Flags to @register@ and @unregister@: (user package, gen-script,
-- in-place, verbosity)
data RegisterFlags = RegisterFlags
- { regPackageDB :: Flag PackageDB
+ { registerCommonFlags :: !CommonSetupFlags
+ , regPackageDB :: Flag PackageDB
, regGenScript :: Flag Bool
, regGenPkgConf :: Flag (Maybe FilePath)
, regInPlace :: Flag Bool
- , regDistPref :: Flag FilePath
, regPrintId :: Flag Bool
- , regVerbosity :: Flag Verbosity
- , -- Same as in 'buildArgs' and 'copyArgs'
- regArgs :: [String]
- , regCabalFilePath :: Flag FilePath
}
deriving (Show, Generic, Typeable)
+pattern RegisterCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> RegisterFlags
+pattern RegisterCommonFlags
+ { registerVerbosity
+ , registerDistPref
+ , registerWorkingDir
+ , registerCabalFilePath
+ , registerTargets
+ } <-
+ ( registerCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = registerVerbosity
+ , setupDistPref = registerDistPref
+ , setupWorkingDir = registerWorkingDir
+ , setupCabalFilePath = registerCabalFilePath
+ , setupTargets = registerTargets
+ }
+ )
+
defaultRegisterFlags :: RegisterFlags
defaultRegisterFlags =
RegisterFlags
- { regPackageDB = NoFlag
+ { registerCommonFlags = defaultCommonSetupFlags
+ , regPackageDB = NoFlag
, regGenScript = Flag False
, regGenPkgConf = NoFlag
, regInPlace = Flag False
- , regDistPref = NoFlag
, regPrintId = Flag False
- , regArgs = []
- , regCabalFilePath = mempty
- , regVerbosity = Flag normal
}
registerCommand :: CommandUI RegisterFlags
@@ -83,59 +111,58 @@ registerCommand =
"Usage: " ++ pname ++ " register [FLAGS]\n"
, commandDefaultFlags = defaultRegisterFlags
, commandOptions = \showOrParseArgs ->
- [ optionVerbosity regVerbosity (\v flags -> flags{regVerbosity = v})
- , optionDistPref
- regDistPref
- (\d flags -> flags{regDistPref = d})
- showOrParseArgs
- , option
- ""
- ["packageDB"]
- ""
- regPackageDB
- (\v flags -> flags{regPackageDB = v})
- ( choiceOpt
- [
- ( Flag UserPackageDB
- , ([], ["user"])
- , "upon registration, register this package in the user's local package database"
- )
- ,
- ( Flag GlobalPackageDB
- , ([], ["global"])
- , "(default)upon registration, register this package in the system-wide package database"
- )
- ]
- )
- , option
- ""
- ["inplace"]
- "register the package in the build location, so it can be used without being installed"
- regInPlace
- (\v flags -> flags{regInPlace = v})
- trueArg
- , option
- ""
- ["gen-script"]
- "instead of registering, generate a script to register later"
- regGenScript
- (\v flags -> flags{regGenScript = v})
- trueArg
- , option
- ""
- ["gen-pkg-config"]
- "instead of registering, generate a package registration file/directory"
- regGenPkgConf
- (\v flags -> flags{regGenPkgConf = v})
- (optArg' "PKG" Flag flagToList)
- , option
- ""
- ["print-ipid"]
- "print the installed package ID calculated for this package"
- regPrintId
- (\v flags -> flags{regPrintId = v})
- trueArg
- ]
+ withCommonSetupOptions
+ registerCommonFlags
+ (\c f -> f{registerCommonFlags = c})
+ showOrParseArgs
+ $ [ option
+ ""
+ ["packageDB"]
+ ""
+ regPackageDB
+ (\v flags -> flags{regPackageDB = v})
+ ( choiceOpt
+ [
+ ( Flag UserPackageDB
+ , ([], ["user"])
+ , "upon registration, register this package in the user's local package database"
+ )
+ ,
+ ( Flag GlobalPackageDB
+ , ([], ["global"])
+ , "(default)upon registration, register this package in the system-wide package database"
+ )
+ ]
+ )
+ , option
+ ""
+ ["inplace"]
+ "register the package in the build location, so it can be used without being installed"
+ regInPlace
+ (\v flags -> flags{regInPlace = v})
+ trueArg
+ , option
+ ""
+ ["gen-script"]
+ "instead of registering, generate a script to register later"
+ regGenScript
+ (\v flags -> flags{regGenScript = v})
+ trueArg
+ , option
+ ""
+ ["gen-pkg-config"]
+ "instead of registering, generate a package registration file/directory"
+ regGenPkgConf
+ (\v flags -> flags{regGenPkgConf = v})
+ (optArg' "PKG" Flag flagToList)
+ , option
+ ""
+ ["print-ipid"]
+ "print the installed package ID calculated for this package"
+ regPrintId
+ (\v flags -> flags{regPrintId = v})
+ trueArg
+ ]
}
unregisterCommand :: CommandUI RegisterFlags
@@ -150,38 +177,37 @@ unregisterCommand =
"Usage: " ++ pname ++ " unregister [FLAGS]\n"
, commandDefaultFlags = defaultRegisterFlags
, commandOptions = \showOrParseArgs ->
- [ optionVerbosity regVerbosity (\v flags -> flags{regVerbosity = v})
- , optionDistPref
- regDistPref
- (\d flags -> flags{regDistPref = d})
- showOrParseArgs
- , option
- ""
- ["user"]
- ""
- regPackageDB
- (\v flags -> flags{regPackageDB = v})
- ( choiceOpt
- [
- ( Flag UserPackageDB
- , ([], ["user"])
- , "unregister this package in the user's local package database"
- )
- ,
- ( Flag GlobalPackageDB
- , ([], ["global"])
- , "(default) unregister this package in the system-wide package database"
- )
- ]
- )
- , option
- ""
- ["gen-script"]
- "Instead of performing the unregister command, generate a script to unregister later"
- regGenScript
- (\v flags -> flags{regGenScript = v})
- trueArg
- ]
+ withCommonSetupOptions
+ registerCommonFlags
+ (\c f -> f{registerCommonFlags = c})
+ showOrParseArgs
+ $ [ option
+ ""
+ ["user"]
+ ""
+ regPackageDB
+ (\v flags -> flags{regPackageDB = v})
+ ( choiceOpt
+ [
+ ( Flag UserPackageDB
+ , ([], ["user"])
+ , "unregister this package in the user's local package database"
+ )
+ ,
+ ( Flag GlobalPackageDB
+ , ([], ["global"])
+ , "(default) unregister this package in the system-wide package database"
+ )
+ ]
+ )
+ , option
+ ""
+ ["gen-script"]
+ "Instead of performing the unregister command, generate a script to unregister later"
+ regGenScript
+ (\v flags -> flags{regGenScript = v})
+ trueArg
+ ]
}
emptyRegisterFlags :: RegisterFlags
diff --git a/Cabal/src/Distribution/Simple/Setup/Repl.hs b/Cabal/src/Distribution/Simple/Setup/Repl.hs
index 2fae5bffcd..4321a9466c 100644
--- a/Cabal/src/Distribution/Simple/Setup/Repl.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Repl.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,7 +21,15 @@
-- Definition of the repl command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Repl
- ( ReplFlags (..)
+ ( ReplFlags
+ ( ReplCommonFlags
+ , replVerbosity
+ , replDistPref
+ , replCabalFilePath
+ , replWorkingDir
+ , replTargets
+ , ..
+ )
, defaultReplFlags
, replCommand
, ReplOptions (..)
@@ -32,11 +43,11 @@ import Distribution.ReadE
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Simple.Program
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Verbosity
-import Distribution.Simple.Setup.Common
-
-- ------------------------------------------------------------
-- * REPL Flags
@@ -50,6 +61,30 @@ data ReplOptions = ReplOptions
}
deriving (Show, Generic, Typeable)
+pattern ReplCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> ReplFlags
+pattern ReplCommonFlags
+ { replVerbosity
+ , replDistPref
+ , replWorkingDir
+ , replCabalFilePath
+ , replTargets
+ } <-
+ ( replCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = replVerbosity
+ , setupDistPref = replDistPref
+ , setupWorkingDir = replWorkingDir
+ , setupCabalFilePath = replCabalFilePath
+ , setupTargets = replTargets
+ }
+ )
+
instance Binary ReplOptions
instance Structured ReplOptions
@@ -61,10 +96,9 @@ instance Semigroup ReplOptions where
(<>) = gmappend
data ReplFlags = ReplFlags
- { replProgramPaths :: [(String, FilePath)]
+ { replCommonFlags :: !CommonSetupFlags
+ , replProgramPaths :: [(String, FilePath)]
, replProgramArgs :: [(String, [String])]
- , replDistPref :: Flag FilePath
- , replVerbosity :: Flag Verbosity
, replReload :: Flag Bool
, replReplOptions :: ReplOptions
}
@@ -76,10 +110,9 @@ instance Structured ReplFlags
defaultReplFlags :: ReplFlags
defaultReplFlags =
ReplFlags
- { replProgramPaths = mempty
+ { replCommonFlags = defaultCommonSetupFlags
+ , replProgramPaths = mempty
, replProgramArgs = []
- , replDistPref = NoFlag
- , replVerbosity = Flag normal
, replReload = Flag False
, replReplOptions = mempty
}
@@ -143,38 +176,37 @@ replCommand progDb =
commandUsage = \pname -> "Usage: " ++ pname ++ " repl [COMPONENT] [FLAGS]\n"
, commandDefaultFlags = defaultReplFlags
, commandOptions = \showOrParseArgs ->
- optionVerbosity replVerbosity (\v flags -> flags{replVerbosity = v})
- : optionDistPref
- replDistPref
- (\d flags -> flags{replDistPref = d})
- showOrParseArgs
- : programDbPaths
+ withCommonSetupOptions
+ replCommonFlags
+ (\c f -> f{replCommonFlags = c})
+ showOrParseArgs
+ $ programDbPaths
progDb
showOrParseArgs
replProgramPaths
(\v flags -> flags{replProgramPaths = v})
- ++ programDbOption
- progDb
- showOrParseArgs
- replProgramArgs
- (\v flags -> flags{replProgramArgs = v})
- ++ programDbOptions
- progDb
- showOrParseArgs
- replProgramArgs
- (\v flags -> flags{replProgramArgs = v})
- ++ case showOrParseArgs of
- ParseArgs ->
- [ option
- ""
- ["reload"]
- "Used from within an interpreter to update files."
- replReload
- (\v flags -> flags{replReload = v})
- trueArg
- ]
- _ -> []
- ++ map liftReplOption (replOptions showOrParseArgs)
+ ++ programDbOption
+ progDb
+ showOrParseArgs
+ replProgramArgs
+ (\v flags -> flags{replProgramArgs = v})
+ ++ programDbOptions
+ progDb
+ showOrParseArgs
+ replProgramArgs
+ (\v flags -> flags{replProgramArgs = v})
+ ++ case showOrParseArgs of
+ ParseArgs ->
+ [ option
+ ""
+ ["reload"]
+ "Used from within an interpreter to update files."
+ replReload
+ (\v flags -> flags{replReload = v})
+ trueArg
+ ]
+ _ -> []
+ ++ map liftReplOption (replOptions showOrParseArgs)
}
where
liftReplOption = liftOption replReplOptions (\v flags -> flags{replReplOptions = v})
diff --git a/Cabal/src/Distribution/Simple/Setup/SDist.hs b/Cabal/src/Distribution/Simple/Setup/SDist.hs
index 56dde313fb..6caf8e51e5 100644
--- a/Cabal/src/Distribution/Simple/Setup/SDist.hs
+++ b/Cabal/src/Distribution/Simple/Setup/SDist.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,7 +21,15 @@
-- Definition of the sdist command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.SDist
- ( SDistFlags (..)
+ ( SDistFlags
+ ( SDistCommonFlags
+ , sDistVerbosity
+ , sDistDistPref
+ , sDistCabalFilePath
+ , sDistWorkingDir
+ , sDistTargets
+ , ..
+ )
, emptySDistFlags
, defaultSDistFlags
, sdistCommand
@@ -29,9 +40,9 @@ import Prelude ()
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
-import Distribution.Verbosity
-
import Distribution.Simple.Setup.Common
+import Distribution.Utils.Path
+import Distribution.Verbosity
-- ------------------------------------------------------------
@@ -41,22 +52,44 @@ import Distribution.Simple.Setup.Common
-- | Flags to @sdist@: (snapshot, verbosity)
data SDistFlags = SDistFlags
- { sDistSnapshot :: Flag Bool
+ { sDistCommonFlags :: !CommonSetupFlags
+ , sDistSnapshot :: Flag Bool
, sDistDirectory :: Flag FilePath
- , sDistDistPref :: Flag FilePath
, sDistListSources :: Flag FilePath
- , sDistVerbosity :: Flag Verbosity
}
deriving (Show, Generic, Typeable)
+pattern SDistCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> SDistFlags
+pattern SDistCommonFlags
+ { sDistVerbosity
+ , sDistDistPref
+ , sDistWorkingDir
+ , sDistCabalFilePath
+ , sDistTargets
+ } <-
+ ( sDistCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = sDistVerbosity
+ , setupDistPref = sDistDistPref
+ , setupWorkingDir = sDistWorkingDir
+ , setupCabalFilePath = sDistCabalFilePath
+ , setupTargets = sDistTargets
+ }
+ )
+
defaultSDistFlags :: SDistFlags
defaultSDistFlags =
SDistFlags
- { sDistSnapshot = Flag False
+ { sDistCommonFlags = defaultCommonSetupFlags
+ , sDistSnapshot = Flag False
, sDistDirectory = mempty
- , sDistDistPref = NoFlag
, sDistListSources = mempty
- , sDistVerbosity = Flag normal
}
sdistCommand :: CommandUI SDistFlags
@@ -71,35 +104,34 @@ sdistCommand =
"Usage: " ++ pname ++ " sdist [FLAGS]\n"
, commandDefaultFlags = defaultSDistFlags
, commandOptions = \showOrParseArgs ->
- [ optionVerbosity sDistVerbosity (\v flags -> flags{sDistVerbosity = v})
- , optionDistPref
- sDistDistPref
- (\d flags -> flags{sDistDistPref = d})
- showOrParseArgs
- , option
- ""
- ["list-sources"]
- "Just write a list of the package's sources to a file"
- sDistListSources
- (\v flags -> flags{sDistListSources = v})
- (reqArgFlag "FILE")
- , option
- ""
- ["snapshot"]
- "Produce a snapshot source distribution"
- sDistSnapshot
- (\v flags -> flags{sDistSnapshot = v})
- trueArg
- , option
- ""
- ["output-directory"]
- ( "Generate a source distribution in the given directory, "
- ++ "without creating a tarball"
- )
- sDistDirectory
- (\v flags -> flags{sDistDirectory = v})
- (reqArgFlag "DIR")
- ]
+ withCommonSetupOptions
+ sDistCommonFlags
+ (\c f -> f{sDistCommonFlags = c})
+ showOrParseArgs
+ [ option
+ ""
+ ["list-sources"]
+ "Just write a list of the package's sources to a file"
+ sDistListSources
+ (\v flags -> flags{sDistListSources = v})
+ (reqArgFlag "FILE")
+ , option
+ ""
+ ["snapshot"]
+ "Produce a snapshot source distribution"
+ sDistSnapshot
+ (\v flags -> flags{sDistSnapshot = v})
+ trueArg
+ , option
+ ""
+ ["output-directory"]
+ ( "Generate a source distribution in the given directory, "
+ ++ "without creating a tarball"
+ )
+ sDistDirectory
+ (\v flags -> flags{sDistDirectory = v})
+ (reqArgFlag "DIR")
+ ]
}
emptySDistFlags :: SDistFlags
diff --git a/Cabal/src/Distribution/Simple/Setup/Test.hs b/Cabal/src/Distribution/Simple/Setup/Test.hs
index 12501c791b..e4c2706eed 100644
--- a/Cabal/src/Distribution/Simple/Setup/Test.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Test.hs
@@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
@@ -18,7 +21,15 @@
-- Definition of the testing command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Test
- ( TestFlags (..)
+ ( TestFlags
+ ( TestCommonFlags
+ , testVerbosity
+ , testDistPref
+ , testCabalFilePath
+ , testWorkingDir
+ , testTargets
+ , ..
+ )
, emptyTestFlags
, defaultTestFlags
, testCommand
@@ -36,11 +47,12 @@ import Distribution.ReadE
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
+import Distribution.Utils.Path
import Distribution.Verbosity
-import qualified Text.PrettyPrint as Disp
-import Distribution.Simple.Setup.Common
+import qualified Text.PrettyPrint as Disp
-- ------------------------------------------------------------
@@ -80,8 +92,7 @@ instance Semigroup TestShowDetails where
a <> b = if a < b then b else a
data TestFlags = TestFlags
- { testDistPref :: Flag FilePath
- , testVerbosity :: Flag Verbosity
+ { testCommonFlags :: !CommonSetupFlags
, testHumanLog :: Flag PathTemplate
, testMachineLog :: Flag PathTemplate
, testShowDetails :: Flag TestShowDetails
@@ -93,14 +104,37 @@ data TestFlags = TestFlags
}
deriving (Show, Generic, Typeable)
+pattern TestCommonFlags
+ :: Flag Verbosity
+ -> Flag (SymbolicPath Pkg (Dir Dist))
+ -> Flag (SymbolicPath CWD (Dir Pkg))
+ -> Flag (SymbolicPath Pkg File)
+ -> [String]
+ -> TestFlags
+pattern TestCommonFlags
+ { testVerbosity
+ , testDistPref
+ , testWorkingDir
+ , testCabalFilePath
+ , testTargets
+ } <-
+ ( testCommonFlags ->
+ CommonSetupFlags
+ { setupVerbosity = testVerbosity
+ , setupDistPref = testDistPref
+ , setupWorkingDir = testWorkingDir
+ , setupCabalFilePath = testCabalFilePath
+ , setupTargets = testTargets
+ }
+ )
+
instance Binary TestFlags
instance Structured TestFlags
defaultTestFlags :: TestFlags
defaultTestFlags =
TestFlags
- { testDistPref = NoFlag
- , testVerbosity = Flag normal
+ { testCommonFlags = defaultCommonSetupFlags
, testHumanLog = toFlag $ toPathTemplate $ "$pkgid-$test-suite.log"
, testMachineLog = toFlag $ toPathTemplate $ "$pkgid.log"
, testShowDetails = toFlag Direct
@@ -132,116 +166,115 @@ testCommand =
testOptions' :: ShowOrParseArgs -> [OptionField TestFlags]
testOptions' showOrParseArgs =
- [ optionVerbosity testVerbosity (\v flags -> flags{testVerbosity = v})
- , optionDistPref
- testDistPref
- (\d flags -> flags{testDistPref = d})
- showOrParseArgs
- , option
- []
- ["log"]
- ( "Log all test suite results to file (name template can use "
- ++ "$pkgid, $compiler, $os, $arch, $test-suite, $result)"
- )
- testHumanLog
- (\v flags -> flags{testHumanLog = v})
- ( reqArg'
- "TEMPLATE"
- (toFlag . toPathTemplate)
- (flagToList . fmap fromPathTemplate)
- )
- , option
- []
- ["machine-log"]
- ( "Produce a machine-readable log file (name template can use "
- ++ "$pkgid, $compiler, $os, $arch, $result)"
- )
- testMachineLog
- (\v flags -> flags{testMachineLog = v})
- ( reqArg'
- "TEMPLATE"
- (toFlag . toPathTemplate)
- (flagToList . fmap fromPathTemplate)
- )
- , option
- []
- ["show-details"]
- ( "'always': always show results of individual test cases. "
- ++ "'never': never show results of individual test cases. "
- ++ "'failures': show results of failing test cases. "
- ++ "'streaming': show results of test cases in real time."
- ++ "'direct': send results of test cases in real time; no log file."
- )
- testShowDetails
- (\v flags -> flags{testShowDetails = v})
- ( reqArg
- "FILTER"
- ( parsecToReadE
- ( \_ ->
- "--show-details flag expects one of "
- ++ intercalate
- ", "
- (map prettyShow knownTestShowDetails)
- )
- (fmap toFlag parsec)
- )
- (flagToList . fmap prettyShow)
- )
- , option
- []
- ["keep-tix-files"]
- "keep .tix files for HPC between test runs"
- testKeepTix
- (\v flags -> flags{testKeepTix = v})
- trueArg
- , option
- []
- ["test-wrapper"]
- "Run test through a wrapper."
- testWrapper
- (\v flags -> flags{testWrapper = v})
- ( reqArg'
- "FILE"
- (toFlag :: FilePath -> Flag FilePath)
- (flagToList :: Flag FilePath -> [FilePath])
- )
- , option
- []
- ["fail-when-no-test-suites"]
- ("Exit with failure when no test suites are found.")
- testFailWhenNoTestSuites
- (\v flags -> flags{testFailWhenNoTestSuites = v})
- trueArg
- , option
- []
- ["test-options"]
- ( "give extra options to test executables "
- ++ "(name templates can use $pkgid, $compiler, "
- ++ "$os, $arch, $test-suite)"
- )
- testOptions
- (\v flags -> flags{testOptions = v})
- ( reqArg'
- "TEMPLATES"
- (map toPathTemplate . splitArgs)
- (const [])
- )
- , option
- []
- ["test-option"]
- ( "give extra option to test executables "
- ++ "(no need to quote options containing spaces, "
- ++ "name template can use $pkgid, $compiler, "
- ++ "$os, $arch, $test-suite)"
- )
- testOptions
- (\v flags -> flags{testOptions = v})
- ( reqArg'
- "TEMPLATE"
- (\x -> [toPathTemplate x])
- (map fromPathTemplate)
- )
- ]
+ withCommonSetupOptions
+ testCommonFlags
+ (\c f -> f{testCommonFlags = c})
+ showOrParseArgs
+ [ option
+ []
+ ["log"]
+ ( "Log all test suite results to file (name template can use "
+ ++ "$pkgid, $compiler, $os, $arch, $test-suite, $result)"
+ )
+ testHumanLog
+ (\v flags -> flags{testHumanLog = v})
+ ( reqArg'
+ "TEMPLATE"
+ (toFlag . toPathTemplate)
+ (flagToList . fmap fromPathTemplate)
+ )
+ , option
+ []
+ ["machine-log"]
+ ( "Produce a machine-readable log file (name template can use "
+ ++ "$pkgid, $compiler, $os, $arch, $result)"
+ )
+ testMachineLog
+ (\v flags -> flags{testMachineLog = v})
+ ( reqArg'
+ "TEMPLATE"
+ (toFlag . toPathTemplate)
+ (flagToList . fmap fromPathTemplate)
+ )
+ , option
+ []
+ ["show-details"]
+ ( "'always': always show results of individual test cases. "
+ ++ "'never': never show results of individual test cases. "
+ ++ "'failures': show results of failing test cases. "
+ ++ "'streaming': show results of test cases in real time."
+ ++ "'direct': send results of test cases in real time; no log file."
+ )
+ testShowDetails
+ (\v flags -> flags{testShowDetails = v})
+ ( reqArg
+ "FILTER"
+ ( parsecToReadE
+ ( \_ ->
+ "--show-details flag expects one of "
+ ++ intercalate
+ ", "
+ (map prettyShow knownTestShowDetails)
+ )
+ (fmap toFlag parsec)
+ )
+ (flagToList . fmap prettyShow)
+ )
+ , option
+ []
+ ["keep-tix-files"]
+ "keep .tix files for HPC between test runs"
+ testKeepTix
+ (\v flags -> flags{testKeepTix = v})
+ trueArg
+ , option
+ []
+ ["test-wrapper"]
+ "Run test through a wrapper."
+ testWrapper
+ (\v flags -> flags{testWrapper = v})
+ ( reqArg'
+ "FILE"
+ (toFlag :: FilePath -> Flag FilePath)
+ (flagToList :: Flag FilePath -> [FilePath])
+ )
+ , option
+ []
+ ["fail-when-no-test-suites"]
+ ("Exit with failure when no test suites are found.")
+ testFailWhenNoTestSuites
+ (\v flags -> flags{testFailWhenNoTestSuites = v})
+ trueArg
+ , option
+ []
+ ["test-options"]
+ ( "give extra options to test executables "
+ ++ "(name templates can use $pkgid, $compiler, "
+ ++ "$os, $arch, $test-suite)"
+ )
+ testOptions
+ (\v flags -> flags{testOptions = v})
+ ( reqArg'
+ "TEMPLATES"
+ (map toPathTemplate . splitArgs)
+ (const [])
+ )
+ , option
+ []
+ ["test-option"]
+ ( "give extra option to test executables "
+ ++ "(no need to quote options containing spaces, "
+ ++ "name template can use $pkgid, $compiler, "
+ ++ "$os, $arch, $test-suite)"
+ )
+ testOptions
+ (\v flags -> flags{testOptions = v})
+ ( reqArg'
+ "TEMPLATE"
+ (\x -> [toPathTemplate x])
+ (map fromPathTemplate)
+ )
+ ]
emptyTestFlags :: TestFlags
emptyTestFlags = mempty
diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs
index 4f84f3ed8e..493c972ae8 100644
--- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs
+++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
-- |
-- This module defines a simple JSON-based format for exporting basic
@@ -76,15 +78,14 @@ import Distribution.Compiler
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Simple.Compiler (Compiler, compilerFlavor, showCompilerId)
+import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.Simple.Setup.Build (BuildFlags)
import Distribution.Simple.Utils (cabalVersion)
import Distribution.Text
-import Distribution.Types.Component
-import Distribution.Types.ComponentLocalBuildInfo
-import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Utils.Json
+import Distribution.Utils.Path
import Distribution.Verbosity
-- | Construct a JSON document describing the build information for a
@@ -147,7 +148,7 @@ mkComponentInfo wdir pkg_descr lbi clbi =
, "unit-id" .= JsonString (prettyShow $ componentUnitId clbi)
, "compiler-args" .= JsonArray (map JsonString compilerArgs)
, "modules" .= JsonArray (map (JsonString . display) modules)
- , "src-files" .= JsonArray (map JsonString sourceFiles)
+ , "src-files" .= JsonArray (map (JsonString . getSymbolicPath) sourceFiles)
, "hs-src-dirs" .= JsonArray (map (JsonString . prettyShow) $ hsSourceDirs bi)
, "src-dir" .= JsonString (addTrailingPathSeparator wdir)
]
@@ -188,7 +189,7 @@ mkComponentInfo wdir pkg_descr lbi clbi =
BenchmarkUnsupported _ -> []
CFLib _ -> []
cabalFile
- | Just fp <- pkgDescrFile lbi = [("cabal-file", JsonString fp)]
+ | Just fp <- pkgDescrFile lbi = [("cabal-file", JsonString $ getSymbolicPath fp)]
| otherwise = []
-- | Get the command-line arguments that would be passed
@@ -200,8 +201,8 @@ getCompilerArgs
-> ([String], [String])
getCompilerArgs bi lbi clbi =
case compilerFlavor $ compiler lbi of
- GHC -> ([], ghc)
- GHCJS -> ([], ghc)
+ GHC -> ([], ghcArgs)
+ GHCJS -> ([], ghcArgs)
c ->
(
[ "ShowBuildInfo.getCompilerArgs: Don't know how to get build "
@@ -212,6 +213,8 @@ getCompilerArgs bi lbi clbi =
)
where
-- This is absolutely awful
- ghc = GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts
- where
- baseOpts = GHC.componentGhcOptions normal lbi bi clbi (buildDir lbi)
+ ghcArgs =
+ GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts
+ baseOpts =
+ GHC.componentGhcOptions normal lbi bi clbi $
+ buildDir lbi
diff --git a/Cabal/src/Distribution/Simple/SrcDist.hs b/Cabal/src/Distribution/Simple/SrcDist.hs
index 90250290fc..443fc87ae5 100644
--- a/Cabal/src/Distribution/Simple/SrcDist.hs
+++ b/Cabal/src/Distribution/Simple/SrcDist.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -47,17 +48,18 @@ import Distribution.Compat.Prelude
import Prelude ()
import Distribution.ModuleName
-import qualified Distribution.ModuleName as ModuleName
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.Pretty
import Distribution.Simple.BuildPaths
import Distribution.Simple.Configure (findDistPrefOrDefault)
+import Distribution.Simple.Errors
import Distribution.Simple.Flag
import Distribution.Simple.Glob (matchDirFileGlobWithDie)
import Distribution.Simple.PreProcess
import Distribution.Simple.Program
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.SDist
import Distribution.Simple.Utils
import Distribution.Utils.Path
@@ -66,9 +68,7 @@ import Distribution.Version
import qualified Data.Map as Map
import Data.Time (UTCTime, getCurrentTime, toGregorian, utctDay)
-import Distribution.Simple.Errors
import System.Directory (doesFileExist)
-import System.FilePath (dropExtension, isRelative, (<.>), (</>))
import System.IO (IOMode (WriteMode), hPutStrLn, withFile)
-- | Create a source distribution.
@@ -83,15 +83,15 @@ sdist
-- ^ extra preprocessors (includes suffixes)
-> IO ()
sdist pkg flags mkTmpDir pps = do
- distPref <- findDistPrefOrDefault $ sDistDistPref flags
- let targetPref = distPref
- tmpTargetDir = mkTmpDir distPref
+ distPref <- findDistPrefOrDefault $ setupDistPref common
+ let targetPref = i distPref
+ tmpTargetDir = mkTmpDir (i distPref)
-- When given --list-sources, just output the list of sources to a file.
case sDistListSources flags of
Flag path -> withFile path WriteMode $ \outHandle -> do
- ordinary <- listPackageSources verbosity "." pkg pps
- traverse_ (hPutStrLn outHandle) ordinary
+ ordinary <- listPackageSources verbosity mbWorkDir pkg pps
+ traverse_ (hPutStrLn outHandle . getSymbolicPath) ordinary
notice verbosity $ "List of package sources written to file '" ++ path ++ "'"
NoFlag -> do
-- do some QA
@@ -117,11 +117,14 @@ sdist pkg flags mkTmpDir pps = do
generateSourceDir :: FilePath -> PackageDescription -> IO ()
generateSourceDir targetDir pkg' = do
setupMessage verbosity "Building source dist for" (packageId pkg')
- prepareTree verbosity pkg' targetDir pps
+ prepareTree verbosity mbWorkDir pkg' targetDir pps
when snapshot $
overwriteSnapshotPackageDesc verbosity pkg' targetDir
- verbosity = fromFlag (sDistVerbosity flags)
+ common = sDistCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ mbWorkDir = flagToMaybe $ setupWorkingDir common
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
snapshot = fromFlag (sDistSnapshot flags)
-- | List all source files of a package.
@@ -131,14 +134,13 @@ sdist pkg flags mkTmpDir pps = do
listPackageSources
:: Verbosity
-- ^ verbosity
- -> FilePath
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-- ^ directory with cabal file
-> PackageDescription
-- ^ info from the cabal file
-> [PPSuffixHandler]
-- ^ extra preprocessors (include suffixes)
- -> IO [FilePath]
- -- ^ relative paths
+ -> IO [SymbolicPath Pkg File]
listPackageSources verbosity cwd pkg_descr0 pps = do
-- Call helpers that actually do all work.
listPackageSources' verbosity dieWithException cwd pkg_descr pps
@@ -153,19 +155,18 @@ listPackageSources verbosity cwd pkg_descr0 pps = do
listPackageSourcesWithDie
:: Verbosity
-- ^ verbosity
- -> (Verbosity -> CabalException -> IO [FilePath])
+ -> (forall res. Verbosity -> CabalException -> IO [res])
-- ^ 'die'' alternative.
-- Since 'die'' prefixes the error message with 'errorPrefix',
-- whatever is passed in here and wants to die should do the same.
-- See issue #7331.
- -> FilePath
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-- ^ directory with cabal file
-> PackageDescription
-- ^ info from the cabal file
-> [PPSuffixHandler]
-- ^ extra preprocessors (include suffixes)
- -> IO [FilePath]
- -- ^ relative paths
+ -> IO [SymbolicPath Pkg File]
listPackageSourcesWithDie verbosity rip cwd pkg_descr0 pps = do
-- Call helpers that actually do all work.
listPackageSources' verbosity rip cwd pkg_descr pps
@@ -175,20 +176,19 @@ listPackageSourcesWithDie verbosity rip cwd pkg_descr0 pps = do
listPackageSources'
:: Verbosity
-- ^ verbosity
- -> (Verbosity -> CabalException -> IO [FilePath])
+ -> (forall res. Verbosity -> CabalException -> IO [res])
-- ^ 'die'' alternative.
-- Since 'die'' prefixes the error message with 'errorPrefix',
-- whatever is passed in here and wants to die should do the same.
-- See issue #7331.
- -> FilePath
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
-- ^ directory with cabal file
-> PackageDescription
-- ^ info from the cabal file
-> [PPSuffixHandler]
-- ^ extra preprocessors (include suffixes)
- -> IO [FilePath]
- -- ^ relative paths
-listPackageSources' verbosity rip cwd pkg_descr pps =
+ -> IO [SymbolicPath Pkg File]
+listPackageSources' verbosity rip mbWorkDir pkg_descr pps =
fmap concat . sequenceA $
[ -- Library sources.
fmap concat
@@ -198,22 +198,22 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
, signatures = sigs
, libBuildInfo = libBi
} ->
- allSourcesBuildInfo verbosity rip cwd libBi pps (modules ++ sigs)
+ allSourcesBuildInfo verbosity rip mbWorkDir libBi pps (modules ++ sigs)
, -- Executables sources.
fmap concat
. withAllExe
$ \Executable{modulePath = mainPath, buildInfo = exeBi} -> do
- biSrcs <- allSourcesBuildInfo verbosity rip cwd exeBi pps []
- mainSrc <- findMainExeFile verbosity cwd exeBi pps mainPath
+ biSrcs <- allSourcesBuildInfo verbosity rip mbWorkDir exeBi pps []
+ mainSrc <- findMainExeFile verbosity mbWorkDir exeBi pps mainPath
return (mainSrc : biSrcs)
, -- Foreign library sources
fmap concat
. withAllFLib
$ \flib@(ForeignLib{foreignLibBuildInfo = flibBi}) -> do
- biSrcs <- allSourcesBuildInfo verbosity rip cwd flibBi pps []
+ biSrcs <- allSourcesBuildInfo verbosity rip mbWorkDir flibBi pps []
defFiles <-
traverse
- (findModDefFile verbosity cwd flibBi pps)
+ (findModDefFile verbosity mbWorkDir flibBi pps)
(foreignLibModDefFile flib)
return (defFiles ++ biSrcs)
, -- Test suites sources.
@@ -223,11 +223,11 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
let bi = testBuildInfo t
case testInterface t of
TestSuiteExeV10 _ mainPath -> do
- biSrcs <- allSourcesBuildInfo verbosity rip cwd bi pps []
- srcMainFile <- findMainExeFile verbosity cwd bi pps mainPath
+ biSrcs <- allSourcesBuildInfo verbosity rip mbWorkDir bi pps []
+ srcMainFile <- findMainExeFile verbosity mbWorkDir bi pps mainPath
return (srcMainFile : biSrcs)
TestSuiteLibV09 _ m ->
- allSourcesBuildInfo verbosity rip cwd bi pps [m]
+ allSourcesBuildInfo verbosity rip mbWorkDir bi pps [m]
TestSuiteUnsupported tp ->
rip verbosity $ UnsupportedTestSuite (show tp)
, -- Benchmarks sources.
@@ -237,8 +237,8 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
let bi = benchmarkBuildInfo bm
case benchmarkInterface bm of
BenchmarkExeV10 _ mainPath -> do
- biSrcs <- allSourcesBuildInfo verbosity rip cwd bi pps []
- srcMainFile <- findMainExeFile verbosity cwd bi pps mainPath
+ biSrcs <- allSourcesBuildInfo verbosity rip mbWorkDir bi pps []
+ srcMainFile <- findMainExeFile verbosity mbWorkDir bi pps mainPath
return (srcMainFile : biSrcs)
BenchmarkUnsupported tp ->
rip verbosity $ UnsupportedBenchMark (show tp)
@@ -248,34 +248,39 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
$ \filename ->
do
let srcDataDirRaw = dataDir pkg_descr
- srcDataDir
- | null srcDataDirRaw = "."
- | otherwise = srcDataDirRaw
- matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd (srcDataDir </> filename)
+ srcDataFile :: SymbolicPath Pkg File
+ srcDataFile
+ | null (getSymbolicPath srcDataDirRaw) = sameDirectory </> filename
+ | otherwise = srcDataDirRaw </> filename
+ fmap coerceSymbolicPath
+ <$> matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) mbWorkDir srcDataFile
, -- Extra source files.
fmap concat . for (extraSrcFiles pkg_descr) $ \fpath ->
- matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd fpath
+ fmap relativeSymbolicPath
+ <$> matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) mbWorkDir fpath
, -- Extra doc files.
fmap concat
. for (extraDocFiles pkg_descr)
$ \filename ->
- matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd filename
+ fmap (coerceSymbolicPath . relativeSymbolicPath)
+ <$> matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) mbWorkDir filename
, -- License file(s).
- return (map getSymbolicPath $ licenseFiles pkg_descr)
+ return (map (relativeSymbolicPath . coerceSymbolicPath) $ licenseFiles pkg_descr)
, -- Install-include files, without autogen-include files
fmap concat
. withAllLib
$ \l -> do
let lbi = libBuildInfo l
- incls = filter (`notElem` autogenIncludes lbi) (installIncludes lbi)
- relincdirs = "." : filter isRelative (includeDirs lbi)
- traverse (fmap snd . findIncludeFile verbosity cwd relincdirs) incls
+ incls = fmap getSymbolicPath $ filter (`notElem` autogenIncludes lbi) (installIncludes lbi)
+ relincdirs = fmap getSymbolicPath $ sameDirectory : mapMaybe symbolicPathRelative_maybe (includeDirs lbi)
+ traverse (fmap (makeSymbolicPath . snd) . findIncludeFile verbosity cwd relincdirs) incls
, -- Setup script, if it exists.
- fmap (maybe [] (\f -> [f])) $ findSetupFile cwd
+ fmap (maybe [] (\f -> [makeSymbolicPath f])) $ findSetupFile cwd
, -- The .cabal file itself.
- fmap (\d -> [d]) (tryFindPackageDescCwd verbosity cwd ".")
+ fmap (\d -> [d]) (coerceSymbolicPath . relativeSymbolicPath <$> tryFindPackageDesc verbosity mbWorkDir)
]
where
+ cwd = maybe "." getSymbolicPath mbWorkDir
-- We have to deal with all libs and executables, so we have local
-- versions of these functions that ignore the 'buildable' attribute:
withAllLib action = traverse action (allLibraries pkg_descr)
@@ -288,6 +293,8 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
prepareTree
:: Verbosity
-- ^ verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ working directory
-> PackageDescription
-- ^ info from the cabal file
-> FilePath
@@ -295,11 +302,12 @@ prepareTree
-> [PPSuffixHandler]
-- ^ extra preprocessors (includes suffixes)
-> IO ()
-prepareTree verbosity pkg_descr0 targetDir pps = do
- ordinary <- listPackageSources verbosity "." pkg_descr pps
- installOrdinaryFiles verbosity targetDir (zip (repeat []) ordinary)
+prepareTree verbosity mbWorkDir pkg_descr0 targetDir pps = do
+ ordinary <- listPackageSources verbosity mbWorkDir pkg_descr pps
+ installOrdinaryFiles verbosity targetDir (zip (repeat []) $ map i ordinary)
maybeCreateDefaultSetupScript targetDir
where
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
pkg_descr = filterAutogenModules pkg_descr0
-- | Find the setup script file, if it exists.
@@ -333,31 +341,36 @@ maybeCreateDefaultSetupScript targetDir = do
-- | Find the main executable file.
findMainExeFile
:: Verbosity
- -> FilePath
- -- ^ cwd
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ working directory
-> BuildInfo
-> [PPSuffixHandler]
- -> FilePath
+ -> RelativePath Source File
-- ^ main-is
- -> IO FilePath
+ -> IO (SymbolicPath Pkg File)
findMainExeFile verbosity cwd exeBi pps mainPath = do
ppFile <-
findFileCwdWithExtension
cwd
(ppSuffixes pps)
- (map getSymbolicPath (hsSourceDirs exeBi))
- (dropExtension mainPath)
+ (hsSourceDirs exeBi)
+ (dropExtensionsSymbolicPath mainPath)
case ppFile of
- Nothing -> findFileCwd verbosity cwd (map getSymbolicPath (hsSourceDirs exeBi)) mainPath
+ Nothing -> findFileCwd verbosity cwd (hsSourceDirs exeBi) mainPath
Just pp -> return pp
-- | Find a module definition file
--
-- TODO: I don't know if this is right
findModDefFile
- :: Verbosity -> FilePath -> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
+ :: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> BuildInfo
+ -> [PPSuffixHandler]
+ -> RelativePath Source File
+ -> IO (SymbolicPath Pkg File)
findModDefFile verbosity cwd flibBi _pps modDefPath =
- findFileCwd verbosity cwd ("." : map getSymbolicPath (hsSourceDirs flibBi)) modDefPath
+ findFileCwd verbosity cwd (sameDirectory : hsSourceDirs flibBi) modDefPath
-- | Given a list of include paths, try to find the include file named
-- @f@. Return the name of the file and the full path, or exit with error if
@@ -365,7 +378,7 @@ findModDefFile verbosity cwd flibBi _pps modDefPath =
findIncludeFile :: Verbosity -> FilePath -> [FilePath] -> String -> IO (String, FilePath)
findIncludeFile verbosity _ [] f = dieWithException verbosity $ NoIncludeFileFound f
findIncludeFile verbosity cwd (d : ds) f = do
- let path = (d </> f)
+ let path = d </> f
b <- doesFileExist (cwd </> path)
if b then return (f, path) else findIncludeFile verbosity cwd ds f
@@ -402,6 +415,8 @@ filterAutogenModules pkg_descr0 =
prepareSnapshotTree
:: Verbosity
-- ^ verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ working directory
-> PackageDescription
-- ^ info from the cabal file
-> FilePath
@@ -409,8 +424,8 @@ prepareSnapshotTree
-> [PPSuffixHandler]
-- ^ extra preprocessors (includes suffixes)
-> IO ()
-prepareSnapshotTree verbosity pkg targetDir pps = do
- prepareTree verbosity pkg targetDir pps
+prepareSnapshotTree verbosity mbWorkDir pkg targetDir pps = do
+ prepareTree verbosity mbWorkDir pkg targetDir pps
overwriteSnapshotPackageDesc verbosity pkg targetDir
overwriteSnapshotPackageDesc
@@ -424,7 +439,7 @@ overwriteSnapshotPackageDesc
overwriteSnapshotPackageDesc verbosity pkg targetDir = do
-- We could just writePackageDescription targetDescFile pkg_descr,
-- but that would lose comments and formatting.
- descFile <- defaultPackageDesc verbosity
+ descFile <- getSymbolicPath <$> defaultPackageDescCwd verbosity
withUTF8FileContents descFile $
writeUTF8File (targetDir </> descFile)
. unlines
@@ -493,37 +508,37 @@ createArchive verbosity pkg_descr tmpDir targetPref = do
-- | Given a buildinfo, return the names of all source files.
allSourcesBuildInfo
:: Verbosity
- -> (Verbosity -> CabalException -> IO [FilePath])
+ -> (Verbosity -> CabalException -> IO [SymbolicPath Pkg File])
-- ^ 'die'' alternative.
-- Since 'die'' prefixes the error message with 'errorPrefix',
-- whatever is passed in here and wants to die should do the same.
-- See issue #7331.
- -> FilePath
- -- ^ cwd -- change me to 'BuildPath Absolute PackageDir'
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ working directory
-> BuildInfo
-> [PPSuffixHandler]
-- ^ Extra preprocessors
-> [ModuleName]
-- ^ Exposed modules
- -> IO [FilePath]
-allSourcesBuildInfo verbosity rip cwd bi pps modules = do
- let searchDirs = map getSymbolicPath (hsSourceDirs bi)
+ -> IO [SymbolicPath Pkg File]
+allSourcesBuildInfo verbosity rip mbWorkDir bi pps modules = do
+ let searchDirs = hsSourceDirs bi
sources <-
fmap concat $
sequenceA $
- [ let file = ModuleName.toFilePath module_
+ [ let file = moduleNameSymbolicPath module_
in -- NB: *Not* findFileWithExtension, because the same source
-- file may show up in multiple paths due to a conditional;
-- we need to package all of them. See #367.
- findAllFilesCwdWithExtension cwd suffixes searchDirs file
+ findAllFilesCwdWithExtension mbWorkDir suffixes searchDirs file
>>= nonEmpty' (notFound module_) return
| module_ <- modules ++ otherModules bi
]
bootFiles <-
sequenceA
- [ let file = ModuleName.toFilePath module_
+ [ let file = moduleNameSymbolicPath module_
fileExts = builtinHaskellBootSuffixes
- in findFileCwdWithExtension cwd fileExts (map getSymbolicPath (hsSourceDirs bi)) file
+ in findFileCwdWithExtension mbWorkDir fileExts (hsSourceDirs bi) file
| module_ <- modules ++ otherModules bi
]
@@ -542,7 +557,7 @@ allSourcesBuildInfo verbosity rip cwd bi pps modules = do
suffixes = ppSuffixes pps ++ builtinHaskellSuffixes
- notFound :: ModuleName -> IO [FilePath]
+ notFound :: ModuleName -> IO [SymbolicPath Pkg File]
notFound m =
rip verbosity $ NoModuleFound m suffixes
diff --git a/Cabal/src/Distribution/Simple/Test.hs b/Cabal/src/Distribution/Simple/Test.hs
index 3c033dd979..3d364ae44b 100644
--- a/Cabal/src/Distribution/Simple/Test.hs
+++ b/Cabal/src/Distribution/Simple/Test.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
@@ -26,7 +27,6 @@ import Prelude ()
import qualified Distribution.PackageDescription as PD
import Distribution.Pretty
import Distribution.Simple.Compiler
-import Distribution.Simple.Flag (fromFlag)
import Distribution.Simple.Hpc
import Distribution.Simple.InstallDirs
import qualified Distribution.Simple.LocalBuildInfo as LBI
@@ -39,12 +39,12 @@ import Distribution.Simple.Utils
import Distribution.TestSuite
import qualified Distribution.Types.LocalBuildInfo as LBI
import Distribution.Types.UnqualComponentName
+import Distribution.Utils.Path
import Distribution.Simple.Configure (getInstalledPackagesById)
import Distribution.Simple.Errors
-import Distribution.Simple.Register
-import Distribution.Simple.Setup (fromFlagOrDefault)
-import Distribution.Simple.Setup.Common (extraCompilationArtifacts)
+import Distribution.Simple.Register (internalPackageDBPath)
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Config
import Distribution.Types.ExposedModule
import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo (libraryDirs), exposedModules)
@@ -55,7 +55,6 @@ import System.Directory
, getDirectoryContents
, removeFile
)
-import System.FilePath ((</>))
-- | Perform the \"@.\/setup test@\" action.
test
@@ -69,16 +68,19 @@ test
-- ^ flags sent to test
-> IO ()
test args pkg_descr lbi0 flags = do
- let verbosity = fromFlag $ testVerbosity flags
+ let common = testCommonFlags flags
+ verbosity = fromFlag $ setupVerbosity common
+ distPref = fromFlag $ setupDistPref common
+ mbWorkDir = flagToMaybe $ setupWorkingDir common
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
machineTemplate = fromFlag $ testMachineLog flags
- distPref = fromFlag $ testDistPref flags
- testLogDir = distPref </> "test"
+ testLogDir = distPref </> makeRelativePathEx "test"
testNames = args
pkgTests = PD.testSuites pkg_descr
enabledTests = LBI.enabledTestLBIs pkg_descr lbi
-- We must add the internalPkgDB to the package database stack to lookup
-- the path to HPC dirs of libraries local to this package
- internalPkgDB = internalPackageDBPath lbi distPref
+ internalPkgDB = LBI.interpretSymbolicPathLBI lbi $ internalPackageDBPath lbi distPref
lbi = lbi0{withPackageDB = withPackageDB lbi0 ++ [SpecificPackageDB internalPkgDB]}
doTest
@@ -130,11 +132,11 @@ test args pkg_descr lbi0 flags = do
dieWithException verbosity $ TestNameDisabled tName
| otherwise -> dieWithException verbosity $ NoSuchTest tName
- createDirectoryIfMissing True testLogDir
+ createDirectoryIfMissing True $ i testLogDir
-- Delete ordinary files from test log directory.
- getDirectoryContents testLogDir
- >>= filterM doesFileExist . map (testLogDir </>)
+ getDirectoryContents (i testLogDir)
+ >>= filterM doesFileExist . map (i testLogDir </>)
>>= traverse_ removeFile
-- We configured the unit-ids of libraries we should cover in our coverage
@@ -154,7 +156,7 @@ test args pkg_descr lbi0 flags = do
unzip $
map
( \ip ->
- ( map (</> extraCompilationArtifacts) $ libraryDirs ip
+ ( map ((</> coerceSymbolicPath extraCompilationArtifacts) . makeSymbolicPath) $ libraryDirs ip
, map exposedName $ exposedModules ip
)
)
@@ -166,8 +168,8 @@ test args pkg_descr lbi0 flags = do
suites <- traverse (doTest hpcMarkupInfo) testsToRun
let packageLog = (localPackageLog pkg_descr lbi){testSuites = suites}
packageLogFile =
- (</>) testLogDir $
- packageLogPath machineTemplate pkg_descr lbi
+ i testLogDir
+ </> packageLogPath machineTemplate pkg_descr lbi
allOk <- summarizePackage verbosity packageLog
writeFile packageLogFile $ show packageLog
diff --git a/Cabal/src/Distribution/Simple/Test/ExeV10.hs b/Cabal/src/Distribution/Simple/Test/ExeV10.hs
index af7a896d84..fc9a3439ee 100644
--- a/Cabal/src/Distribution/Simple/Test/ExeV10.hs
+++ b/Cabal/src/Distribution/Simple/Test/ExeV10.hs
@@ -13,6 +13,7 @@ import qualified Distribution.PackageDescription as PD
import Distribution.Simple.Build.PathsModule
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
+import Distribution.Simple.Errors
import Distribution.Simple.Flag
import Distribution.Simple.Hpc
import Distribution.Simple.InstallDirs
@@ -21,6 +22,7 @@ import qualified Distribution.Simple.LocalBuildInfo as LBI
, buildDir
, depLibraryPaths
)
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Test
import Distribution.Simple.Test.Log
import Distribution.Simple.Utils
@@ -34,20 +36,19 @@ import qualified Distribution.Types.LocalBuildInfo as LBI
import Distribution.Types.UnqualComponentName
import Distribution.Verbosity
+import Distribution.Utils.Path
+
+import qualified Data.ByteString.Lazy as LBS
+import Distribution.Simple.LocalBuildInfo (interpretSymbolicPathLBI, packageRoot)
import System.Directory
( createDirectoryIfMissing
, doesDirectoryExist
, doesFileExist
- , getCurrentDirectory
, removeDirectoryRecursive
)
-import System.FilePath ((<.>), (</>))
import System.IO (stderr, stdout)
import System.Process (createPipe)
-import qualified Data.ByteString.Lazy as LBS
-import Distribution.Simple.Errors
-
runTest
:: PD.PackageDescription
-> LBI.LocalBuildInfo
@@ -59,13 +60,12 @@ runTest
runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do
let isCoverageEnabled = LBI.testCoverage lbi
way = guessWay lbi
- tixDir_ = tixDir distPref way
+ tixDir_ = i $ tixDir distPref way
- pwd <- getCurrentDirectory
existingEnv <- getEnvironment
let cmd =
- LBI.buildDir lbi
+ i (LBI.buildDir lbi)
</> testName'
</> testName' <.> exeExtension (LBI.hostPlatform lbi)
-- Check that the test executable exists.
@@ -90,8 +90,13 @@ runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do
map
(testOption pkg_descr lbi suite)
(testOptions flags)
- dataDirPath = pwd </> PD.dataDir pkg_descr
- tixFile = pwd </> tixFilePath distPref way (testName')
+ rawDataDir = PD.dataDir pkg_descr
+ dataDirPath
+ | null $ getSymbolicPath rawDataDir =
+ interpretSymbolicPath mbWorkDir sameDirectory
+ | otherwise =
+ interpretSymbolicPath mbWorkDir rawDataDir
+ tixFile = packageRoot (testCommonFlags flags) </> getSymbolicPath (tixFilePath distPref way (testName'))
pkgPathEnv =
(pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: existingEnv
@@ -191,12 +196,16 @@ runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do
return suiteLog
where
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
+ commonFlags = testCommonFlags flags
+ mbWorkDir = flagToMaybe $ setupWorkingDir commonFlags
+
testName' = unUnqualComponentName $ PD.testName suite
- distPref = fromFlag $ testDistPref flags
- verbosity = fromFlag $ testVerbosity flags
+ distPref = fromFlag $ setupDistPref commonFlags
+ verbosity = fromFlag $ setupVerbosity commonFlags
details = fromFlag $ testShowDetails flags
- testLogDir = distPref </> "test"
+ testLogDir = distPref </> makeRelativePathEx "test"
buildLog exit =
let r = case exit of
@@ -213,7 +222,7 @@ runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do
{ testSuiteName = PD.testName suite
, testLogs = l
, logFile =
- testLogDir
+ i testLogDir
</> testSuiteLogPath
(fromFlag $ testHumanLog flags)
pkg_descr
diff --git a/Cabal/src/Distribution/Simple/Test/LibV09.hs b/Cabal/src/Distribution/Simple/Test/LibV09.hs
index f5a6ec2ce1..0fe7a597e4 100644
--- a/Cabal/src/Distribution/Simple/Test/LibV09.hs
+++ b/Cabal/src/Distribution/Simple/Test/LibV09.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -18,28 +19,29 @@ import Prelude ()
import Distribution.Compat.Environment
import Distribution.Compat.Internal.TempFile
+import Distribution.Compat.Process (proc)
import Distribution.ModuleName
import qualified Distribution.PackageDescription as PD
import Distribution.Pretty
import Distribution.Simple.Build.PathsModule
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
-import Distribution.Simple.Flag (Flag (Flag, NoFlag), fromFlag)
+import Distribution.Simple.Errors
import Distribution.Simple.Hpc
import Distribution.Simple.InstallDirs
import qualified Distribution.Simple.LocalBuildInfo as LBI
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Test
import Distribution.Simple.Test.Log
import Distribution.Simple.Utils
import Distribution.System
import Distribution.TestSuite
import qualified Distribution.Types.LocalBuildInfo as LBI
+import Distribution.Utils.Path
import Distribution.Verbosity
import qualified Control.Exception as CE
import qualified Data.ByteString.Lazy as LBS
-import Distribution.Compat.Process (proc)
-import Distribution.Simple.Errors
import System.Directory
( canonicalizePath
, createDirectoryIfMissing
@@ -50,7 +52,6 @@ import System.Directory
, removeFile
, setCurrentDirectory
)
-import System.FilePath ((<.>), (</>))
import System.IO (hClose, hPutStr)
import qualified System.Process as Process
@@ -66,13 +67,14 @@ runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do
let isCoverageEnabled = LBI.testCoverage lbi
way = guessWay lbi
- pwd <- getCurrentDirectory
+ let mbWorkDir = LBI.mbWorkDirLBI lbi
existingEnv <- getEnvironment
let cmd =
- LBI.buildDir lbi
+ interpretSymbolicPath mbWorkDir (LBI.buildDir lbi)
</> stubName suite
</> stubName suite <.> exeExtension (LBI.hostPlatform lbi)
+ tDir = i $ tixDir distPref way
-- Check that the test executable exists.
exists <- doesFileExist cmd
unless exists $
@@ -81,12 +83,11 @@ runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do
-- Remove old .tix files if appropriate.
unless (fromFlag $ testKeepTix flags) $ do
- let tDir = tixDir distPref way
exists' <- doesDirectoryExist tDir
when exists' $ removeDirectoryRecursive tDir
-- Create directory for HPC files.
- createDirectoryIfMissing True $ tixDir distPref way
+ createDirectoryIfMissing True tDir
-- Write summary notices indicating start of test suite
notice verbosity $ summarizeSuiteStart testName'
@@ -94,8 +95,13 @@ runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do
suiteLog <- CE.bracket openCabalTemp deleteIfExists $ \tempLog -> do
-- Run test executable
let opts = map (testOption pkg_descr lbi suite) $ testOptions flags
- dataDirPath = pwd </> PD.dataDir pkg_descr
- tixFile = pwd </> tixFilePath distPref way testName'
+ rawDataDirPath = PD.dataDir pkg_descr
+ dataDirPath
+ | null $ getSymbolicPath rawDataDirPath =
+ i sameDirectory
+ | otherwise =
+ i rawDataDirPath
+ tixFile = i $ tixFilePath distPref way testName'
pkgPathEnv =
(pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: existingEnv
@@ -108,7 +114,7 @@ runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do
then do
let (Platform _ os) = LBI.hostPlatform lbi
paths <- LBI.depLibraryPaths True False lbi clbi
- cpath <- canonicalizePath $ LBI.componentBuildDir lbi clbi
+ cpath <- canonicalizePath $ i $ LBI.componentBuildDir lbi clbi
return (addLibraryPath os (cpath : paths) shellEnv)
else return shellEnv
let (cmd', opts') = case testWrapper flags of
@@ -143,7 +149,7 @@ runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do
-- Generate final log file name
let finalLogName l =
- testLogDir
+ interpretSymbolicPath mbWorkDir testLogDir
</> testSuiteLogPath
(fromFlag $ testHumanLog flags)
pkg_descr
@@ -199,19 +205,21 @@ runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do
return suiteLog
where
+ i = LBI.interpretSymbolicPathLBI lbi
+ common = testCommonFlags flags
testName' = unUnqualComponentName $ PD.testName suite
deleteIfExists file = do
exists <- doesFileExist file
when exists $ removeFile file
- testLogDir = distPref </> "test"
+ testLogDir = distPref </> makeRelativePathEx "test"
openCabalTemp = do
- (f, h) <- openTempFile testLogDir $ "cabal-test-" <.> "log"
+ (f, h) <- openTempFile (i testLogDir) $ "cabal-test-" <.> "log"
hClose h >> return f
- distPref = fromFlag $ testDistPref flags
- verbosity = fromFlag $ testVerbosity flags
+ distPref = fromFlag $ setupDistPref common
+ verbosity = fromFlag $ setupVerbosity common
-- TODO: This is abusing the notion of a 'PathTemplate'. The result isn't
-- necessarily a path.
@@ -234,10 +242,6 @@ testOption pkg_descr lbi suite template =
-- Test stub ----------
--- | The name of the stub executable associated with a library 'TestSuite'.
-stubName :: PD.TestSuite -> FilePath
-stubName t = unUnqualComponentName (PD.testName t) ++ "Stub"
-
-- | The filename of the source file for the stub executable associated with a
-- library 'TestSuite'.
stubFilePath :: PD.TestSuite -> FilePath
diff --git a/Cabal/src/Distribution/Simple/UHC.hs b/Cabal/src/Distribution/Simple/UHC.hs
index ce6bb95d0e..af085ef3a7 100644
--- a/Cabal/src/Distribution/Simple/UHC.hs
+++ b/Cabal/src/Distribution/Simple/UHC.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -50,7 +51,7 @@ import Language.Haskell.Extension
import qualified Data.Map as Map (empty)
import System.Directory
-import System.FilePath
+import System.FilePath (pathSeparator)
-- -----------------------------------------------------------------------------
-- Configuring
@@ -242,8 +243,11 @@ buildExe
buildExe verbosity _pkg_descr lbi exe clbi = do
systemPkgDir <- getGlobalPackageDir verbosity (withPrograms lbi)
userPkgDir <- getUserPackageDir
+ let mbWorkDir = mbWorkDirLBI lbi
+ srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs $ buildInfo exe) (modulePath exe)
let runUhcProg = runDbProgram verbosity uhcProgram (withPrograms lbi)
- let uhcArgs =
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
+ uhcArgs =
-- common flags lib/exe
constructUHCCmdLine
userPkgDir
@@ -254,9 +258,9 @@ buildExe verbosity _pkg_descr lbi exe clbi = do
(buildDir lbi)
verbosity
-- output file
- ++ ["--output", buildDir lbi </> prettyShow (exeName exe)]
+ ++ ["--output", i $ buildDir lbi </> makeRelativePathEx (prettyShow (exeName exe))]
-- main source module
- ++ [modulePath exe]
+ ++ [i $ srcMainPath]
runUhcProg uhcArgs
constructUHCCmdLine
@@ -265,7 +269,7 @@ constructUHCCmdLine
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
- -> FilePath
+ -> SymbolicPath Pkg (Dir Build)
-> Verbosity
-> [String]
constructUHCCmdLine user system lbi bi clbi odir verbosity =
@@ -287,20 +291,22 @@ constructUHCCmdLine user system lbi bi clbi odir verbosity =
++ ["--package=uhcbase"]
++ ["--package=" ++ prettyShow (mungedName pkgid) | (_, pkgid) <- componentPackageDeps clbi]
-- search paths
- ++ ["-i" ++ odir]
- ++ ["-i" ++ getSymbolicPath l | l <- nub (hsSourceDirs bi)]
- ++ ["-i" ++ autogenComponentModulesDir lbi clbi]
- ++ ["-i" ++ autogenPackageModulesDir lbi]
+ ++ ["-i" ++ i odir]
+ ++ ["-i" ++ i l | l <- nub (hsSourceDirs bi)]
+ ++ ["-i" ++ i (autogenComponentModulesDir lbi clbi)]
+ ++ ["-i" ++ i (autogenPackageModulesDir lbi)]
-- cpp options
++ ["--optP=" ++ opt | opt <- cppOptions bi]
-- output path
- ++ ["--odir=" ++ odir]
+ ++ ["--odir=" ++ i odir]
-- optimization
++ ( case withOptimization lbi of
NoOptimisation -> ["-O0"]
NormalOptimisation -> ["-O1"]
MaximumOptimisation -> ["-O2"]
)
+ where
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
uhcPackageDbOptions :: FilePath -> FilePath -> PackageDBStack -> [String]
uhcPackageDbOptions user system db =
@@ -361,5 +367,5 @@ registerPackage verbosity comp progdb packageDbs installedPkgInfo = do
pkgid = sourcePackageId installedPkgInfo
compilerid = compilerId comp
-inplacePackageDbPath :: LocalBuildInfo -> FilePath
-inplacePackageDbPath lbi = buildDir lbi
+inplacePackageDbPath :: LocalBuildInfo -> SymbolicPath Pkg (Dir PkgDB)
+inplacePackageDbPath lbi = coerceSymbolicPath $ buildDir lbi
diff --git a/Cabal/src/Distribution/Simple/Utils.hs b/Cabal/src/Distribution/Simple/Utils.hs
index 1da133ca4c..8c30cc18ab 100644
--- a/Cabal/src/Distribution/Simple/Utils.hs
+++ b/Cabal/src/Distribution/Simple/Utils.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -61,6 +62,7 @@ module Distribution.Simple.Utils
, rawSystemProc
, rawSystemProcAction
, rawSystemExitWithEnv
+ , rawSystemExitWithEnvCwd
, rawSystemStdout
, rawSystemStdInOut
, rawSystemIOWithEnv
@@ -86,6 +88,7 @@ module Distribution.Simple.Utils
, copyFileVerbose
, copyFiles
, copyFileTo
+ , copyFileToCwd
-- * installing files
, installOrdinaryFile
@@ -103,7 +106,6 @@ module Distribution.Simple.Utils
, setFileExecutable
-- * file names
- , currentDir
, shortRelativePath
, dropExeExtension
, exeExtensions
@@ -115,10 +117,13 @@ module Distribution.Simple.Utils
, findFileWithExtension
, findFileCwdWithExtension
, findFileWithExtension'
+ , findFileCwdWithExtension'
, findAllFilesWithExtension
, findAllFilesCwdWithExtension
, findModuleFileEx
+ , findModuleFileCwd
, findModuleFilesEx
+ , findModuleFilesCwd
, getDirectoryContentsRecursive
-- * environment variables
@@ -133,17 +138,18 @@ module Distribution.Simple.Utils
, TempFileOptions (..)
, defaultTempFileOptions
, withTempFile
+ , withTempFileCwd
, withTempFileEx
, withTempDirectory
+ , withTempDirectoryCwd
, withTempDirectoryEx
+ , withTempDirectoryCwdEx
, createTempDirectory
-- * .cabal and .buildinfo files
- , defaultPackageDesc
+ , defaultPackageDescCwd
, findPackageDesc
- , findPackageDescCwd
, tryFindPackageDesc
- , tryFindPackageDescCwd
, findHookedPackageDesc
-- * reading and writing files safely
@@ -207,6 +213,7 @@ import Distribution.Types.PackageId
import Distribution.Utils.Generic
import Distribution.Utils.IOData (IOData (..), IODataMode (..), KnownIODataMode (..))
import qualified Distribution.Utils.IOData as IOData
+import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
import Prelude ()
@@ -248,6 +255,7 @@ import System.Directory
import System.Environment
( getProgName
)
+import System.FilePath (takeFileName)
import System.FilePath as FilePath
( getSearchPath
, joinPath
@@ -256,8 +264,6 @@ import System.FilePath as FilePath
, splitDirectories
, splitExtension
, takeDirectory
- , (<.>)
- , (</>)
)
import System.IO
( BufferMode (..)
@@ -853,19 +859,21 @@ logCommand verbosity cp = do
-- | Execute the given command with the given arguments, exiting
-- with the same exit code if the command fails.
-rawSystemExit :: Verbosity -> FilePath -> [String] -> IO ()
-rawSystemExit verbosity path args =
+rawSystemExit :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> FilePath -> [String] -> IO ()
+rawSystemExit verbosity mbWorkDir path args =
withFrozenCallStack $
maybeExit $
- rawSystemExitCode verbosity path args
+ rawSystemExitCode verbosity mbWorkDir path args
-- | Execute the given command with the given arguments, returning
-- the command's exit code.
-rawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode
-rawSystemExitCode verbosity path args =
+rawSystemExitCode :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> FilePath -> [String] -> IO ExitCode
+rawSystemExitCode verbosity mbWorkDir path args =
withFrozenCallStack $
rawSystemProc verbosity $
- proc path args
+ (proc path args)
+ { Process.cwd = fmap getSymbolicPath mbWorkDir
+ }
-- | Execute the given command with the given arguments, returning
-- the command's exit code.
@@ -918,12 +926,24 @@ rawSystemExitWithEnv
-> [String]
-> [(String, String)]
-> IO ()
-rawSystemExitWithEnv verbosity path args env =
+rawSystemExitWithEnv verbosity =
+ rawSystemExitWithEnvCwd verbosity Nothing
+
+-- | Like 'rawSystemExitWithEnv', but setting a working directory.
+rawSystemExitWithEnvCwd
+ :: Verbosity
+ -> Maybe (SymbolicPath CWD to)
+ -> FilePath
+ -> [String]
+ -> [(String, String)]
+ -> IO ()
+rawSystemExitWithEnvCwd verbosity mbWorkDir path args env =
withFrozenCallStack $
maybeExit $
rawSystemProc verbosity $
(proc path args)
{ Process.env = Just env
+ , Process.cwd = getSymbolicPath <$> mbWorkDir
}
-- | Execute the given command with the given arguments, returning
@@ -1187,83 +1207,75 @@ xargs maxSize rawSystemFun fixedArgs bigArgs =
--
-- @since 3.4.0.0
findFileCwd
- :: Verbosity
- -> FilePath
- -- ^ cwd
- -> [FilePath]
- -- ^ relative search location
- -> FilePath
+ :: forall searchDir allowAbsolute
+ . Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ working directory
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
+ -- ^ search directories
+ -> RelativePath searchDir File
-- ^ File Name
- -> IO FilePath
-findFileCwd verbosity cwd searchPath fileName =
+ -> IO (SymbolicPathX allowAbsolute Pkg File)
+findFileCwd verbosity mbWorkDir searchPath fileName =
findFirstFile
- (cwd </>)
+ (interpretSymbolicPath mbWorkDir)
[ path </> fileName
| path <- ordNub searchPath
]
- >>= maybe (dieWithException verbosity $ FindFileCwd fileName) return
+ >>= maybe (dieWithException verbosity $ FindFile $ getSymbolicPath fileName) return
-- | Find a file by looking in a search path. The file path must match exactly.
findFileEx
- :: Verbosity
- -> [FilePath]
- -- ^ search locations
- -> FilePath
+ :: forall searchDir allowAbsolute
+ . Verbosity
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
+ -- ^ search directories
+ -> RelativePath searchDir File
-- ^ File Name
- -> IO FilePath
-findFileEx verbosity searchPath fileName =
- findFirstFile
- id
- [ path </> fileName
- | path <- ordNub searchPath
- ]
- >>= maybe (dieWithException verbosity $ FindFileEx fileName) return
+ -> IO (SymbolicPathX allowAbsolute Pkg File)
+findFileEx v = findFileCwd v Nothing
-- | Find a file by looking in a search path with one of a list of possible
-- file extensions. The file base name should be given and it will be tried
-- with each of the extensions in each element of the search path.
findFileWithExtension
:: [Suffix]
- -> [FilePath]
- -> FilePath
- -> IO (Maybe FilePath)
-findFileWithExtension extensions searchPath baseName =
- findFirstFile
- id
- [ path </> baseName <.> ext
- | path <- ordNub searchPath
- , Suffix ext <- ordNub extensions
- ]
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
+ -> RelativePath searchDir File
+ -> IO (Maybe (SymbolicPathX allowAbsolute Pkg File))
+findFileWithExtension =
+ findFileCwdWithExtension Nothing
--- | @since 3.4.0.0
+-- | Find a file by looking in a search path with one of a list of possible
+-- file extensions.
+--
+-- @since 3.4.0.0
findFileCwdWithExtension
- :: FilePath
+ :: forall searchDir allowAbsolute
+ . Maybe (SymbolicPath CWD (Dir Pkg))
-> [Suffix]
- -> [FilePath]
- -> FilePath
- -> IO (Maybe FilePath)
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
+ -> RelativePath searchDir File
+ -> IO (Maybe (SymbolicPathX allowAbsolute Pkg File))
findFileCwdWithExtension cwd extensions searchPath baseName =
- findFirstFile
- (cwd </>)
- [ path </> baseName <.> ext
- | path <- ordNub searchPath
- , Suffix ext <- ordNub extensions
- ]
+ fmap (uncurry (</>))
+ <$> findFileCwdWithExtension' cwd extensions searchPath baseName
-- | @since 3.4.0.0
findAllFilesCwdWithExtension
- :: FilePath
- -- ^ cwd
+ :: forall searchDir allowAbsolute
+ . Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ working directory
-> [Suffix]
-- ^ extensions
- -> [FilePath]
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
-- ^ relative search locations
- -> FilePath
+ -> RelativePath searchDir File
-- ^ basename
- -> IO [FilePath]
-findAllFilesCwdWithExtension cwd extensions searchPath basename =
+ -> IO [SymbolicPathX allowAbsolute Pkg File]
+findAllFilesCwdWithExtension mbWorkDir extensions searchPath basename =
findAllFiles
- (cwd </>)
+ (interpretSymbolicPath mbWorkDir)
[ path </> basename <.> ext
| path <- ordNub searchPath
, Suffix ext <- ordNub extensions
@@ -1271,31 +1283,42 @@ findAllFilesCwdWithExtension cwd extensions searchPath basename =
findAllFilesWithExtension
:: [Suffix]
- -> [FilePath]
- -> FilePath
- -> IO [FilePath]
-findAllFilesWithExtension extensions searchPath basename =
- findAllFiles
- id
- [ path </> basename <.> ext
- | path <- ordNub searchPath
- , Suffix ext <- ordNub extensions
- ]
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
+ -> RelativePath searchDir File
+ -> IO [SymbolicPathX allowAbsolute Pkg File]
+findAllFilesWithExtension =
+ findAllFilesCwdWithExtension Nothing
-- | Like 'findFileWithExtension' but returns which element of the search path
-- the file was found in, and the file path relative to that base directory.
findFileWithExtension'
:: [Suffix]
- -> [FilePath]
- -> FilePath
- -> IO (Maybe (FilePath, FilePath))
-findFileWithExtension' extensions searchPath baseName =
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
+ -> RelativePath searchDir File
+ -> IO (Maybe (SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File))
+findFileWithExtension' =
+ findFileCwdWithExtension' Nothing
+
+-- | Like 'findFileCwdWithExtension' but returns which element of the search path
+-- the file was found in, and the file path relative to that base directory.
+findFileCwdWithExtension'
+ :: forall searchDir allowAbsolute
+ . Maybe (SymbolicPath CWD (Dir Pkg))
+ -> [Suffix]
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
+ -> RelativePath searchDir File
+ -> IO (Maybe (SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File))
+findFileCwdWithExtension' cwd extensions searchPath baseName =
findFirstFile
- (uncurry (</>))
+ (uncurry mkPath)
[ (path, baseName <.> ext)
| path <- ordNub searchPath
, Suffix ext <- ordNub extensions
]
+ where
+ mkPath :: SymbolicPathX allowAbsolute Pkg (Dir searchDir) -> RelativePath searchDir File -> FilePath
+ mkPath base file =
+ interpretSymbolicPath cwd (base </> file)
findFirstFile :: (a -> FilePath) -> [a] -> IO (Maybe a)
findFirstFile file = findFirst
@@ -1314,39 +1337,79 @@ findAllFiles file = filterM (doesFileExist . file)
--
-- As 'findModuleFile' but for a list of module names.
findModuleFilesEx
- :: Verbosity
- -> [FilePath]
+ :: forall searchDir allowAbsolute
+ . Verbosity
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
-- ^ build prefix (location of objects)
-> [Suffix]
-- ^ search suffixes
-> [ModuleName]
-- ^ modules
- -> IO [(FilePath, FilePath)]
+ -> IO [(SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File)]
findModuleFilesEx verbosity searchPath extensions moduleNames =
traverse (findModuleFileEx verbosity searchPath extensions) moduleNames
+-- | Finds the files corresponding to a list of Haskell module names.
+--
+-- As 'findModuleFileCwd' but for a list of module names.
+findModuleFilesCwd
+ :: forall searchDir allowAbsolute
+ . Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
+ -- ^ build prefix (location of objects)
+ -> [Suffix]
+ -- ^ search suffixes
+ -> [ModuleName]
+ -- ^ modules
+ -> IO [(SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File)]
+findModuleFilesCwd verbosity cwd searchPath extensions moduleNames =
+ traverse (findModuleFileCwd verbosity cwd searchPath extensions) moduleNames
+
-- | Find the file corresponding to a Haskell module name.
--
-- This is similar to 'findFileWithExtension'' but specialised to a module
-- name. The function fails if the file corresponding to the module is missing.
findModuleFileEx
- :: Verbosity
- -> [FilePath]
+ :: forall searchDir allowAbsolute
+ . Verbosity
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
+ -- ^ build prefix (location of objects)
+ -> [Suffix]
+ -- ^ search suffixes
+ -> ModuleName
+ -- ^ module
+ -> IO (SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File)
+findModuleFileEx verbosity =
+ findModuleFileCwd verbosity Nothing
+
+-- | Find the file corresponding to a Haskell module name.
+--
+-- This is similar to 'findFileCwdWithExtension'' but specialised to a module
+-- name. The function fails if the file corresponding to the module is missing.
+findModuleFileCwd
+ :: forall searchDir allowAbsolute
+ . Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)]
-- ^ build prefix (location of objects)
-> [Suffix]
-- ^ search suffixes
-> ModuleName
-- ^ module
- -> IO (FilePath, FilePath)
-findModuleFileEx verbosity searchPath extensions mod_name =
- maybe notFound return
- =<< findFileWithExtension'
+ -> IO (SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File)
+findModuleFileCwd verbosity cwd searchPath extensions mod_name = do
+ mbRes <-
+ findFileCwdWithExtension'
+ cwd
extensions
searchPath
- (ModuleName.toFilePath mod_name)
- where
- notFound =
- dieWithException verbosity $ FindModuleFileEx mod_name extensions searchPath
+ (makeRelativePathEx $ ModuleName.toFilePath mod_name)
+ case mbRes of
+ Nothing ->
+ dieWithException verbosity $
+ FindModuleFileEx mod_name extensions (map getSymbolicPath searchPath)
+ Just res -> return res
-- | List all the files in a directory and all subdirectories.
--
@@ -1520,11 +1583,34 @@ installMaybeExecutableFile verbosity src dest = withFrozenCallStack $ do
-- | Given a relative path to a file, copy it to the given directory, preserving
-- the relative path and creating the parent directories if needed.
-copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()
-copyFileTo verbosity dir file = withFrozenCallStack $ do
- let targetFile = dir </> file
+copyFileTo
+ :: Verbosity
+ -> FilePath
+ -> FilePath
+ -> IO ()
+copyFileTo verbosity dir file =
+ withFrozenCallStack $
+ copyFileToCwd
+ verbosity
+ Nothing
+ (makeSymbolicPath dir)
+ (makeRelativePathEx file)
+
+-- | Given a relative path to a file, copy it to the given directory, preserving
+-- the relative path and creating the parent directories if needed.
+copyFileToCwd
+ :: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg (Dir target)
+ -> RelativePath Pkg File
+ -> IO ()
+copyFileToCwd verbosity mbWorkDir dir file = withFrozenCallStack $ do
+ let targetFile = i $ dir </> unsafeCoerceSymbolicPath file
createDirectoryIfMissingVerbose verbosity True (takeDirectory targetFile)
- installOrdinaryFile verbosity file targetFile
+ installOrdinaryFile verbosity (i file) targetFile
+ where
+ i :: SymbolicPathX allowAbs Pkg to -> FilePath
+ i = interpretSymbolicPath mbWorkDir
-- | Common implementation of 'copyFiles', 'installOrdinaryFiles',
-- 'installExecutableFiles' and 'installMaybeExecutableFiles'.
@@ -1637,7 +1723,7 @@ data TempFileOptions = TempFileOptions
defaultTempFileOptions :: TempFileOptions
defaultTempFileOptions = TempFileOptions{optKeepTempFiles = False}
--- | Use a temporary filename that doesn't already exist.
+-- | Use a temporary filename that doesn't already exist
withTempFile
:: FilePath
-- ^ Temp dir to create the file in
@@ -1645,29 +1731,58 @@ withTempFile
-- ^ File name template. See 'openTempFile'.
-> (FilePath -> Handle -> IO a)
-> IO a
-withTempFile tmpDir template action =
- withTempFileEx defaultTempFileOptions tmpDir template action
+withTempFile tmpDir template f = withFrozenCallStack $
+ withTempFileCwd Nothing (makeSymbolicPath tmpDir) template $
+ \fp h -> f (getSymbolicPath fp) h
+
+-- | Use a temporary filename that doesn't already exist.
+withTempFileCwd
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory
+ -> SymbolicPath Pkg (Dir tmpDir)
+ -- ^ Temp dir to create the file in
+ -> String
+ -- ^ File name template. See 'openTempFile'.
+ -> (SymbolicPath Pkg File -> Handle -> IO a)
+ -> IO a
+withTempFileCwd = withFrozenCallStack $ withTempFileEx defaultTempFileOptions
-- | A version of 'withTempFile' that additionally takes a 'TempFileOptions'
-- argument.
withTempFileEx
- :: TempFileOptions
- -> FilePath
+ :: forall a tmpDir
+ . TempFileOptions
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory
+ -> SymbolicPath Pkg (Dir tmpDir)
-- ^ Temp dir to create the file in
-> String
-- ^ File name template. See 'openTempFile'.
- -> (FilePath -> Handle -> IO a)
+ -> (SymbolicPath Pkg File -> Handle -> IO a)
-> IO a
-withTempFileEx opts tmpDir template action =
- Exception.bracket
- (openTempFile tmpDir template)
- ( \(name, handle) -> do
- hClose handle
- unless (optKeepTempFiles opts) $
- handleDoesNotExist () . removeFile $
- name
- )
- (withLexicalCallStack (\x -> uncurry action x))
+withTempFileEx opts mbWorkDir tmpDir template action =
+ withFrozenCallStack $
+ Exception.bracket
+ (openTempFile (i tmpDir) template)
+ ( \(name, handle) -> do
+ hClose handle
+ unless (optKeepTempFiles opts) $
+ handleDoesNotExist () $
+ removeFile $
+ name
+ )
+ (withLexicalCallStack (\(fn, h) -> action (mkRelToPkg fn) h))
+ where
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
+ mkRelToPkg :: FilePath -> SymbolicPath Pkg File
+ mkRelToPkg fp =
+ tmpDir </> makeRelativePathEx (takeFileName fp)
+
+-- 'openTempFile' returns a path of the form @i tmpDir </> fn@, but we
+-- want 'withTempFileEx' to return @tmpDir </> fn@. So we split off
+-- the filename and add back the (un-interpreted) directory.
+-- This assumes 'openTempFile' returns a filepath of the form
+-- @inputDir </> fn@, where @fn@ does not contain any path separators.
-- | Create and use a temporary directory.
--
@@ -1678,12 +1793,44 @@ withTempFileEx opts tmpDir template action =
--
-- The @tmpDir@ will be a new subdirectory of the given directory, e.g.
-- @src/sdist.342@.
-withTempDirectory :: Verbosity -> FilePath -> String -> (FilePath -> IO a) -> IO a
-withTempDirectory verbosity targetDir template f =
+withTempDirectory
+ :: Verbosity
+ -> FilePath
+ -> String
+ -> (FilePath -> IO a)
+ -> IO a
+withTempDirectory verb targetDir template f =
withFrozenCallStack $
- withTempDirectoryEx
+ withTempDirectoryCwd
+ verb
+ Nothing
+ (makeSymbolicPath targetDir)
+ template
+ (f . getSymbolicPath)
+
+-- | Create and use a temporary directory.
+--
+-- Creates a new temporary directory inside the given directory, making use
+-- of the template. The temp directory is deleted after use. For example:
+--
+-- > withTempDirectory verbosity "src" "sdist." $ \tmpDir -> do ...
+--
+-- The @tmpDir@ will be a new subdirectory of the given directory, e.g.
+-- @src/sdist.342@.
+withTempDirectoryCwd
+ :: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory
+ -> SymbolicPath Pkg (Dir tmpDir1)
+ -> String
+ -> (SymbolicPath Pkg (Dir tmpDir2) -> IO a)
+ -> IO a
+withTempDirectoryCwd verbosity mbWorkDir targetDir template f =
+ withFrozenCallStack $
+ withTempDirectoryCwdEx
verbosity
defaultTempFileOptions
+ mbWorkDir
targetDir
template
(withLexicalCallStack (\x -> f x))
@@ -1697,15 +1844,35 @@ withTempDirectoryEx
-> String
-> (FilePath -> IO a)
-> IO a
-withTempDirectoryEx _verbosity opts targetDir template f =
+withTempDirectoryEx verbosity opts targetDir template f =
+ withFrozenCallStack $
+ withTempDirectoryCwdEx verbosity opts Nothing (makeSymbolicPath targetDir) template $
+ \fp -> f (getSymbolicPath fp)
+
+-- | A version of 'withTempDirectoryCwd' that additionally takes a
+-- 'TempFileOptions' argument.
+withTempDirectoryCwdEx
+ :: forall a tmpDir1 tmpDir2
+ . Verbosity
+ -> TempFileOptions
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory
+ -> SymbolicPath Pkg (Dir tmpDir1)
+ -> String
+ -> (SymbolicPath Pkg (Dir tmpDir2) -> IO a)
+ -> IO a
+withTempDirectoryCwdEx _verbosity opts mbWorkDir targetDir template f =
withFrozenCallStack $
Exception.bracket
- (createTempDirectory targetDir template)
- ( unless (optKeepTempFiles opts)
- . handleDoesNotExist ()
- . removeDirectoryRecursive
+ (createTempDirectory (i targetDir) template)
+ ( \tmpDirRelPath ->
+ unless (optKeepTempFiles opts) $
+ handleDoesNotExist () $
+ removeDirectoryRecursive (i targetDir </> tmpDirRelPath)
)
- (withLexicalCallStack (\x -> f x))
+ (withLexicalCallStack (\tmpDirRelPath -> f $ targetDir </> makeRelativePathEx tmpDirRelPath))
+ where
+ i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
-----------------------------------
-- Safely reading and writing files
@@ -1737,12 +1904,6 @@ rewriteFileLBS verbosity path newContent =
| otherwise =
ioError e
--- | The path name that represents the current directory.
--- In Unix, it's @\".\"@, but this is system-specific.
--- (E.g. AmigaOS uses the empty string @\"\"@ for the current directory.)
-currentDir :: FilePath
-currentDir = "."
-
shortRelativePath :: FilePath -> FilePath -> FilePath
shortRelativePath from to =
case dropCommonPrefix (splitDirectories from) (splitDirectories to) of
@@ -1792,71 +1953,61 @@ exeExtensions = case (buildArch, buildOS) of
-- ------------------------------------------------------------
--- | Package description file (/pkgname/@.cabal@)
-defaultPackageDesc :: Verbosity -> IO FilePath
-defaultPackageDesc verbosity = tryFindPackageDesc verbosity currentDir
+-- | Package description file (/pkgname/@.cabal@) in the current
+-- working directory.
+defaultPackageDescCwd :: Verbosity -> IO (RelativePath Pkg File)
+defaultPackageDescCwd verbosity = tryFindPackageDesc verbosity Nothing
-- | Find a package description file in the given directory. Looks for
-- @.cabal@ files.
findPackageDesc
- :: FilePath
- -- ^ Where to look
- -> IO (Either CabalException FilePath)
- -- ^ <pkgname>.cabal
-findPackageDesc = findPackageDescCwd "."
-
--- | @since 3.4.0.0
-findPackageDescCwd
- :: FilePath
- -- ^ project root
- -> FilePath
- -- ^ relative directory
- -> IO (Either CabalException FilePath)
- -- ^ <pkgname>.cabal relative to the project root
-findPackageDescCwd cwd dir =
+ :: Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ package directory
+ -> IO (Either CabalException (RelativePath Pkg File))
+findPackageDesc mbPkgDir =
do
- files <- getDirectoryContents (cwd </> dir)
+ let pkgDir = maybe "." getSymbolicPath mbPkgDir
+ files <- getDirectoryContents pkgDir
-- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.cabal
-- file we filter to exclude dirs and null base file names:
cabalFiles <-
filterM
- (doesFileExist . snd)
- [ (dir </> file, cwd </> dir </> file)
+ (doesFileExist . uncurry (</>))
+ [ (pkgDir, file)
| file <- files
, let (name, ext) = splitExtension file
, not (null name) && ext == ".cabal"
]
- case map fst cabalFiles of
+ case map snd cabalFiles of
[] -> return (Left NoDesc)
- [cabalFile] -> return (Right cabalFile)
+ [cabalFile] -> return (Right $ makeRelativePathEx cabalFile)
multiple -> return (Left $ MultiDesc multiple)
-- | Like 'findPackageDesc', but calls 'die' in case of error.
-tryFindPackageDesc :: Verbosity -> FilePath -> IO FilePath
+tryFindPackageDesc
+ :: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ directory in which to look
+ -> IO (RelativePath Pkg File)
tryFindPackageDesc verbosity dir =
either (dieWithException verbosity) return =<< findPackageDesc dir
--- | Like 'findPackageDescCwd', but calls 'die' in case of error.
---
--- @since 3.4.0.0
-tryFindPackageDescCwd :: Verbosity -> FilePath -> FilePath -> IO FilePath
-tryFindPackageDescCwd verbosity cwd dir =
- either (dieWithException verbosity) return =<< findPackageDescCwd cwd dir
-
-- | Find auxiliary package information in the given directory.
-- Looks for @.buildinfo@ files.
findHookedPackageDesc
:: Verbosity
- -> FilePath
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ Working directory
+ -> SymbolicPath Pkg (Dir Build)
-- ^ Directory to search
- -> IO (Maybe FilePath)
+ -> IO (Maybe (SymbolicPath Pkg File))
-- ^ /dir/@\/@/pkgname/@.buildinfo@, if present
-findHookedPackageDesc verbosity dir = do
- files <- getDirectoryContents dir
+findHookedPackageDesc verbosity mbWorkDir dir = do
+ files <- getDirectoryContents $ interpretSymbolicPath mbWorkDir dir
buildInfoFiles <-
filterM
- doesFileExist
- [ dir </> file
+ (doesFileExist . interpretSymbolicPath mbWorkDir)
+ [ dir </> makeRelativePathEx file
| file <- files
, let (name, ext) = splitExtension file
, not (null name) && ext == buildInfoExt
diff --git a/Cabal/src/Distribution/Types/LocalBuildConfig.hs b/Cabal/src/Distribution/Types/LocalBuildConfig.hs
index 4423a77410..9126d92f1e 100644
--- a/Cabal/src/Distribution/Types/LocalBuildConfig.hs
+++ b/Cabal/src/Distribution/Types/LocalBuildConfig.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -36,9 +37,10 @@ import Distribution.Simple.InstallDirs hiding
, substPathTemplate
)
import Distribution.Simple.PackageIndex
-import Distribution.Simple.Program
+import Distribution.Simple.Program.Db (ProgramDb)
import Distribution.Simple.Setup.Config
import Distribution.System
+import Distribution.Utils.Path
import Distribution.Compat.Graph (Graph)
@@ -57,7 +59,7 @@ data PackageBuildDescr = PackageBuildDescr
-- ^ The compiler we're building with
, hostPlatform :: Platform
-- ^ The platform we're building for
- , pkgDescrFile :: Maybe FilePath
+ , pkgDescrFile :: Maybe (SymbolicPath Pkg File)
-- ^ the filename containing the .cabal file, if available
, localPkgDescr :: PackageDescription
-- ^ WARNING WARNING WARNING Be VERY careful about using
diff --git a/Cabal/src/Distribution/Types/LocalBuildInfo.hs b/Cabal/src/Distribution/Types/LocalBuildInfo.hs
index 1c3aeef016..a5706fff09 100644
--- a/Cabal/src/Distribution/Types/LocalBuildInfo.hs
+++ b/Cabal/src/Distribution/Types/LocalBuildInfo.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
@@ -55,8 +56,8 @@ module Distribution.Types.LocalBuildInfo
, localPackage
, buildDir
, buildDirPBD
- , configFlagsBuildDir
- , cabalFilePath
+ , setupFlagsBuildDir
+ , packageRoot
, progPrefix
, progSuffix
@@ -105,6 +106,8 @@ import Distribution.Types.PackageId
import Distribution.Types.TargetInfo
import Distribution.Types.UnitId
+import Distribution.Utils.Path
+
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Simple.Compiler
@@ -116,13 +119,15 @@ import Distribution.Simple.InstallDirs hiding
)
import Distribution.Simple.PackageIndex
import Distribution.Simple.Program
+import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Config
import Distribution.System
import qualified Data.Map as Map
import Distribution.Compat.Graph (Graph)
import qualified Distribution.Compat.Graph as Graph
-import System.FilePath ((</>))
+
+import qualified System.FilePath as FilePath (takeDirectory)
-- | Data cached after configuration step. See also
-- 'Distribution.Simple.Setup.ConfigFlags'.
@@ -148,7 +153,7 @@ pattern LocalBuildInfo
-> InstallDirTemplates
-> Compiler
-> Platform
- -> Maybe FilePath
+ -> Maybe (SymbolicPath Pkg File)
-> Graph ComponentLocalBuildInfo
-> Map ComponentName [ComponentLocalBuildInfo]
-> Map (PackageName, ComponentName) ComponentId
@@ -273,20 +278,28 @@ instance Structured LocalBuildInfo
-------------------------------------------------------------------------------
-- Accessor functions
-buildDir :: LocalBuildInfo -> FilePath
+buildDir :: LocalBuildInfo -> SymbolicPath Pkg (Dir Build)
buildDir lbi =
buildDirPBD $ LBC.packageBuildDescr $ localBuildDescr lbi
-buildDirPBD :: LBC.PackageBuildDescr -> FilePath
+buildDirPBD :: LBC.PackageBuildDescr -> SymbolicPath Pkg (Dir Build)
buildDirPBD (LBC.PackageBuildDescr{configFlags = cfg}) =
- configFlagsBuildDir cfg
-
-configFlagsBuildDir :: ConfigFlags -> FilePath
-configFlagsBuildDir cfg = fromFlag (configDistPref cfg) </> "build"
-
-cabalFilePath :: LocalBuildInfo -> Maybe FilePath
-cabalFilePath (LocalBuildInfo{configFlags = cfg}) =
- flagToMaybe (configCabalFilePath cfg)
+ setupFlagsBuildDir $ configCommonFlags cfg
+
+setupFlagsBuildDir :: CommonSetupFlags -> SymbolicPath Pkg (Dir Build)
+setupFlagsBuildDir cfg = fromFlag (setupDistPref cfg) </> makeRelativePathEx "build"
+
+-- | The (relative or absolute) path to the package root, based on
+--
+-- - the working directory flag
+-- - the @.cabal@ path
+packageRoot :: CommonSetupFlags -> FilePath
+packageRoot cfg =
+ case flagToMaybe (setupCabalFilePath cfg) of
+ Just cabalPath -> FilePath.takeDirectory $ interpretSymbolicPath mbWorkDir cabalPath
+ Nothing -> maybe "." getSymbolicPath mbWorkDir
+ where
+ mbWorkDir = flagToMaybe $ setupWorkingDir cfg
progPrefix, progSuffix :: LocalBuildInfo -> PathTemplate
progPrefix (LocalBuildInfo{configFlags = cfg}) =
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 95b7ce725f..2e06aa991b 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -40,7 +40,13 @@ Flag lukko
manual: True
common warnings
- ghc-options: -Wall -Wcompat -Wnoncanonical-monad-instances -Wincomplete-uni-patterns -Wincomplete-record-updates
+ ghc-options:
+ -Wall
+ -Wcompat
+ -Wnoncanonical-monad-instances
+ -Wincomplete-uni-patterns
+ -Wincomplete-record-updates
+ -Wno-unticked-promoted-constructors
if impl(ghc < 8.8)
ghc-options: -Wnoncanonical-monadfail-instances
diff --git a/cabal-install/src/Distribution/Client/Check.hs b/cabal-install/src/Distribution/Client/Check.hs
index 07ec20bf93..f8c1d45675 100644
--- a/cabal-install/src/Distribution/Client/Check.hs
+++ b/cabal-install/src/Distribution/Client/Check.hs
@@ -21,6 +21,7 @@ module Distribution.Client.Check
import Distribution.Client.Compat.Prelude
import Prelude ()
+import Distribution.Client.Errors
import Distribution.Client.Utils.Parsec (renderParseError)
import Distribution.PackageDescription (GenericPackageDescription)
import Distribution.PackageDescription.Check
@@ -29,7 +30,9 @@ import Distribution.PackageDescription.Parsec
, runParseResult
)
import Distribution.Parsec (PWarning (..), showPError)
-import Distribution.Simple.Utils (defaultPackageDesc, dieWithException, notice, warn, warnError)
+import Distribution.Simple.Utils (defaultPackageDescCwd, dieWithException, notice, warn, warnError)
+import Distribution.Utils.Path (getSymbolicPath)
+
import System.IO (hPutStr, stderr)
import qualified Control.Monad as CM
@@ -37,7 +40,6 @@ import qualified Data.ByteString as BS
import qualified Data.Function as F
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
-import Distribution.Client.Errors
import qualified System.Directory as Dir
readGenericPackageDescriptionCheck :: Verbosity -> FilePath -> IO ([PWarning], GenericPackageDescription)
@@ -66,7 +68,7 @@ check
-- (e.g. @invalid-path-win@) to ignore.
-> IO Bool
check verbosity ignores = do
- pdfile <- defaultPackageDesc verbosity
+ pdfile <- getSymbolicPath <$> defaultPackageDescCwd verbosity
(ws, ppd) <- readGenericPackageDescriptionCheck verbosity pdfile
-- convert parse warnings into PackageChecks
let ws' = map (wrapParseWarning pdfile) ws
diff --git a/cabal-install/src/Distribution/Client/CmdBench.hs b/cabal-install/src/Distribution/Client/CmdBench.hs
index b39aa9d675..0563414128 100644
--- a/cabal-install/src/Distribution/Client/CmdBench.hs
+++ b/cabal-install/src/Distribution/Client/CmdBench.hs
@@ -50,6 +50,7 @@ import Distribution.Simple.Command
import Distribution.Simple.Flag
( fromFlagOrDefault
)
+import Distribution.Simple.Setup (CommonSetupFlags (..))
import Distribution.Simple.Utils
( dieWithException
, warn
@@ -150,7 +151,7 @@ benchAction flags@NixStyleFlags{..} targetStrings globalFlags = do
buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx
runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
where
- verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
cliConfig =
commandLineFlagsToProjectConfig
globalFlags
diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs
index be4b26b003..44f1c4e0f2 100644
--- a/cabal-install/src/Distribution/Client/CmdBuild.hs
+++ b/cabal-install/src/Distribution/Client/CmdBuild.hs
@@ -40,7 +40,8 @@ import Distribution.Client.ScriptUtils
, withContextAndSelectors
)
import Distribution.Client.Setup
- ( ConfigFlags (..)
+ ( CommonSetupFlags (..)
+ , ConfigFlags (..)
, GlobalFlags
, yesNoOpt
)
@@ -184,7 +185,7 @@ buildAction flags@NixStyleFlags{extraFlags = buildFlags, ..} targetStrings globa
buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx
runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
where
- verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
-- | This defines what a 'TargetSelector' means for the @bench@ command.
-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
diff --git a/cabal-install/src/Distribution/Client/CmdClean.hs b/cabal-install/src/Distribution/Client/CmdClean.hs
index ef481300ef..2ffda4dce6 100644
--- a/cabal-install/src/Distribution/Client/CmdClean.hs
+++ b/cabal-install/src/Distribution/Client/CmdClean.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
module Distribution.Client.CmdClean (cleanCommand, cleanAction) where
@@ -51,6 +52,10 @@ import Distribution.Simple.Utils
, info
, wrapText
)
+import Distribution.Utils.Path hiding
+ ( (<.>)
+ , (</>)
+ )
import Distribution.Verbosity
( normal
)
@@ -77,7 +82,7 @@ import System.FilePath
data CleanFlags = CleanFlags
{ cleanSaveConfig :: Flag Bool
, cleanVerbosity :: Flag Verbosity
- , cleanDistDir :: Flag FilePath
+ , cleanDistDir :: Flag (SymbolicPath Pkg (Dir Dist))
}
deriving (Eq)
@@ -132,7 +137,7 @@ cleanAction :: (ProjectFlags, CleanFlags) -> [String] -> GlobalFlags -> IO ()
cleanAction (ProjectFlags{..}, CleanFlags{..}) extraArgs _ = do
let verbosity = fromFlagOrDefault normal cleanVerbosity
saveConfig = fromFlagOrDefault False cleanSaveConfig
- mdistDirectory = flagToMaybe cleanDistDir
+ mdistDirectory = fmap getSymbolicPath $ flagToMaybe cleanDistDir
mprojectDir = flagToMaybe flagProjectDir
mprojectFile = flagToMaybe flagProjectFile
@@ -165,7 +170,7 @@ cleanAction (ProjectFlags{..}, CleanFlags{..}) extraArgs _ = do
info verbosity ("Deleting dist-newstyle (" ++ distRoot ++ ")")
handleDoesNotExist () $ removeDirectoryRecursive distRoot
- removeEnvFiles (distProjectRootDirectory distLayout)
+ removeEnvFiles $ distProjectRootDirectory distLayout
-- Clean specified script build caches and orphaned caches.
-- There is currently no good way to specify to only clean orphaned caches.
diff --git a/cabal-install/src/Distribution/Client/CmdConfigure.hs b/cabal-install/src/Distribution/Client/CmdConfigure.hs
index ff249ed0ed..c5bd678c2a 100644
--- a/cabal-install/src/Distribution/Client/CmdConfigure.hs
+++ b/cabal-install/src/Distribution/Client/CmdConfigure.hs
@@ -22,6 +22,7 @@ import Distribution.Client.ProjectFlags
)
import Distribution.Client.ProjectOrchestration
import Distribution.Simple.Flag
+import Distribution.Simple.Setup (CommonSetupFlags (..))
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..)
@@ -123,7 +124,7 @@ configureAction flags@NixStyleFlags{..} extraArgs globalFlags = do
then notice v "Config file not written due to flag(s)."
else writeProjectLocalExtraConfig (distDirLayout baseCtx) projConfig
where
- v = fromFlagOrDefault normal (configVerbosity configFlags)
+ v = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
configureAction' :: NixStyleFlags () -> [String] -> GlobalFlags -> IO (ProjectBaseContext, ProjectConfig)
configureAction' flags@NixStyleFlags{..} _extraArgs globalFlags = do
@@ -164,7 +165,7 @@ configureAction' flags@NixStyleFlags{..} _extraArgs globalFlags = do
return (baseCtx, conf <> cliConfig)
else return (baseCtx, cliConfig)
where
- v = fromFlagOrDefault normal (configVerbosity configFlags)
+ v = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
cliConfig =
commandLineFlagsToProjectConfig
globalFlags
diff --git a/cabal-install/src/Distribution/Client/CmdExec.hs b/cabal-install/src/Distribution/Client/CmdExec.hs
index fc81f323fd..43be4ec0f2 100644
--- a/cabal-install/src/Distribution/Client/CmdExec.hs
+++ b/cabal-install/src/Distribution/Client/CmdExec.hs
@@ -55,7 +55,7 @@ import Distribution.Client.ProjectPlanning
)
import qualified Distribution.Client.ProjectPlanning as Planning
import Distribution.Client.Setup
- ( ConfigFlags (configVerbosity)
+ ( ConfigFlags (configCommonFlags)
, GlobalFlags
)
import Distribution.Simple.Command
@@ -84,6 +84,7 @@ import Distribution.Simple.Program.Run
( programInvocation
, runProgramInvocation
)
+import Distribution.Simple.Setup (CommonSetupFlags (..))
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose
, dieWithException
@@ -222,7 +223,7 @@ execAction flags@NixStyleFlags{..} extraArgs globalFlags = do
then notice verbosity "Running of executable suppressed by flag(s)"
else runProgramInvocation verbosity invocation
where
- verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
cliConfig =
commandLineFlagsToProjectConfig
globalFlags
@@ -252,10 +253,11 @@ withTempEnvFile
-> ([(String, Maybe String)] -> IO a)
-> IO a
withTempEnvFile verbosity baseCtx buildCtx buildStatus action = do
- createDirectoryIfMissingVerbose verbosity True (distTempDirectory (distDirLayout baseCtx))
+ let tmpDirTemplate = distTempDirectory (distDirLayout baseCtx)
+ createDirectoryIfMissingVerbose verbosity True tmpDirTemplate
withTempDirectory
verbosity
- (distTempDirectory (distDirLayout baseCtx))
+ tmpDirTemplate
"environment."
( \tmpDir -> do
envOverrides <-
diff --git a/cabal-install/src/Distribution/Client/CmdFreeze.hs b/cabal-install/src/Distribution/Client/CmdFreeze.hs
index 85c7eb137e..29718b5d44 100644
--- a/cabal-install/src/Distribution/Client/CmdFreeze.hs
+++ b/cabal-install/src/Distribution/Client/CmdFreeze.hs
@@ -40,7 +40,8 @@ import Distribution.Solver.Types.PackageConstraint
)
import Distribution.Client.Setup
- ( ConfigFlags (..)
+ ( CommonSetupFlags (setupVerbosity)
+ , ConfigFlags (..)
, GlobalFlags
)
import Distribution.Package
@@ -157,9 +158,9 @@ freezeAction flags@NixStyleFlags{..} extraArgs globalFlags = do
else do
writeProjectLocalFreezeConfig distDirLayout freezeConfig
notice verbosity $
- "Wrote freeze file: " ++ distProjectFile distDirLayout "freeze"
+ "Wrote freeze file: " ++ (distProjectFile distDirLayout "freeze")
where
- verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
cliConfig =
commandLineFlagsToProjectConfig
globalFlags
diff --git a/cabal-install/src/Distribution/Client/CmdHaddock.hs b/cabal-install/src/Distribution/Client/CmdHaddock.hs
index b67bda4bce..8ecc548779 100644
--- a/cabal-install/src/Distribution/Client/CmdHaddock.hs
+++ b/cabal-install/src/Distribution/Client/CmdHaddock.hs
@@ -31,7 +31,8 @@ import Distribution.Client.ProjectPlanning
( ElaboratedSharedConfig (..)
)
import Distribution.Client.Setup
- ( ConfigFlags (..)
+ ( CommonSetupFlags (..)
+ , ConfigFlags (..)
, GlobalFlags
, InstallFlags (..)
)
@@ -147,7 +148,7 @@ haddockAction relFlags targetStrings globalFlags = do
flags@NixStyleFlags{..} <- mkFlagsAbsolute relFlags
let
- verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
installDoc = fromFlagOrDefault True (installDocumentation installFlags)
flags' = flags{installFlags = installFlags{installDocumentation = Flag installDoc}}
cliConfig = commandLineFlagsToProjectConfig globalFlags flags' mempty -- ClientInstallFlags, not needed here
diff --git a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
index bde0948dcf..bf21de2d35 100644
--- a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
+++ b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
@@ -46,7 +46,8 @@ import Distribution.Client.ScriptUtils
, withContextAndSelectors
)
import Distribution.Client.Setup
- ( ConfigFlags (..)
+ ( CommonSetupFlags (setupVerbosity)
+ , ConfigFlags (..)
, GlobalFlags (..)
)
import Distribution.Client.TargetProblem (TargetProblem (..))
@@ -75,6 +76,7 @@ import Distribution.Simple.Setup
( HaddockFlags (..)
, HaddockProjectFlags (..)
, Visibility (..)
+ , defaultCommonSetupFlags
, defaultHaddockFlags
, haddockProjectCommand
)
@@ -107,9 +109,14 @@ haddockProjectAction flags _extraArgs globalFlags = do
warn verbosity "haddock-project command is experimental, it might break in the future"
-- build all packages with appropriate haddock flags
- let haddockFlags =
+ let commonFlags =
+ defaultCommonSetupFlags
+ { setupVerbosity = haddockProjectVerbosity flags
+ }
+ haddockFlags =
defaultHaddockFlags
- { haddockHtml = Flag True
+ { haddockCommonFlags = commonFlags
+ , haddockHtml = Flag True
, -- one can either use `--haddock-base-url` or
-- `--haddock-html-location`.
haddockBaseUrl =
@@ -141,7 +148,6 @@ haddockProjectAction flags _extraArgs globalFlags = do
then Flag (toPathTemplate "../doc-index.html")
else NoFlag
, haddockKeepTempFiles = haddockProjectKeepTempFiles flags
- , haddockVerbosity = haddockProjectVerbosity flags
, haddockLib = haddockProjectLib flags
, haddockOutputDir = haddockProjectOutputDir flags
}
@@ -150,7 +156,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
{ NixStyleOptions.haddockFlags = haddockFlags
, NixStyleOptions.configFlags =
(NixStyleOptions.configFlags (commandDefaultFlags CmdBuild.buildCommand))
- { configVerbosity = haddockProjectVerbosity flags
+ { configCommonFlags = commonFlags
}
}
@@ -368,6 +374,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
(pkgConfigCompilerProgs sharedConfig')
(pkgConfigCompiler sharedConfig')
(pkgConfigPlatform sharedConfig')
+ Nothing
flags'
where
verbosity = fromFlagOrDefault normal (haddockProjectVerbosity flags)
diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs
index be4f66363d..fa64668f6f 100644
--- a/cabal-install/src/Distribution/Client/CmdInstall.hs
+++ b/cabal-install/src/Distribution/Client/CmdInstall.hs
@@ -97,7 +97,8 @@ import Distribution.Client.RebuildMonad
( runRebuild
)
import Distribution.Client.Setup
- ( ConfigFlags (..)
+ ( CommonSetupFlags (..)
+ , ConfigFlags (..)
, GlobalFlags (..)
, InstallFlags (..)
)
@@ -538,7 +539,7 @@ installAction flags@NixStyleFlags{extraFlags, configFlags, installFlags, project
traverseInstall (installCheckUnitExes InstallCheckInstall) installCfg
where
configFlags' = disableTestsBenchsByDefault configFlags
- verbosity = fromFlagOrDefault normal (configVerbosity configFlags')
+ verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags')
ignoreProject = flagIgnoreProject projectFlags
cliConfig =
commandLineFlagsToProjectConfig
diff --git a/cabal-install/src/Distribution/Client/CmdLegacy.hs b/cabal-install/src/Distribution/Client/CmdLegacy.hs
index 4572c868f3..128d5fb425 100644
--- a/cabal-install/src/Distribution/Client/CmdLegacy.hs
+++ b/cabal-install/src/Distribution/Client/CmdLegacy.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
@@ -37,23 +38,37 @@ regularCmd :: HasVerbosity flags => CommandUI flags -> (flags -> [String] -> glo
regularCmd ui action =
CommandSpec ui ((flip commandAddAction) (\flags extra globals -> action flags extra globals)) NormalCommand
-wrapperCmd :: Monoid flags => CommandUI flags -> (flags -> Setup.Flag Verbosity) -> (flags -> Setup.Flag String) -> CommandSpec (Client.GlobalFlags -> IO ())
-wrapperCmd ui verbosity' distPref =
- CommandSpec ui (\ui' -> wrapperAction ui' verbosity' distPref) NormalCommand
-
-wrapperAction :: Monoid flags => CommandUI flags -> (flags -> Setup.Flag Verbosity) -> (flags -> Setup.Flag String) -> Command (Client.GlobalFlags -> IO ())
-wrapperAction command verbosityFlag distPrefFlag =
+wrapperCmd
+ :: Monoid flags
+ => CommandUI flags
+ -> (flags -> Setup.CommonSetupFlags)
+ -> CommandSpec (Client.GlobalFlags -> IO ())
+wrapperCmd ui getCommonFlags =
+ CommandSpec ui (\ui' -> wrapperAction ui' getCommonFlags) NormalCommand
+
+wrapperAction
+ :: Monoid flags
+ => CommandUI flags
+ -> (flags -> Setup.CommonSetupFlags)
+ -> Command (Client.GlobalFlags -> IO ())
+wrapperAction command getCommonFlags =
commandAddAction
command
{ commandDefaultFlags = mempty
}
$ \flags extraArgs globalFlags -> do
- let verbosity' = Setup.fromFlagOrDefault normal (verbosityFlag flags)
+ let common = getCommonFlags flags
+ verbosity' = Setup.fromFlagOrDefault normal (Setup.setupVerbosity common)
+ mbWorkDir = Setup.flagToMaybe $ Setup.setupWorkingDir common
load <- try (loadConfigOrSandboxConfig verbosity' globalFlags)
let config = either (\(SomeException _) -> mempty) id load
- distPref <- findSavedDistPref config (distPrefFlag flags)
- let setupScriptOptions = defaultSetupScriptOptions{useDistPref = distPref}
+ distPref <- findSavedDistPref config (Setup.setupDistPref common)
+ let setupScriptOptions =
+ defaultSetupScriptOptions
+ { useDistPref = distPref
+ , useWorkingDir = mbWorkDir
+ }
let command' = command{commandName = T.unpack . T.replace "v1-" "" . T.pack . commandName $ command}
@@ -62,6 +77,7 @@ wrapperAction command verbosityFlag distPrefFlag =
setupScriptOptions
Nothing
command'
+ getCommonFlags
(const flags)
(const extraArgs)
@@ -89,25 +105,25 @@ instance HasVerbosity a => HasVerbosity (a, b, c, d, e, f) where
verbosity (a, _, _, _, _, _) = verbosity a
instance HasVerbosity Setup.BuildFlags where
- verbosity = verbosity . Setup.buildVerbosity
+ verbosity = verbosity . Setup.setupVerbosity . Setup.buildCommonFlags
instance HasVerbosity Setup.ConfigFlags where
- verbosity = verbosity . Setup.configVerbosity
+ verbosity = verbosity . Setup.setupVerbosity . Setup.configCommonFlags
instance HasVerbosity Setup.ReplFlags where
- verbosity = verbosity . Setup.replVerbosity
+ verbosity = verbosity . Setup.setupVerbosity . Setup.replCommonFlags
instance HasVerbosity Client.FreezeFlags where
verbosity = verbosity . Client.freezeVerbosity
instance HasVerbosity Setup.HaddockFlags where
- verbosity = verbosity . Setup.haddockVerbosity
+ verbosity = verbosity . Setup.setupVerbosity . Setup.haddockCommonFlags
instance HasVerbosity Client.UpdateFlags where
verbosity = verbosity . Client.updateVerbosity
instance HasVerbosity Setup.CleanFlags where
- verbosity = verbosity . Setup.cleanVerbosity
+ verbosity = verbosity . Setup.setupVerbosity . Setup.cleanCommonFlags
--
@@ -138,8 +154,12 @@ toLegacyCmd mkSpec = [toLegacy mkSpec]
legacyCmd :: HasVerbosity flags => CommandUI flags -> (flags -> [String] -> globals -> IO action) -> [CommandSpec (globals -> IO action)]
legacyCmd ui action = toLegacyCmd (regularCmd ui action)
-legacyWrapperCmd :: Monoid flags => CommandUI flags -> (flags -> Setup.Flag Verbosity) -> (flags -> Setup.Flag String) -> [CommandSpec (Client.GlobalFlags -> IO ())]
-legacyWrapperCmd ui verbosity' distPref = toLegacyCmd (wrapperCmd ui verbosity' distPref)
+legacyWrapperCmd
+ :: Monoid flags
+ => CommandUI flags
+ -> (flags -> Setup.CommonSetupFlags)
+ -> [CommandSpec (Client.GlobalFlags -> IO ())]
+legacyWrapperCmd ui commonFlags = toLegacyCmd (wrapperCmd ui commonFlags)
newCmd :: CommandUI flags -> (flags -> [String] -> globals -> IO action) -> [CommandSpec (globals -> IO action)]
newCmd origUi@CommandUI{..} action = [cmd defaultUi, cmd newUi, cmd origUi]
diff --git a/cabal-install/src/Distribution/Client/CmdListBin.hs b/cabal-install/src/Distribution/Client/CmdListBin.hs
index 1fefd3a737..e53100122e 100644
--- a/cabal-install/src/Distribution/Client/CmdListBin.hs
+++ b/cabal-install/src/Distribution/Client/CmdListBin.hs
@@ -49,7 +49,7 @@ import Distribution.Client.Setup (GlobalFlags (..))
import Distribution.Client.TargetProblem (TargetProblem (..))
import Distribution.Simple.BuildPaths (dllExtension, exeExtension)
import Distribution.Simple.Command (CommandUI (..))
-import Distribution.Simple.Setup (configVerbosity, fromFlagOrDefault)
+import Distribution.Simple.Setup (configCommonFlags, fromFlagOrDefault, setupVerbosity)
import Distribution.Simple.Utils (dieWithException, withOutputMarker, wrapText)
import Distribution.System (Platform)
import Distribution.Types.ComponentName (showComponentName)
@@ -173,7 +173,7 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do
_ -> dieWithException verbosity MultipleTargetsFound
where
defaultVerbosity = verboseStderr silent
- verbosity = fromFlagOrDefault defaultVerbosity (configVerbosity configFlags)
+ verbosity = fromFlagOrDefault defaultVerbosity (setupVerbosity $ configCommonFlags configFlags)
-- this is copied from
elaboratedPackage
diff --git a/cabal-install/src/Distribution/Client/CmdOutdated.hs b/cabal-install/src/Distribution/Client/CmdOutdated.hs
index 7093ee7a0b..ed40a1a85e 100644
--- a/cabal-install/src/Distribution/Client/CmdOutdated.hs
+++ b/cabal-install/src/Distribution/Client/CmdOutdated.hs
@@ -152,6 +152,7 @@ import Distribution.Version
import qualified Data.Set as S
import Distribution.Client.Errors
+import Distribution.Utils.Path (relativeSymbolicPath)
import System.Directory
( doesFileExist
, getCurrentDirectory
@@ -435,9 +436,8 @@ depsFromNewFreezeFile verbosity httpTransport compiler (Platform arch os) mproje
-- | Read the list of dependencies from the package description.
depsFromPkgDesc :: Verbosity -> Compiler -> Platform -> IO [PackageVersionConstraint]
depsFromPkgDesc verbosity comp platform = do
- cwd <- getCurrentDirectory
- path <- tryFindPackageDesc verbosity cwd
- gpd <- readGenericPackageDescription verbosity path
+ path <- tryFindPackageDesc verbosity Nothing
+ gpd <- readGenericPackageDescription verbosity Nothing (relativeSymbolicPath path)
let cinfo = compilerInfo comp
epd =
finalizePD
diff --git a/cabal-install/src/Distribution/Client/CmdRepl.hs b/cabal-install/src/Distribution/Client/CmdRepl.hs
index e243eb8297..39468a8e54 100644
--- a/cabal-install/src/Distribution/Client/CmdRepl.hs
+++ b/cabal-install/src/Distribution/Client/CmdRepl.hs
@@ -103,6 +103,7 @@ import Distribution.Simple.Compiler
)
import Distribution.Simple.Setup
( ReplOptions (..)
+ , setupVerbosity
)
import Distribution.Simple.Utils
( TempFileOptions (..)
@@ -500,7 +501,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g
go m ("PATH", Just s) = foldl' (\m' f -> Map.insertWith (+) f 1 m') m (splitSearchPath s)
go m _ = m
- verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
keepTempFiles = fromFlagOrDefault False replKeepTempFiles
validatedTargets ctx compiler elaboratedPlan targetSelectors = do
diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs
index b390dacb22..ea839eef94 100644
--- a/cabal-install/src/Distribution/Client/CmdRun.hs
+++ b/cabal-install/src/Distribution/Client/CmdRun.hs
@@ -70,7 +70,8 @@ import Distribution.Client.ScriptUtils
, withContextAndSelectors
)
import Distribution.Client.Setup
- ( ConfigFlags (..)
+ ( CommonSetupFlags (setupVerbosity)
+ , ConfigFlags (..)
, GlobalFlags (..)
)
import Distribution.Client.TargetProblem
@@ -199,7 +200,7 @@ runAction flags@NixStyleFlags{..} targetAndArgs globalFlags =
GlobalContext -> return (ctx, normal)
ScriptContext path exemeta -> (,silent) <$> updateContextAndWriteProjectFile ctx path exemeta
- let verbosity = fromFlagOrDefault defaultVerbosity (configVerbosity configFlags)
+ let verbosity = fromFlagOrDefault defaultVerbosity (setupVerbosity $ configCommonFlags configFlags)
buildCtx <-
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs
index a1142b06a2..07687bbeb9 100644
--- a/cabal-install/src/Distribution/Client/CmdSdist.hs
+++ b/cabal-install/src/Distribution/Client/CmdSdist.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -26,6 +27,7 @@ import Distribution.Client.DistDirLayout
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..)
, defaultNixStyleFlags
+ , updNixStyleCommonSetupFlags
)
import Distribution.Client.ProjectConfig
( ProjectConfig
@@ -47,7 +49,8 @@ import Distribution.Client.ProjectOrchestration
, establishProjectBaseContextWithRoot
)
import Distribution.Client.Setup
- ( GlobalFlags (..)
+ ( CommonSetupFlags (..)
+ , GlobalFlags (..)
)
import Distribution.Client.TargetSelector
( ComponentKind
@@ -63,6 +66,10 @@ import Distribution.Client.Types
import Distribution.Solver.Types.SourcePackage
( SourcePackage (..)
)
+import Distribution.Utils.Path hiding
+ ( (<.>)
+ , (</>)
+ )
import Distribution.Client.Errors
import Distribution.Client.SrcDist
@@ -94,8 +101,6 @@ import Distribution.Simple.PreProcess
)
import Distribution.Simple.Setup
( Flag (..)
- , configDistPref
- , configVerbosity
, flagToList
, flagToMaybe
, fromFlagOrDefault
@@ -166,7 +171,7 @@ sdistCommand =
data SdistFlags = SdistFlags
{ sdistVerbosity :: Flag Verbosity
- , sdistDistDir :: Flag FilePath
+ , sdistDistDir :: Flag (SymbolicPath Pkg (Dir Dist))
, sdistListSources :: Flag Bool
, sdistNulSeparated :: Flag Bool
, sdistOutputPath :: Flag FilePath
@@ -270,7 +275,13 @@ sdistAction (pf@ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
, Just "-" <- mOutputPath' ->
dieWithException verbosity Can'tWriteMultipleTarballs
| otherwise ->
- traverse_ (\pkg -> packageToSdist verbosity (distProjectRootDirectory distDirLayout) format (outputPath pkg) pkg) pkgs
+ for_ pkgs $ \pkg ->
+ packageToSdist
+ verbosity
+ (distProjectRootDirectory distDirLayout)
+ format
+ (outputPath pkg)
+ pkg
where
verbosity = fromFlagOrDefault normal sdistVerbosity
listSources = fromFlagOrDefault False sdistListSources
@@ -281,15 +292,15 @@ sdistAction (pf@ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
prjConfig =
commandLineFlagsToProjectConfig
globalFlags
- (defaultNixStyleFlags ())
- { configFlags =
- (configFlags $ defaultNixStyleFlags ())
- { configVerbosity = sdistVerbosity
- , configDistPref = sdistDistDir
- }
- , projectFlags = pf
+ (updNixStyleCommonSetupFlags (const commonFlags) $ defaultNixStyleFlags ())
+ { projectFlags = pf
}
mempty
+ commonFlags =
+ mempty
+ { setupVerbosity = sdistVerbosity
+ , setupDistPref = sdistDistDir
+ }
globalConfigFlag = projectConfigConfigFile (projectConfigShared prjConfig)
@@ -341,17 +352,18 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do
TarGzArchive -> do
writeLBS =<< BSL.readFile tgz
_ -> dieWithException verbosity $ CannotConvertTarballPackage (show format)
- Right dir -> case format of
- SourceList nulSep -> do
- let gpd :: GenericPackageDescription
- gpd = srcpkgDescription pkg
-
- files' <- listPackageSourcesWithDie verbosity dieWithException dir (flattenPackageDescription gpd) knownSuffixHandlers
- let files = nub $ sort $ map normalise files'
- let prefix = makeRelative projectRootDir dir
- write $ concat [prefix </> i ++ [nulSep] | i <- files]
- TarGzArchive -> do
- packageDirToSdist verbosity (srcpkgDescription pkg) dir >>= writeLBS
+ Right dir -> do
+ case format of
+ SourceList nulSep -> do
+ let gpd :: GenericPackageDescription
+ gpd = srcpkgDescription pkg
+
+ files' <- listPackageSourcesWithDie verbosity dieWithException (Just $ makeSymbolicPath dir) (flattenPackageDescription gpd) knownSuffixHandlers
+ let files = nub $ sort $ map (normalise . getSymbolicPath) files'
+ let prefix = makeRelative (normalise projectRootDir) dir
+ write $ concat [prefix </> i ++ [nulSep] | i <- files]
+ TarGzArchive -> do
+ packageDirToSdist verbosity (srcpkgDescription pkg) dir >>= writeLBS
--
diff --git a/cabal-install/src/Distribution/Client/CmdTest.hs b/cabal-install/src/Distribution/Client/CmdTest.hs
index 74fcc3a78b..7c1adffdc9 100644
--- a/cabal-install/src/Distribution/Client/CmdTest.hs
+++ b/cabal-install/src/Distribution/Client/CmdTest.hs
@@ -66,6 +66,7 @@ import Distribution.Verbosity
import qualified System.Exit (exitSuccess)
import Distribution.Client.Errors
+import Distribution.Client.Setup (CommonSetupFlags (..))
import GHC.Environment
( getFullArgs
)
@@ -163,7 +164,7 @@ testAction flags@NixStyleFlags{..} targetStrings globalFlags = do
runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
where
failWhenNoTestSuites = testFailWhenNoTestSuites testFlags
- verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags
-- | This defines what a 'TargetSelector' means for the @test@ command.
diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs
index 052c8d60ed..c388ba3987 100644
--- a/cabal-install/src/Distribution/Client/CmdUpdate.hs
+++ b/cabal-install/src/Distribution/Client/CmdUpdate.hs
@@ -56,7 +56,8 @@ import Distribution.Client.ProjectFlags
)
import Distribution.Client.ProjectOrchestration
import Distribution.Client.Setup
- ( ConfigFlags (..)
+ ( CommonSetupFlags (..)
+ , ConfigFlags (..)
, GlobalFlags
, RepoContext (..)
, UpdateFlags
@@ -223,7 +224,7 @@ updateAction flags@NixStyleFlags{..} extraArgs globalFlags = do
reposToUpdate
traverse_ (\_ -> collectJob jobCtrl) reposToUpdate
where
- verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here
globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs
index 1c2b4dabb2..2a2bc6754f 100644
--- a/cabal-install/src/Distribution/Client/Config.hs
+++ b/cabal-install/src/Distribution/Client/Config.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
@@ -176,6 +177,7 @@ import Distribution.Simple.Program
)
import Distribution.Simple.Setup
( BenchmarkFlags (..)
+ , CommonSetupFlags (..)
, ConfigFlags (..)
, Flag (..)
, HaddockFlags (..)
@@ -203,6 +205,7 @@ import Distribution.Simple.Utils
, warn
)
import Distribution.Solver.Types.ConstraintSource
+import Distribution.Utils.Path (getSymbolicPath, unsafeMakeSymbolicPath)
import Distribution.Verbosity
( normal
)
@@ -458,9 +461,21 @@ instance Semigroup SavedConfig where
where
combine = combine' savedClientInstallFlags
+ combinedSavedCommonFlags which =
+ CommonSetupFlags
+ { setupDistPref = combine setupDistPref
+ , setupWorkingDir = combine setupWorkingDir
+ , setupCabalFilePath = combine setupCabalFilePath
+ , setupVerbosity = combine setupVerbosity
+ , setupTargets = lastNonEmpty setupTargets
+ }
+ where
+ lastNonEmpty = lastNonEmpty' which
+ combine = combine' which
+
combinedSavedConfigureFlags =
ConfigFlags
- { configArgs = lastNonEmpty configArgs
+ { configCommonFlags = combinedSavedCommonFlags (configCommonFlags . savedConfigureFlags)
, configPrograms_ = configPrograms_ . savedConfigureFlags $ b
, -- TODO: NubListify
configProgramPaths = lastNonEmpty configProgramPaths
@@ -502,9 +517,6 @@ instance Semigroup SavedConfig where
, configDeterministic = combine configDeterministic
, configIPID = combine configIPID
, configCID = combine configCID
- , configDistPref = combine configDistPref
- , configCabalFilePath = combine configCabalFilePath
- , configVerbosity = combine configVerbosity
, configUserInstall = combine configUserInstall
, -- TODO: NubListify
configPackageDBs = lastNonEmpty configPackageDBs
@@ -595,7 +607,8 @@ instance Semigroup SavedConfig where
combinedSavedHaddockFlags =
HaddockFlags
- { -- TODO: NubListify
+ { haddockCommonFlags = combinedSavedCommonFlags (haddockCommonFlags . savedHaddockFlags)
+ , -- TODO: NubListify
haddockProgramPaths = lastNonEmpty haddockProgramPaths
, -- TODO: NubListify
haddockProgramArgs = lastNonEmpty haddockProgramArgs
@@ -613,15 +626,11 @@ instance Semigroup SavedConfig where
, haddockQuickJump = combine haddockQuickJump
, haddockHscolourCss = combine haddockHscolourCss
, haddockContents = combine haddockContents
- , haddockDistPref = combine haddockDistPref
, haddockKeepTempFiles = combine haddockKeepTempFiles
- , haddockVerbosity = combine haddockVerbosity
- , haddockCabalFilePath = combine haddockCabalFilePath
, haddockIndex = combine haddockIndex
, haddockBaseUrl = combine haddockBaseUrl
, haddockLib = combine haddockLib
, haddockOutputDir = combine haddockOutputDir
- , haddockArgs = lastNonEmpty haddockArgs
}
where
combine = combine' savedHaddockFlags
@@ -629,8 +638,7 @@ instance Semigroup SavedConfig where
combinedSavedTestFlags =
TestFlags
- { testDistPref = combine testDistPref
- , testVerbosity = combine testVerbosity
+ { testCommonFlags = combinedSavedCommonFlags (testCommonFlags . savedTestFlags)
, testHumanLog = combine testHumanLog
, testMachineLog = combine testMachineLog
, testShowDetails = combine testShowDetails
@@ -645,12 +653,10 @@ instance Semigroup SavedConfig where
combinedSavedBenchmarkFlags =
BenchmarkFlags
- { benchmarkDistPref = combine benchmarkDistPref
- , benchmarkVerbosity = combine benchmarkVerbosity
+ { benchmarkCommonFlags = combinedSavedCommonFlags (benchmarkCommonFlags . savedBenchmarkFlags)
, benchmarkOptions = lastNonEmpty benchmarkOptions
}
where
- combine = combine' savedBenchmarkFlags
lastNonEmpty = lastNonEmpty' savedBenchmarkFlags
combinedSavedReplMulti = combine' savedReplMulti id
@@ -685,7 +691,10 @@ baseSavedConfig = do
mempty
{ configHcFlavor = toFlag defaultCompiler
, configUserInstall = toFlag defaultUserInstall
- , configVerbosity = toFlag normal
+ , configCommonFlags =
+ mempty
+ { setupVerbosity = toFlag normal
+ }
}
, savedUserInstallDirs =
mempty
@@ -1290,18 +1299,9 @@ configFieldDescriptions src =
[]
++ [ viewAsFieldDescr $
optionDistPref
- (configDistPref . savedConfigureFlags)
- ( \distPref config ->
- config
- { savedConfigureFlags =
- (savedConfigureFlags config)
- { configDistPref = distPref
- }
- , savedHaddockFlags =
- (savedHaddockFlags config)
- { haddockDistPref = distPref
- }
- }
+ (setupDistPref . configCommonFlags . savedConfigureFlags)
+ ( \distPref ->
+ updSavedCommonSetupFlags (\common -> common{setupDistPref = distPref})
)
ParseArgs
]
@@ -1323,6 +1323,30 @@ configFieldDescriptions src =
toRelaxDeps True = RelaxDepsAll
toRelaxDeps False = mempty
+updSavedCommonSetupFlags
+ :: (CommonSetupFlags -> CommonSetupFlags)
+ -> SavedConfig
+ -> SavedConfig
+updSavedCommonSetupFlags setFlag config =
+ config
+ { savedConfigureFlags =
+ let flags = savedConfigureFlags config
+ common = configCommonFlags flags
+ in flags{configCommonFlags = setFlag common}
+ , savedHaddockFlags =
+ let flags = savedHaddockFlags config
+ common = haddockCommonFlags flags
+ in flags{haddockCommonFlags = setFlag common}
+ , savedTestFlags =
+ let flags = savedTestFlags config
+ common = testCommonFlags flags
+ in flags{testCommonFlags = setFlag common}
+ , savedBenchmarkFlags =
+ let flags = savedBenchmarkFlags config
+ common = benchmarkCommonFlags flags
+ in flags{benchmarkCommonFlags = setFlag common}
+ }
+
-- TODO: next step, make the deprecated fields elicit a warning.
--
deprecatedFieldDescriptions :: [FieldDescr SavedConfig]
@@ -1512,6 +1536,9 @@ parseConfig src initial = \str -> do
_ -> [s]
splitMultiPath xs = xs
+ splitMultiSymPath =
+ map unsafeMakeSymbolicPath . splitMultiPath . map getSymbolicPath
+
-- This is a fixup, pending a full config parser rewrite, to
-- ensure that config fields which can be comma-separated lists
-- actually parse as comma-separated lists.
@@ -1525,16 +1552,16 @@ parseConfig src initial = \str -> do
splitMultiPath
(fromNubList $ configProgramPathExtra scf)
, configExtraLibDirs =
- splitMultiPath
+ splitMultiSymPath
(configExtraLibDirs scf)
, configExtraLibDirsStatic =
- splitMultiPath
+ splitMultiSymPath
(configExtraLibDirsStatic scf)
, configExtraFrameworkDirs =
- splitMultiPath
+ splitMultiSymPath
(configExtraFrameworkDirs scf)
, configExtraIncludeDirs =
- splitMultiPath
+ splitMultiSymPath
(configExtraIncludeDirs scf)
, configConfigureArgs =
splitMultiPath
diff --git a/cabal-install/src/Distribution/Client/Configure.hs b/cabal-install/src/Distribution/Client/Configure.hs
index b01681d972..fc7ea49fe3 100644
--- a/cabal-install/src/Distribution/Client/Configure.hs
+++ b/cabal-install/src/Distribution/Client/Configure.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
-----------------------------------------------------------------------------
@@ -23,7 +24,6 @@ module Distribution.Client.Configure
-- * Saved configure flags
, readConfigFlagsFrom
, readConfigFlags
- , cabalConfigFlagsFile
, writeConfigFlagsTo
, writeConfigFlags
) where
@@ -99,14 +99,16 @@ import Distribution.Simple.PackageIndex as PackageIndex
)
import Distribution.Simple.Program (ProgramDb)
import Distribution.Simple.Setup
- ( ConfigFlags (..)
+ ( CommonSetupFlags (..)
+ , ConfigFlags (..)
, flagToMaybe
, fromFlagOrDefault
+ , maybeToFlag
, toFlag
)
import Distribution.Simple.Utils as Utils
( debug
- , defaultPackageDesc
+ , defaultPackageDescCwd
, dieWithException
, notice
, warn
@@ -121,6 +123,7 @@ import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint (..)
, thisPackageVersionConstraint
)
+import Distribution.Utils.Path
import Distribution.Version
( Version
, VersionRange
@@ -129,7 +132,6 @@ import Distribution.Version
)
import Distribution.Client.Errors
-import System.FilePath ((</>))
-- | Choose the Cabal version such that the setup scripts compiled against this
-- version will support the given command-line flags. Currently, it implements no
@@ -200,6 +202,7 @@ configure
(setupScriptOptions installedPkgIndex Nothing)
Nothing
configureCommand
+ configCommonFlags
(const configFlags)
(const extraArgs)
Right installPlan0 ->
@@ -238,7 +241,7 @@ configure
progdb
( fromFlagOrDefault
(useDistPref defaultSetupScriptOptions)
- (configDistPref configFlags)
+ (setupDistPref $ configCommonFlags configFlags)
)
( chooseCabalVersion
configExFlags
@@ -254,7 +257,7 @@ configureSetupScript
-> Compiler
-> Platform
-> ProgramDb
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-> VersionRange
-> Maybe Lock
-> Bool
@@ -399,9 +402,9 @@ planLocalPackage
(SourcePackageDb _ packagePrefs)
pkgConfigDb = do
pkg <-
- readGenericPackageDescription verbosity
- =<< case flagToMaybe (configCabalFilePath configFlags) of
- Nothing -> defaultPackageDesc verbosity
+ readGenericPackageDescription verbosity Nothing
+ =<< case flagToMaybe (setupCabalFilePath $ configCommonFlags configFlags) of
+ Nothing -> relativeSymbolicPath <$> defaultPackageDescCwd verbosity
Just fp -> return fp
let
@@ -501,6 +504,7 @@ configurePackage
scriptOptions
(Just pkg)
configureCommand
+ configCommonFlags
configureFlags
(const extraArgs)
where
@@ -510,7 +514,12 @@ configurePackage
configureFlags =
filterConfigureFlags
configFlags
- { configIPID =
+ { configCommonFlags =
+ (configCommonFlags configFlags)
+ { setupVerbosity = toFlag verbosity
+ , setupWorkingDir = maybeToFlag $ useWorkingDir scriptOptions
+ }
+ , configIPID =
if isJust (flagToMaybe (configIPID configFlags))
then -- Make sure cabal configure --ipid works.
configIPID configFlags
@@ -531,7 +540,6 @@ configurePackage
]
, -- Use '--exact-configuration' if supported.
configExactConfiguration = toFlag True
- , configVerbosity = toFlag verbosity
, -- NB: if the user explicitly specified
-- --enable-tests/--enable-benchmarks, always respect it.
-- (But if they didn't, let solver decide.)
@@ -570,7 +578,7 @@ readConfigFlagsFrom
readConfigFlagsFrom flags = do
readCommandFlags flags configureExCommand
--- | The path (relative to @--build-dir@) where the arguments to @configure@
+-- | The path (relative to the package root) where the arguments to @configure@
-- should be saved.
cabalConfigFlagsFile :: FilePath -> FilePath
cabalConfigFlagsFile dist = dist </> "cabal-config-flags"
@@ -586,12 +594,12 @@ readConfigFlags dist =
-- | Save the configure flags and environment to the specified files.
writeConfigFlagsTo
- :: FilePath
+ :: Verbosity
+ -> FilePath
-- ^ path to saved flags file
- -> Verbosity
-> (ConfigFlags, ConfigExFlags)
-> IO ()
-writeConfigFlagsTo file verb flags = do
+writeConfigFlagsTo verb file flags = do
writeCommandFlags verb file configureExCommand flags
-- | Save the build flags to the usual location.
@@ -602,4 +610,4 @@ writeConfigFlags
-> (ConfigFlags, ConfigExFlags)
-> IO ()
writeConfigFlags verb dist =
- writeConfigFlagsTo (cabalConfigFlagsFile dist) verb
+ writeConfigFlagsTo verb (cabalConfigFlagsFile dist)
diff --git a/cabal-install/src/Distribution/Client/DistDirLayout.hs b/cabal-install/src/Distribution/Client/DistDirLayout.hs
index b1a8dc5b48..01da7195d5 100644
--- a/cabal-install/src/Distribution/Client/DistDirLayout.hs
+++ b/cabal-install/src/Distribution/Client/DistDirLayout.hs
@@ -144,7 +144,7 @@ data CabalDirLayout = CabalDirLayout
--
-- It can either be an implicit project root in the current dir if no
-- @cabal.project@ file is found, or an explicit root if either
--- the file is found or the project root directory was specicied.
+-- the file is found or the project root directory was specified.
data ProjectRoot
= -- | An implicit project root. It contains the absolute project
-- root dir.
@@ -167,8 +167,7 @@ defaultDistDirLayout
:: ProjectRoot
-- ^ the project root
-> Maybe FilePath
- -- ^ the @dist@ directory or default
- -- (absolute or relative to the root)
+ -- ^ the @dist@ directory (relative to package root)
-> Maybe FilePath
-- ^ the documentation directory
-> DistDirLayout
diff --git a/cabal-install/src/Distribution/Client/GenBounds.hs b/cabal-install/src/Distribution/Client/GenBounds.hs
index ab69bb55ef..ae78b50c00 100644
--- a/cabal-install/src/Distribution/Client/GenBounds.hs
+++ b/cabal-install/src/Distribution/Client/GenBounds.hs
@@ -67,6 +67,7 @@ import Distribution.Types.ComponentRequestedSpec
( defaultComponentRequestedSpec
)
import Distribution.Types.Dependency
+import Distribution.Utils.Path (relativeSymbolicPath)
import Distribution.Version
( LowerBound (..)
, UpperBound (..)
@@ -80,9 +81,6 @@ import Distribution.Version
, intersectVersionRanges
, orLaterVersion
)
-import System.Directory
- ( getCurrentDirectory
- )
-- | Given a version, return an API-compatible (according to PVP) version range.
--
@@ -132,9 +130,8 @@ genBounds
genBounds verbosity packageDBs repoCtxt comp platform progdb globalFlags freezeFlags = do
let cinfo = compilerInfo comp
- cwd <- getCurrentDirectory
- path <- tryFindPackageDesc verbosity cwd
- gpd <- readGenericPackageDescription verbosity path
+ path <- relativeSymbolicPath <$> tryFindPackageDesc verbosity Nothing
+ gpd <- readGenericPackageDescription verbosity Nothing path
-- NB: We don't enable tests or benchmarks, since often they
-- don't really have useful bounds.
let epd =
diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs
index 2dc7d37e29..5958deca55 100644
--- a/cabal-install/src/Distribution/Client/IndexUtils.hs
+++ b/cabal-install/src/Distribution/Client/IndexUtils.hs
@@ -114,7 +114,6 @@ import Distribution.PackageDescription.Parsec
, parseGenericPackageDescriptionMaybe
)
import qualified Distribution.PackageDescription.Parsec as PackageDesc.Parse
-import qualified Distribution.Simple.PackageDescription as PackageDesc.Parse
import Distribution.Solver.Types.PackageIndex (PackageIndex)
import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
@@ -134,7 +133,7 @@ import qualified Data.Set as Set
import Distribution.Client.GZipUtils (maybeDecompress)
import Distribution.Client.Utils
( byteStringToFilePath
- , tryFindAddSourcePackageDesc
+ , tryReadAddSourcePackageDesc
)
import Distribution.Compat.Directory (listDirectory)
import Distribution.Compat.Time (getFileAge, getModTime)
@@ -167,7 +166,7 @@ getInstalledPackages
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages verbosity comp packageDbs progdb =
- Configure.getInstalledPackages verbosity' comp packageDbs progdb
+ Configure.getInstalledPackages verbosity' comp Nothing packageDbs progdb
where
verbosity' = lessVerbose verbosity
@@ -638,8 +637,7 @@ extractPkg verbosity entry blockNo = case Tar.entryContent entry of
if not dirExists
then return Nothing
else do
- cabalFile <- tryFindAddSourcePackageDesc verbosity path "Error reading package index."
- descr <- PackageDesc.Parse.readGenericPackageDescription normal cabalFile
+ descr <- tryReadAddSourcePackageDesc verbosity path "Error reading package index."
return . Just $
BuildTreeRef
(refTypeFromTypeCode typeCode)
@@ -1044,8 +1042,7 @@ packageListFromCache verbosity mkPkg hnd Cache{..} = accum mempty [] mempty cach
path <- fmap byteStringToFilePath . getEntryContent $ blockno
pkg <- do
let err = "Error reading package index from cache."
- file <- tryFindAddSourcePackageDesc verbosity path err
- PackageDesc.Parse.readGenericPackageDescription normal file
+ tryReadAddSourcePackageDesc verbosity path err
let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)
accum srcpkgs (srcpkg : btrs) prefs entries
accum srcpkgs btrs prefs (CachePreference pref@(Dependency pn _ _) _ _ : entries) =
diff --git a/cabal-install/src/Distribution/Client/Init/Format.hs b/cabal-install/src/Distribution/Client/Init/Format.hs
index d2ed5a8c87..ced1f74cf8 100644
--- a/cabal-install/src/Distribution/Client/Init/Format.hs
+++ b/cabal-install/src/Distribution/Client/Init/Format.hs
@@ -180,7 +180,7 @@ mkLibStanza opts (LibTarget srcDirs lang expMods otherMods exts deps tools) =
, field
"hs-source-dirs"
formatHsSourceDirs
- (unsafeMakeSymbolicPath <$> srcDirs)
+ (makeSymbolicPath <$> srcDirs)
["Directories containing source files."]
True
opts
@@ -247,7 +247,7 @@ mkExeStanza opts (ExeTarget exeMain appDirs lang otherMods exts deps tools) =
, field
"hs-source-dirs"
formatHsSourceDirs
- (unsafeMakeSymbolicPath <$> appDirs)
+ (makeSymbolicPath <$> appDirs)
["Directories containing source files."]
True
opts
@@ -316,7 +316,7 @@ mkTestStanza opts (TestTarget testMain dirs lang otherMods exts deps tools) =
, field
"hs-source-dirs"
formatHsSourceDirs
- (unsafeMakeSymbolicPath <$> dirs)
+ (makeSymbolicPath <$> dirs)
["Directories containing source files."]
True
opts
@@ -473,14 +473,14 @@ mkPkgDescription opts pkgDesc =
Just fs ->
field
"extra-doc-files"
- formatExtraSourceFiles
+ (formatExtraSourceFiles . map unsafeMakeSymbolicPath)
(toList fs)
["Extra doc files to be distributed with the package, such as a CHANGELOG or a README."]
True
opts
, field
"extra-source-files"
- formatExtraSourceFiles
+ (formatExtraSourceFiles . map unsafeMakeSymbolicPath)
(toList $ _pkgExtraSrcFiles pkgDesc)
["Extra source files to be distributed with the package, such as examples, or a tutorial module."]
True
diff --git a/cabal-install/src/Distribution/Client/Init/Utils.hs b/cabal-install/src/Distribution/Client/Init/Utils.hs
index f986cce0e0..12605a669a 100644
--- a/cabal-install/src/Distribution/Client/Init/Utils.hs
+++ b/cabal-install/src/Distribution/Client/Init/Utils.hs
@@ -128,7 +128,7 @@ retrieveSourceFiles fp = do
Nothing -> return Nothing
Just moduleName -> do
let fileExtension = takeExtension f
- relativeSourcePath <- makeRelative f <$> getCurrentDirectory
+ relativeSourcePath <- makeRelative (normalise f) <$> getCurrentDirectory
imports <- retrieveModuleImports f
extensions <- retrieveModuleExtensions f
diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs
index e1f855cdaf..a31e4d2ce6 100644
--- a/cabal-install/src/Distribution/Client/Install.hs
+++ b/cabal-install/src/Distribution/Client/Install.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
-----------------------------------------------------------------------------
@@ -111,6 +112,7 @@ import Distribution.Client.Setup
, InstallFlags (..)
, RepoContext (..)
, configureCommand
+ , filterCommonFlags
, filterConfigureFlags
, filterTestFlags
)
@@ -193,30 +195,36 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Program (ProgramDb)
import Distribution.Simple.Register (defaultRegisterOptions, registerPackage)
import Distribution.Simple.Setup
- ( BenchmarkFlags
+ ( BenchmarkFlags (..)
, BuildFlags (..)
+ , CommonSetupFlags (..)
+ , CopyFlags (..)
, HaddockFlags (..)
- , TestFlags
+ , RegisterFlags (..)
+ , TestFlags (..)
, buildCommand
+ , copyCommonFlags
+ , defaultCommonSetupFlags
, defaultDistPref
, emptyBuildFlags
, flagToMaybe
, fromFlag
, fromFlagOrDefault
, haddockCommand
+ , maybeToFlag
+ , registerCommonFlags
+ , setupDistPref
+ , setupVerbosity
+ , setupWorkingDir
+ , testCommonFlags
, toFlag
)
import qualified Distribution.Simple.Setup as Cabal
- ( CopyFlags (..)
- , Flag (..)
- , RegisterFlags (..)
- , TestFlags (..)
- , copyCommand
- , emptyCopyFlags
- , emptyRegisterFlags
- , registerCommand
- , testCommand
+import Distribution.Utils.Path hiding
+ ( (<.>)
+ , (</>)
)
+
import Distribution.Simple.Utils
( VerboseException
, createDirectoryIfMissingVerbose
@@ -1482,7 +1490,7 @@ performInstallations
distPref =
fromFlagOrDefault
(useDistPref defaultSetupScriptOptions)
- (configDistPref configFlags)
+ (setupDistPref $ configCommonFlags configFlags)
setupScriptOptions index lock rpkg =
configureSetupScript
@@ -1698,7 +1706,7 @@ installLocalPackage
:: Verbosity
-> PackageIdentifier
-> ResolvedPkgLoc
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-> (Maybe FilePath -> IO BuildOutcome)
-> IO BuildOutcome
installLocalPackage verbosity pkgid location distPref installPkg =
@@ -1733,7 +1741,7 @@ installLocalTarballPackage
:: Verbosity
-> PackageIdentifier
-> FilePath
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-> (Maybe FilePath -> IO BuildOutcome)
-> IO BuildOutcome
installLocalTarballPackage
@@ -1774,9 +1782,9 @@ installLocalTarballPackage
-- fails even with this workaround. We probably can live with that.
maybeRenameDistDir :: FilePath -> IO ()
maybeRenameDistDir absUnpackedPath = do
- let distDirPath = absUnpackedPath </> defaultDistPref
- distDirPathTmp = absUnpackedPath </> (defaultDistPref ++ "-tmp")
- distDirPathNew = absUnpackedPath </> distPref
+ let distDirPath = absUnpackedPath </> getSymbolicPath defaultDistPref
+ distDirPathTmp = absUnpackedPath </> (getSymbolicPath defaultDistPref ++ "-tmp")
+ distDirPathNew = absUnpackedPath </> getSymbolicPath distPref
distDirExists <- doesDirectoryExist distDirPath
when
( distDirExists
@@ -1854,6 +1862,15 @@ installUnpackedPackage
++ " with the latest revision from the index."
writeFileAtomic descFilePath pkgtxt
+ let mbWorkDir = fmap makeSymbolicPath workingDir
+ commonFlags ver =
+ (`filterCommonFlags` ver) $
+ defaultCommonSetupFlags
+ { setupDistPref = setupDistPref $ configCommonFlags configFlags
+ , setupVerbosity = toFlag verbosity'
+ , setupWorkingDir = maybeToFlag mbWorkDir
+ }
+
-- Make sure that we pass --libsubdir etc to 'setup configure' (necessary if
-- the setup script was compiled against an old version of the Cabal lib).
configFlags' <- addDefaultInstallDirs configFlags
@@ -1862,9 +1879,34 @@ installUnpackedPackage
configureFlags =
filterConfigureFlags
configFlags'
- { configVerbosity = toFlag verbosity'
+ { configCommonFlags =
+ (configCommonFlags (configFlags'))
+ { setupVerbosity = toFlag verbosity'
+ }
}
+ buildFlags vers =
+ emptyBuildFlags{buildCommonFlags = commonFlags vers}
+ shouldHaddock = fromFlag (installDocumentation installFlags)
+ haddockFlags' vers =
+ haddockFlags{haddockCommonFlags = commonFlags vers}
+ testsEnabled =
+ fromFlag (configTests configFlags)
+ && fromFlagOrDefault False (installRunTests installFlags)
+ testFlags' vers =
+ (`filterTestFlags` vers) $
+ testFlags{testCommonFlags = commonFlags vers}
+ copyFlags vers =
+ Cabal.emptyCopyFlags
+ { Cabal.copyDest = toFlag InstallDirs.NoCopyDest
+ , copyCommonFlags = commonFlags vers
+ }
+ shouldRegister = PackageDescription.hasLibs pkg
+ registerFlags vers =
+ Cabal.emptyRegisterFlags
+ { registerCommonFlags = commonFlags vers
+ }
+
-- Path to the optional log file.
mLogPath <- maybeLogPath
@@ -1872,19 +1914,19 @@ installUnpackedPackage
-- Configure phase
onFailure ConfigureFailed $ do
noticeProgress ProgressStarting
- setup configureCommand configureFlags mLogPath
+ setup configureCommand configCommonFlags configureFlags mLogPath
-- Build phase
onFailure BuildFailed $ do
noticeProgress ProgressBuilding
- setup buildCommand' buildFlags mLogPath
+ setup buildCommand' buildCommonFlags buildFlags mLogPath
-- Doc generation phase
docsResult <-
if shouldHaddock
then
( do
- setup haddockCommand haddockFlags' mLogPath
+ setup haddockCommand haddockCommonFlags haddockFlags' mLogPath
return DocsOk
)
`catchIO` (\_ -> return DocsFailed)
@@ -1894,7 +1936,7 @@ installUnpackedPackage
-- Tests phase
onFailure TestsFailed $ do
when (testsEnabled && PackageDescription.hasTests pkg) $
- setup Cabal.testCommand testFlags' mLogPath
+ setup Cabal.testCommand testCommonFlags testFlags' mLogPath
let testsResult
| testsEnabled = TestsOk
@@ -1911,11 +1953,14 @@ installUnpackedPackage
platform
pkg
$ do
- setup Cabal.copyCommand copyFlags mLogPath
+ setup Cabal.copyCommand copyCommonFlags copyFlags mLogPath
-- Capture installed package configuration file, so that
-- it can be incorporated into the final InstallPlan
- ipkgs <- genPkgConfs mLogPath
+ ipkgs <-
+ if shouldRegister
+ then genPkgConfs registerFlags mLogPath
+ else return []
let ipkgs' = case ipkgs of
[ipkg] -> [ipkg{Installed.installedUnitId = uid}]
_ -> ipkgs
@@ -1928,6 +1973,7 @@ installUnpackedPackage
verbosity
comp
progdb
+ mbWorkDir
packageDBs
ipkg'
defaultRegisterOptions
@@ -1944,38 +1990,6 @@ installUnpackedPackage
noticeProgress phase =
when isParallelBuild $
progressMessage verbosity phase dispname
-
- buildFlags _ =
- emptyBuildFlags
- { buildDistPref = configDistPref configFlags
- , buildVerbosity = toFlag verbosity'
- }
- shouldHaddock = fromFlag (installDocumentation installFlags)
- haddockFlags' _ =
- haddockFlags
- { haddockVerbosity = toFlag verbosity'
- , haddockDistPref = configDistPref configFlags
- }
- testsEnabled =
- fromFlag (configTests configFlags)
- && fromFlagOrDefault False (installRunTests installFlags)
- testFlags' =
- filterTestFlags
- testFlags
- { Cabal.testDistPref = configDistPref configFlags
- }
- copyFlags _ =
- Cabal.emptyCopyFlags
- { Cabal.copyDistPref = configDistPref configFlags
- , Cabal.copyDest = toFlag InstallDirs.NoCopyDest
- , Cabal.copyVerbosity = toFlag verbosity'
- }
- shouldRegister = PackageDescription.hasLibs pkg
- registerFlags _ =
- Cabal.emptyRegisterFlags
- { Cabal.regDistPref = configDistPref configFlags
- , Cabal.regVerbosity = toFlag verbosity'
- }
verbosity' = maybe verbosity snd useLogFile
tempTemplate name = name ++ "-" ++ prettyShow pkgid
@@ -2001,30 +2015,32 @@ installUnpackedPackage
(configUserInstall configFlags')
genPkgConfs
- :: Maybe FilePath
+ :: (Version -> Cabal.RegisterFlags)
+ -> Maybe FilePath
-> IO [Installed.InstalledPackageInfo]
- genPkgConfs mLogPath =
- if shouldRegister
- then do
- tmp <- getTemporaryDirectory
- withTempDirectory verbosity tmp (tempTemplate "pkgConf") $ \dir -> do
- let pkgConfDest = dir </> "pkgConf"
- registerFlags' version =
- (registerFlags version)
- { Cabal.regGenPkgConf = toFlag (Just pkgConfDest)
- }
- setup Cabal.registerCommand registerFlags' mLogPath
- is_dir <- doesDirectoryExist pkgConfDest
- let notHidden = not . isHidden
- isHidden name = "." `isPrefixOf` name
- if is_dir
- then -- Sort so that each prefix of the package
- -- configurations is well formed
-
- traverse (readPkgConf pkgConfDest) . sort . filter notHidden
- =<< getDirectoryContents pkgConfDest
- else fmap (: []) $ readPkgConf "." pkgConfDest
- else return []
+ genPkgConfs flags mLogPath = do
+ tmp <- getTemporaryDirectory
+ withTempDirectory verbosity tmp (tempTemplate "pkgConf") $ \dir -> do
+ let pkgConfDest = dir </> "pkgConf"
+ registerFlags' version =
+ (flags version)
+ { Cabal.regGenPkgConf = toFlag (Just pkgConfDest)
+ }
+ setup
+ Cabal.registerCommand
+ registerCommonFlags
+ registerFlags'
+ mLogPath
+ is_dir <- doesDirectoryExist pkgConfDest
+ let notHidden = not . isHidden
+ isHidden name = "." `isPrefixOf` name
+ if is_dir
+ then -- Sort so that each prefix of the package
+ -- configurations is well formed
+
+ traverse (readPkgConf pkgConfDest) . sort . filter notHidden
+ =<< getDirectoryContents pkgConfDest
+ else fmap (: []) $ readPkgConf "." pkgConfDest
readPkgConf
:: FilePath
@@ -2056,7 +2072,7 @@ installUnpackedPackage
when logFileExists $ removeFile logFileName
return (Just logFileName)
- setup cmd flags mLogPath =
+ setup cmd getCommonFlags flags mLogPath =
Exception.bracket
(traverse (\path -> openFile path AppendMode) mLogPath)
(traverse_ hClose)
@@ -2065,10 +2081,11 @@ installUnpackedPackage
verbosity
scriptOptions
{ useLoggingHandle = logFileHandle
- , useWorkingDir = workingDir
+ , useWorkingDir = makeSymbolicPath <$> workingDir
}
(Just pkg)
cmd
+ getCommonFlags
flags
(const [])
)
diff --git a/cabal-install/src/Distribution/Client/InstallSymlink.hs b/cabal-install/src/Distribution/Client/InstallSymlink.hs
index 13e29a44d8..1701aa1f65 100644
--- a/cabal-install/src/Distribution/Client/InstallSymlink.hs
+++ b/cabal-install/src/Distribution/Client/InstallSymlink.hs
@@ -84,6 +84,7 @@ import System.Directory
import System.FilePath
( isAbsolute
, joinPath
+ , normalise
, splitPath
, (</>)
)
@@ -316,7 +317,7 @@ symlinkBinary :: Symlink -> IO Bool
symlinkBinary inputs@Symlink{publicBindir, privateBindir, publicName, privateName} = do
onSymlinkBinary mkLink overwrite (return False) maybeOverwrite inputs
where
- relativeBindir = makeRelative publicBindir privateBindir
+ relativeBindir = makeRelative (normalise publicBindir) privateBindir
mkLink :: IO Bool
mkLink = True <$ createFileLink (relativeBindir </> privateName) (publicBindir </> publicName)
diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs
index 6ef0a67371..4c9dcba5f0 100644
--- a/cabal-install/src/Distribution/Client/Main.hs
+++ b/cabal-install/src/Distribution/Client/Main.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -24,6 +25,7 @@ import Distribution.Client.Setup
( ActAsSetupFlags (..)
, BuildFlags (..)
, CheckFlags (..)
+ , CommonSetupFlags (..)
, ConfigExFlags (..)
, ConfigFlags (..)
, FetchFlags (..)
@@ -51,6 +53,7 @@ import Distribution.Client.Setup
, defaultConfigExFlags
, defaultInstallFlags
, fetchCommand
+ , filterCommonFlags
, formatCommand
, freezeCommand
, genBoundsCommand
@@ -87,7 +90,6 @@ import Distribution.Simple.Setup
, RegisterFlags (..)
, ReplFlags (..)
, TestFlags (..)
- , configAbsolutePaths
, defaultHaddockFlags
, flagToMaybe
, fromFlag
@@ -189,6 +191,8 @@ import Distribution.PackageDescription
, buildable
)
+import Distribution.Client.Errors
+import Distribution.Compat.ResponseFile
import qualified Distribution.Make as Make
import Distribution.PackageDescription.PrettyPrint
( writeGenericPackageDescription
@@ -246,6 +250,10 @@ import Distribution.Text
( display
)
import qualified Distribution.Types.UnqualComponentName as Make
+import Distribution.Utils.Path hiding
+ ( (<.>)
+ , (</>)
+ )
import Distribution.Verbosity as Verbosity
( normal
)
@@ -258,11 +266,8 @@ import Distribution.Version
import Control.Exception (AssertionFailed, assert, try)
import Control.Monad (mapM_)
import Data.Monoid (Any (..))
-import Distribution.Client.Errors
-import Distribution.Compat.ResponseFile
import System.Directory
( doesFileExist
- , getCurrentDirectory
, withCurrentDirectory
)
import System.Environment (getEnvironment, getExecutablePath, getProgName)
@@ -437,7 +442,7 @@ mainWorker args = do
, regularCmd pathCommand pathAction
, regularCmd genBoundsCommand genBoundsAction
, regularCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction
- , wrapperCmd hscolourCommand hscolourVerbosity hscolourDistPref
+ , wrapperCmd hscolourCommand hscolourCommonFlags
, hiddenCmd formatCommand formatAction
, hiddenCmd actAsSetupCommand actAsSetupAction
, hiddenCmd manpageCommand (manpageAction commandSpecs)
@@ -470,8 +475,8 @@ mainWorker args = do
, legacyCmd testCommand testAction
, legacyCmd benchmarkCommand benchmarkAction
, legacyCmd cleanCommand cleanAction
- , legacyWrapperCmd copyCommand copyVerbosity copyDistPref
- , legacyWrapperCmd registerCommand regVerbosity regDistPref
+ , legacyWrapperCmd copyCommand copyCommonFlags
+ , legacyWrapperCmd registerCommand registerCommonFlags
, legacyCmd reconfigureCommand reconfigureAction
]
@@ -499,34 +504,39 @@ hiddenCmd ui action =
wrapperCmd
:: Monoid flags
=> CommandUI flags
- -> (flags -> Flag Verbosity)
- -> (flags -> Flag String)
+ -> (flags -> CommonSetupFlags)
-> CommandSpec Action
-wrapperCmd ui verbosity distPref =
- CommandSpec ui (\ui' -> wrapperAction ui' verbosity distPref) NormalCommand
+wrapperCmd ui getCommonFlags =
+ CommandSpec ui (\ui' -> wrapperAction ui' getCommonFlags) NormalCommand
wrapperAction
:: Monoid flags
=> CommandUI flags
- -> (flags -> Flag Verbosity)
- -> (flags -> Flag String)
+ -> (flags -> CommonSetupFlags)
-> Command Action
-wrapperAction command verbosityFlag distPrefFlag =
+wrapperAction command getCommonFlags =
commandAddAction
command
{ commandDefaultFlags = mempty
}
$ \flags extraArgs globalFlags -> do
- let verbosity = fromFlagOrDefault normal (verbosityFlag flags)
+ let common = getCommonFlags flags
+ verbosity = fromFlagOrDefault normal $ setupVerbosity common
+ mbWorkDir = flagToMaybe $ setupWorkingDir common
load <- try (loadConfigOrSandboxConfig verbosity globalFlags)
let config = either (\(SomeException _) -> mempty) id load
- distPref <- findSavedDistPref config (distPrefFlag flags)
- let setupScriptOptions = defaultSetupScriptOptions{useDistPref = distPref}
+ distPref <- findSavedDistPref config (setupDistPref common)
+ let setupScriptOptions =
+ defaultSetupScriptOptions
+ { useDistPref = distPref
+ , useWorkingDir = mbWorkDir
+ }
setupWrapper
verbosity
setupScriptOptions
Nothing
command
+ getCommonFlags
(const flags)
(const extraArgs)
@@ -535,11 +545,12 @@ configureAction
-> [String]
-> Action
configureAction (configFlags, configExFlags) extraArgs globalFlags = do
- let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ let common = configCommonFlags configFlags
+ verbosity = fromFlagOrDefault normal $ setupVerbosity common
config <-
updateInstallDirs (configUserInstall configFlags)
<$> loadConfigOrSandboxConfig verbosity globalFlags
- distPref <- findSavedDistPref config (configDistPref configFlags)
+ distPref <- getSymbolicPath <$> findSavedDistPref config (setupDistPref common)
nixInstantiate verbosity distPref True globalFlags config
nixShell verbosity distPref globalFlags config $ do
let configFlags' = savedConfigureFlags config `mappend` configFlags
@@ -573,11 +584,12 @@ reconfigureAction
-> [String]
-> Action
reconfigureAction flags@(configFlags, _) _ globalFlags = do
- let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ let common = configCommonFlags configFlags
+ verbosity = fromFlagOrDefault normal (setupVerbosity common)
config <-
updateInstallDirs (configUserInstall configFlags)
<$> loadConfigOrSandboxConfig verbosity globalFlags
- distPref <- findSavedDistPref config (configDistPref configFlags)
+ distPref <- findSavedDistPref config (setupDistPref common)
let checkFlags = Check $ \_ saved -> do
let flags' = saved <> flags
unless (saved == flags') $ info verbosity message
@@ -589,7 +601,7 @@ reconfigureAction flags@(configFlags, _) _ globalFlags = do
message =
"flags changed: "
++ unwords (commandShowOptions configureExCommand flags)
- nixInstantiate verbosity distPref True globalFlags config
+ nixInstantiate verbosity (getSymbolicPath distPref) True globalFlags config
_ <-
reconfigure
configureAction
@@ -604,9 +616,10 @@ reconfigureAction flags@(configFlags, _) _ globalFlags = do
buildAction :: BuildFlags -> [String] -> Action
buildAction buildFlags extraArgs globalFlags = do
- let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)
+ let common = buildCommonFlags buildFlags
+ verbosity = fromFlagOrDefault normal $ setupVerbosity common
config <- loadConfigOrSandboxConfig verbosity globalFlags
- distPref <- findSavedDistPref config (buildDistPref buildFlags)
+ distPref <- findSavedDistPref config (setupDistPref common)
-- Calls 'configureAction' to do the real work, so nothing special has to be
-- done to support sandboxes.
config' <-
@@ -619,19 +632,20 @@ buildAction buildFlags extraArgs globalFlags = do
[]
globalFlags
config
- nixShell verbosity distPref globalFlags config $ do
+ nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do
build verbosity config' distPref buildFlags extraArgs
-- | Actually do the work of building the package. This is separate from
-- 'buildAction' so that 'testAction' and 'benchmarkAction' do not invoke
-- 'reconfigure' twice.
-build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> IO ()
+build :: Verbosity -> SavedConfig -> SymbolicPath Pkg (Dir Dist) -> BuildFlags -> [String] -> IO ()
build verbosity config distPref buildFlags extraArgs =
setupWrapper
verbosity
setupOptions
Nothing
(Cabal.buildCommand progDb)
+ buildCommonFlags
mkBuildFlags
(const extraArgs)
where
@@ -639,16 +653,28 @@ build verbosity config distPref buildFlags extraArgs =
setupOptions = defaultSetupScriptOptions{useDistPref = distPref}
mkBuildFlags version = filterBuildFlags version config buildFlags'
+ commonFlags = buildCommonFlags buildFlags
buildFlags' =
buildFlags
- { buildVerbosity = toFlag verbosity
- , buildDistPref = toFlag distPref
+ { buildCommonFlags =
+ commonFlags
+ { setupVerbosity = toFlag verbosity
+ , setupDistPref = toFlag distPref
+ }
}
-- | Make sure that we don't pass new flags to setup scripts compiled against
-- old versions of Cabal.
filterBuildFlags :: Version -> SavedConfig -> BuildFlags -> BuildFlags
-filterBuildFlags version config buildFlags
+filterBuildFlags version config buildFlags =
+ let flags' = filterBuildFlags' version config buildFlags
+ in flags'
+ { buildCommonFlags =
+ filterCommonFlags (buildCommonFlags flags') version
+ }
+
+filterBuildFlags' :: Version -> SavedConfig -> BuildFlags -> BuildFlags
+filterBuildFlags' version config buildFlags
| version >= mkVersion [1, 19, 1] = buildFlags_latest
-- Cabal < 1.19.1 doesn't support 'build -j'.
| otherwise = buildFlags_pre_1_19_1
@@ -669,11 +695,11 @@ filterBuildFlags version config buildFlags
replAction :: ReplFlags -> [String] -> Action
replAction replFlags extraArgs globalFlags = do
- let verbosity = fromFlagOrDefault normal (replVerbosity replFlags)
+ let common = replCommonFlags replFlags
+ verbosity = fromFlagOrDefault normal $ setupVerbosity common
config <- loadConfigOrSandboxConfig verbosity globalFlags
- distPref <- findSavedDistPref config (replDistPref replFlags)
- cwd <- getCurrentDirectory
- pkgDesc <- findPackageDesc cwd
+ distPref <- findSavedDistPref config (setupDistPref common)
+ pkgDesc <- findPackageDesc Nothing
let
-- There is a .cabal file in the current directory: start a REPL and load
-- the project's modules.
@@ -696,14 +722,25 @@ replAction replFlags extraArgs globalFlags = do
{ useCabalVersion = orLaterVersion $ mkVersion [1, 18, 0]
, useDistPref = distPref
}
+ commonFlags = replCommonFlags replFlags
replFlags' =
replFlags
- { replVerbosity = toFlag verbosity
- , replDistPref = toFlag distPref
+ { replCommonFlags =
+ commonFlags
+ { setupVerbosity = toFlag verbosity
+ , setupDistPref = toFlag distPref
+ }
}
- nixShell verbosity distPref globalFlags config $
- setupWrapper verbosity setupOptions Nothing (Cabal.replCommand progDb) (const replFlags') (const extraArgs)
+ nixShell verbosity (getSymbolicPath distPref) globalFlags config $
+ setupWrapper
+ verbosity
+ setupOptions
+ Nothing
+ (Cabal.replCommand progDb)
+ Cabal.replCommonFlags
+ (const replFlags')
+ (const extraArgs)
-- No .cabal file in the current directory: just start the REPL (possibly
-- using the sandbox package DB).
@@ -716,7 +753,7 @@ replAction replFlags extraArgs globalFlags = do
(replProgramPaths replFlags)
(replProgramArgs replFlags)
programDb
- nixShell verbosity distPref globalFlags config $ do
+ nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do
startInterpreter
verbosity
programDb'
@@ -738,15 +775,17 @@ installAction
-> Action
installAction (configFlags, _, installFlags, _, _, _) _ globalFlags
| fromFlagOrDefault False (installOnly installFlags) = do
- let verb = fromFlagOrDefault normal (configVerbosity configFlags)
+ let common = configCommonFlags configFlags
+ verb = fromFlagOrDefault normal (setupVerbosity common)
config <- loadConfigOrSandboxConfig verb globalFlags
- dist <- findSavedDistPref config (configDistPref configFlags)
+ dist <- findSavedDistPref config (setupDistPref common)
let setupOpts = defaultSetupScriptOptions{useDistPref = dist}
setupWrapper
verb
setupOpts
Nothing
installCommand
+ (const common)
(const (mempty, mempty, mempty, mempty, mempty, mempty))
(const [])
installAction
@@ -759,12 +798,13 @@ installAction
)
extraArgs
globalFlags = do
- let verb = fromFlagOrDefault normal (configVerbosity configFlags)
+ let common = configCommonFlags configFlags
+ verb = fromFlagOrDefault normal $ setupVerbosity common
config <-
updateInstallDirs (configUserInstall configFlags)
<$> loadConfigOrSandboxConfig verb globalFlags
- dist <- findSavedDistPref config (configDistPref configFlags)
+ dist <- findSavedDistPref config $ setupDistPref common
do
targets <- readUserTargets verb extraArgs
@@ -772,7 +812,12 @@ installAction
let configFlags' =
maybeForceTests installFlags' $
savedConfigureFlags config
- `mappend` configFlags{configDistPref = toFlag dist}
+ `mappend` configFlags
+ { configCommonFlags =
+ (configCommonFlags configFlags)
+ { setupDistPref = toFlag dist
+ }
+ }
configExFlags' =
defaultConfigExFlags
`mappend` savedConfigureExFlags config
@@ -784,15 +829,30 @@ installAction
haddockFlags' =
defaultHaddockFlags
`mappend` savedHaddockFlags config
- `mappend` haddockFlags{haddockDistPref = toFlag dist}
+ `mappend` haddockFlags
+ { haddockCommonFlags =
+ (haddockCommonFlags haddockFlags)
+ { setupDistPref = toFlag dist
+ }
+ }
testFlags' =
Cabal.defaultTestFlags
`mappend` savedTestFlags config
- `mappend` testFlags{testDistPref = toFlag dist}
+ `mappend` testFlags
+ { testCommonFlags =
+ (testCommonFlags testFlags)
+ { setupDistPref = toFlag dist
+ }
+ }
benchmarkFlags' =
Cabal.defaultBenchmarkFlags
`mappend` savedBenchmarkFlags config
- `mappend` benchmarkFlags{benchmarkDistPref = toFlag dist}
+ `mappend` benchmarkFlags
+ { benchmarkCommonFlags =
+ (benchmarkCommonFlags benchmarkFlags)
+ { setupDistPref = toFlag dist
+ }
+ }
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, platform, progdb) <- configCompilerAux' configFlags'
@@ -800,18 +860,16 @@ installAction
-- future.
progdb' <- configureAllKnownPrograms verb progdb
- configFlags'' <- configAbsolutePaths configFlags'
-
withRepoContext verb globalFlags' $ \repoContext ->
install
verb
- (configPackageDB' configFlags'')
+ (configPackageDB' configFlags')
repoContext
comp
platform
progdb'
globalFlags'
- configFlags''
+ configFlags'
configExFlags'
installFlags'
haddockFlags'
@@ -831,12 +889,15 @@ testAction
-> GlobalFlags
-> IO ()
testAction (buildFlags, testFlags) extraArgs globalFlags = do
- let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)
+ let verbosity = fromFlagOrDefault normal (setupVerbosity $ buildCommonFlags buildFlags)
config <- loadConfigOrSandboxConfig verbosity globalFlags
- distPref <- findSavedDistPref config (testDistPref testFlags)
+ distPref <- findSavedDistPref config (setupDistPref $ testCommonFlags testFlags)
let buildFlags' =
buildFlags
- { buildVerbosity = testVerbosity testFlags
+ { buildCommonFlags =
+ (buildCommonFlags buildFlags)
+ { setupVerbosity = setupVerbosity $ testCommonFlags testFlags
+ }
}
checkFlags = Check $ \_ flags@(configFlags, configExFlags) ->
if fromFlagOrDefault False (configTests configFlags)
@@ -859,14 +920,20 @@ testAction (buildFlags, testFlags) extraArgs globalFlags = do
[]
globalFlags
config
- nixShell verbosity distPref globalFlags config $ do
+ nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do
let setupOptions = defaultSetupScriptOptions{useDistPref = distPref}
- testFlags' = testFlags{testDistPref = toFlag distPref}
+ testFlags' =
+ testFlags
+ { testCommonFlags =
+ (testCommonFlags testFlags){setupDistPref = toFlag distPref}
+ }
+ mbWorkDir = flagToMaybe $ testWorkingDir testFlags
-- The package was just configured, so the LBI must be available.
names <-
componentNamesFromLBI
verbosity
+ mbWorkDir
distPref
"test suites"
(\c -> case c of LBI.CTest{} -> True; _ -> False)
@@ -880,7 +947,14 @@ testAction (buildFlags, testFlags) extraArgs globalFlags = do
| otherwise = extraArgs
build verbosity config distPref buildFlags' extraArgs'
- setupWrapper verbosity setupOptions Nothing Cabal.testCommand (const testFlags') (const extraArgs')
+ setupWrapper
+ verbosity
+ setupOptions
+ Nothing
+ Cabal.testCommand
+ Cabal.testCommonFlags
+ (const testFlags')
+ (const extraArgs')
data ComponentNames
= ComponentNamesUnknown
@@ -889,12 +963,14 @@ data ComponentNames
-- | Return the names of all buildable components matching a given predicate.
componentNamesFromLBI
:: Verbosity
- -> FilePath
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -- ^ working directory
+ -> SymbolicPath Pkg (Dir Dist)
-> String
-> (LBI.Component -> Bool)
-> IO ComponentNames
-componentNamesFromLBI verbosity distPref targetsDescr compPred = do
- eLBI <- tryGetPersistBuildConfig distPref
+componentNamesFromLBI verbosity mbWorkDir distPref targetsDescr compPred = do
+ eLBI <- tryGetPersistBuildConfig mbWorkDir distPref
case eLBI of
Left err -> case err of
-- Note: the build config could have been generated by a custom setup
@@ -930,13 +1006,16 @@ benchmarkAction
let verbosity =
fromFlagOrDefault
normal
- (buildVerbosity buildFlags)
+ (setupVerbosity $ buildCommonFlags buildFlags)
config <- loadConfigOrSandboxConfig verbosity globalFlags
- distPref <- findSavedDistPref config (benchmarkDistPref benchmarkFlags)
+ distPref <- findSavedDistPref config (setupDistPref $ benchmarkCommonFlags benchmarkFlags)
let buildFlags' =
buildFlags
- { buildVerbosity = benchmarkVerbosity benchmarkFlags
+ { buildCommonFlags =
+ (buildCommonFlags buildFlags)
+ { setupVerbosity = setupVerbosity $ benchmarkCommonFlags benchmarkFlags
+ }
}
let checkFlags = Check $ \_ flags@(configFlags, configExFlags) ->
@@ -960,14 +1039,22 @@ benchmarkAction
[]
globalFlags
config
- nixShell verbosity distPref globalFlags config $ do
+ nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do
let setupOptions = defaultSetupScriptOptions{useDistPref = distPref}
- benchmarkFlags' = benchmarkFlags{benchmarkDistPref = toFlag distPref}
+ benchmarkFlags' =
+ benchmarkFlags
+ { benchmarkCommonFlags =
+ (benchmarkCommonFlags benchmarkFlags)
+ { setupDistPref = toFlag distPref
+ }
+ }
+ mbWorkDir = flagToMaybe $ benchmarkWorkingDir benchmarkFlags
-- The package was just configured, so the LBI must be available.
names <-
componentNamesFromLBI
verbosity
+ mbWorkDir
distPref
"benchmarks"
(\c -> case c of LBI.CBench{} -> True; _ -> False)
@@ -981,13 +1068,21 @@ benchmarkAction
| otherwise = extraArgs
build verbosity config' distPref buildFlags' extraArgs'
- setupWrapper verbosity setupOptions Nothing Cabal.benchmarkCommand (const benchmarkFlags') (const extraArgs')
+ setupWrapper
+ verbosity
+ setupOptions
+ Nothing
+ Cabal.benchmarkCommand
+ Cabal.benchmarkCommonFlags
+ (const benchmarkFlags')
+ (const extraArgs')
haddockAction :: HaddockFlags -> [String] -> Action
haddockAction haddockFlags extraArgs globalFlags = do
- let verbosity = fromFlag (haddockVerbosity haddockFlags)
+ let common = haddockCommonFlags haddockFlags
+ verbosity = fromFlag $ setupVerbosity common
config <- loadConfigOrSandboxConfig verbosity globalFlags
- distPref <- findSavedDistPref config (haddockDistPref haddockFlags)
+ distPref <- findSavedDistPref config (setupDistPref common)
config' <-
reconfigure
configureAction
@@ -998,11 +1093,17 @@ haddockAction haddockFlags extraArgs globalFlags = do
[]
globalFlags
config
- nixShell verbosity distPref globalFlags config $ do
+ let mbWorkDir = flagToMaybe $ setupWorkingDir common
+ nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do
let haddockFlags' =
defaultHaddockFlags
`mappend` savedHaddockFlags config'
- `mappend` haddockFlags{haddockDistPref = toFlag distPref}
+ `mappend` haddockFlags
+ { haddockCommonFlags =
+ (haddockCommonFlags haddockFlags)
+ { setupDistPref = toFlag distPref
+ }
+ }
setupScriptOptions =
defaultSetupScriptOptions
{ useDistPref = distPref
@@ -1012,36 +1113,44 @@ haddockAction haddockFlags extraArgs globalFlags = do
setupScriptOptions
Nothing
haddockCommand
+ haddockCommonFlags
(const haddockFlags')
(const extraArgs)
when (haddockForHackage haddockFlags == Flag ForHackage) $ do
- pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)
- let dest = distPref </> name <.> "tar.gz"
+ pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig mbWorkDir distPref)
+ let dest = getSymbolicPath distPref </> name <.> "tar.gz"
name = display (packageId pkg) ++ "-docs"
- docDir = distPref </> "doc" </> "html"
+ docDir = getSymbolicPath distPref </> "doc" </> "html"
createTarGzFile dest docDir name
notice verbosity $ "Documentation tarball created: " ++ dest
cleanAction :: CleanFlags -> [String] -> Action
cleanAction cleanFlags extraArgs globalFlags = do
+ let common = cleanCommonFlags cleanFlags
+ verbosity = fromFlagOrDefault normal $ setupVerbosity common
load <- try (loadConfigOrSandboxConfig verbosity globalFlags)
let config = either (\(SomeException _) -> mempty) id load
- distPref <- findSavedDistPref config (cleanDistPref cleanFlags)
+ distPref <- findSavedDistPref config $ setupDistPref common
let setupScriptOptions =
defaultSetupScriptOptions
{ useDistPref = distPref
, useWin32CleanHack = True
}
- cleanFlags' = cleanFlags{cleanDistPref = toFlag distPref}
+ cleanFlags' =
+ cleanFlags
+ { cleanCommonFlags =
+ (cleanCommonFlags cleanFlags)
+ { setupDistPref = toFlag distPref
+ }
+ }
setupWrapper
verbosity
setupScriptOptions
Nothing
cleanCommand
+ cleanCommonFlags
(const cleanFlags')
(const extraArgs)
- where
- verbosity = fromFlagOrDefault normal (cleanVerbosity cleanFlags)
listAction :: ListFlags -> [String] -> Action
listAction listFlags extraArgs globalFlags = do
@@ -1121,7 +1230,7 @@ freezeAction freezeFlags _extraArgs globalFlags = do
let verbosity = fromFlag (freezeVerbosity freezeFlags)
config <- loadConfigOrSandboxConfig verbosity globalFlags
distPref <- findSavedDistPref config NoFlag
- nixShell verbosity distPref globalFlags config $ do
+ nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do
let configFlags = savedConfigureFlags config
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, platform, progdb) <- configCompilerAux' configFlags
@@ -1142,7 +1251,7 @@ genBoundsAction freezeFlags _extraArgs globalFlags = do
let verbosity = fromFlag (freezeVerbosity freezeFlags)
config <- loadConfigOrSandboxConfig verbosity globalFlags
distPref <- findSavedDistPref config NoFlag
- nixShell verbosity distPref globalFlags config $ do
+ nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do
let configFlags = savedConfigureFlags config
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, platform, progdb) <- configCompilerAux' configFlags
@@ -1227,8 +1336,9 @@ uploadAction uploadFlags extraArgs globalFlags = do
[]
globalFlags
distPref <- findSavedDistPref config NoFlag
- pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)
- return $ distPref </> display (packageId pkg) ++ "-docs" <.> "tar.gz"
+ let mbWorkDir = flagToMaybe $ configWorkingDir $ savedConfigureFlags config
+ pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig mbWorkDir distPref)
+ return $ getSymbolicPath distPref </> display (packageId pkg) ++ "-docs" <.> "tar.gz"
checkAction :: CheckFlags -> [String] -> Action
checkAction checkFlags extraArgs _globalFlags = do
@@ -1244,13 +1354,11 @@ formatAction :: Flag Verbosity -> [String] -> Action
formatAction verbosityFlag extraArgs _globalFlags = do
let verbosity = fromFlag verbosityFlag
path <- case extraArgs of
- [] -> do
- cwd <- getCurrentDirectory
- tryFindPackageDesc verbosity cwd
- (p : _) -> return p
- pkgDesc <- readGenericPackageDescription verbosity path
+ [] -> relativeSymbolicPath <$> tryFindPackageDesc verbosity Nothing
+ (p : _) -> return $ makeSymbolicPath p
+ pkgDesc <- readGenericPackageDescription verbosity Nothing path
-- Uses 'writeFileAtomic' under the hood.
- writeGenericPackageDescription path pkgDesc
+ writeGenericPackageDescription (getSymbolicPath path) pkgDesc
reportAction :: ReportFlags -> [String] -> Action
reportAction reportFlags extraArgs globalFlags = do
@@ -1272,9 +1380,10 @@ reportAction reportFlags extraArgs globalFlags = do
runAction :: BuildFlags -> [String] -> Action
runAction buildFlags extraArgs globalFlags = do
- let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)
+ let common = buildCommonFlags buildFlags
+ verbosity = fromFlagOrDefault normal $ setupVerbosity common
config <- loadConfigOrSandboxConfig verbosity globalFlags
- distPref <- findSavedDistPref config (buildDistPref buildFlags)
+ distPref <- findSavedDistPref config $ setupDistPref common
config' <-
reconfigure
configureAction
@@ -1285,8 +1394,9 @@ runAction buildFlags extraArgs globalFlags = do
[]
globalFlags
config
- nixShell verbosity distPref globalFlags config $ do
- lbi <- getPersistBuildConfig distPref
+ let mbWorkDir = flagToMaybe $ setupWorkingDir common
+ nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do
+ lbi <- getPersistBuildConfig mbWorkDir distPref
(exe, exeArgs) <- splitRunArgs verbosity lbi extraArgs
build verbosity config' distPref buildFlags ["exe:" ++ display (exeName exe)]
diff --git a/cabal-install/src/Distribution/Client/NixStyleOptions.hs b/cabal-install/src/Distribution/Client/NixStyleOptions.hs
index 7a047774b2..ff2a010ba1 100644
--- a/cabal-install/src/Distribution/Client/NixStyleOptions.hs
+++ b/cabal-install/src/Distribution/Client/NixStyleOptions.hs
@@ -8,13 +8,19 @@ module Distribution.Client.NixStyleOptions
( NixStyleFlags (..)
, nixStyleOptions
, defaultNixStyleFlags
+ , updNixStyleCommonSetupFlags
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Simple.Command (OptionField (..), ShowOrParseArgs)
-import Distribution.Simple.Setup (BenchmarkFlags, HaddockFlags, TestFlags)
+import Distribution.Simple.Setup
+ ( BenchmarkFlags (benchmarkCommonFlags)
+ , CommonSetupFlags (..)
+ , HaddockFlags (..)
+ , TestFlags (testCommonFlags)
+ )
import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..))
import Distribution.Client.ProjectFlags
@@ -126,3 +132,27 @@ defaultNixStyleFlags x =
, projectFlags = defaultProjectFlags
, extraFlags = x
}
+
+updNixStyleCommonSetupFlags
+ :: (CommonSetupFlags -> CommonSetupFlags)
+ -> NixStyleFlags a
+ -> NixStyleFlags a
+updNixStyleCommonSetupFlags setFlag nixFlags =
+ nixFlags
+ { configFlags =
+ let flags = configFlags nixFlags
+ common = configCommonFlags flags
+ in flags{configCommonFlags = setFlag common}
+ , haddockFlags =
+ let flags = haddockFlags nixFlags
+ common = haddockCommonFlags flags
+ in flags{haddockCommonFlags = setFlag common}
+ , testFlags =
+ let flags = testFlags nixFlags
+ common = testCommonFlags flags
+ in flags{testCommonFlags = setFlag common}
+ , benchmarkFlags =
+ let flags = benchmarkFlags nixFlags
+ common = benchmarkCommonFlags flags
+ in flags{benchmarkCommonFlags = setFlag common}
+ }
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
index a0906686dd..3c11674de8 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -80,6 +81,10 @@ import qualified Distribution.Simple.Register as Cabal
import Distribution.Compat.Graph (IsNode (..))
import Distribution.Simple.Utils
+import Distribution.Utils.Path hiding
+ ( (<.>)
+ , (</>)
+ )
import Distribution.Version
import qualified Data.Map as Map
@@ -89,7 +94,7 @@ import qualified Text.PrettyPrint as Disp
import Control.Exception (assert, bracket, handle)
import System.Directory (doesDirectoryExist, doesFileExist, renameDirectory)
-import System.FilePath (makeRelative, takeDirectory, (<.>), (</>))
+import System.FilePath (makeRelative, normalise, takeDirectory, (<.>), (</>))
import System.Semaphore (SemaphoreName (..))
import Distribution.Client.Errors
@@ -533,7 +538,7 @@ rebuildTarget
case pkgBuildStatus of
BuildStatusDownload -> downloadPhase
BuildStatusUnpack tarball -> unpackTarballPhase tarball
- BuildStatusRebuild srcdir status -> rebuildPhase status srcdir
+ BuildStatusRebuild srcdir status -> rebuildPhase status (makeSymbolicPath srcdir)
-- TODO: perhaps re-nest the types to make these impossible
BuildStatusPreExisting{} -> unexpectedState
BuildStatusInstalled{} -> unexpectedState
@@ -570,7 +575,7 @@ rebuildTarget
-- 'BuildInplaceOnly' style packages. 'BuildAndInstall' style packages
-- would only start from download or unpack phases.
--
- rebuildPhase :: BuildStatusRebuild -> FilePath -> IO BuildResult
+ rebuildPhase :: BuildStatusRebuild -> SymbolicPath CWD (Dir Pkg) -> IO BuildResult
rebuildPhase buildStatus srcdir =
assert
(isInplaceBuildStyle $ elabBuildStyle pkg)
@@ -579,11 +584,13 @@ rebuildTarget
srcdir
builddir
where
+ distdir = distBuildDirectory (elabDistDirParams sharedPackageConfig pkg)
builddir =
- distBuildDirectory
- (elabDistDirParams sharedPackageConfig pkg)
+ makeSymbolicPath $
+ makeRelative (normalise $ getSymbolicPath srcdir) distdir
+ -- TODO: [nice to have] ^^ do this relative stuff better
- buildAndInstall :: FilePath -> FilePath -> IO BuildResult
+ buildAndInstall :: SymbolicPath CWD (Dir Pkg) -> SymbolicPath Pkg (Dir Dist) -> IO BuildResult
buildAndInstall srcdir builddir =
buildAndInstallUnpackedPackage
verbosity
@@ -597,12 +604,9 @@ rebuildTarget
plan
rpkg
srcdir
- builddir'
- where
- builddir' = makeRelative srcdir builddir
- -- TODO: [nice to have] ^^ do this relative stuff better
+ builddir
- buildInplace :: BuildStatusRebuild -> FilePath -> FilePath -> IO BuildResult
+ buildInplace :: BuildStatusRebuild -> SymbolicPath CWD (Dir Pkg) -> SymbolicPath Pkg (Dir Dist) -> IO BuildResult
buildInplace buildStatus srcdir builddir =
-- TODO: [nice to have] use a relative build dir rather than absolute
buildInplaceUnpackedPackage
@@ -698,8 +702,8 @@ withTarballLocalDirectory
-> DistDirParams
-> BuildStyle
-> Maybe CabalFileText
- -> ( FilePath -- Source directory
- -> FilePath -- Build directory
+ -> ( SymbolicPath CWD (Dir Pkg) -- Source directory
+ -> SymbolicPath Pkg (Dir Dist) -- Build directory
-> IO a
)
-> IO a
@@ -723,15 +727,15 @@ withTarballLocalDirectory
-- this way we avoid breaking those packages
BuildAndInstall ->
let tmpdir = distTempDirectory
+ builddir = relativeSymbolicPath $ makeRelativePathEx "dist"
in withTempDirectory verbosity tmpdir "src" $ \unpackdir -> do
+ let srcdir = makeSymbolicPath $ unpackdir </> prettyShow pkgid
unpackPackageTarball
verbosity
tarball
unpackdir
pkgid
pkgTextOverride
- let srcdir = unpackdir </> prettyShow pkgid
- builddir = srcdir </> "dist"
buildPkg srcdir builddir
-- In this case we make sure the tarball has been unpacked to the
@@ -740,10 +744,14 @@ withTarballLocalDirectory
BuildInplaceOnly{} -> do
let srcrootdir = distUnpackedSrcRootDirectory
srcdir = distUnpackedSrcDirectory pkgid
- builddir = distBuildDirectory dparams
+ builddir =
+ makeSymbolicPath $
+ makeRelative (normalise srcdir) $
+ distBuildDirectory dparams
+ -- TODO: [nice to have] ^^ do this relative stuff better
+ exists <- doesDirectoryExist srcdir
-- TODO: [nice to have] use a proper file monitor rather
-- than this dir exists test
- exists <- doesDirectoryExist srcdir
unless exists $ do
createDirectoryIfMissingVerbose verbosity True srcrootdir
unpackPackageTarball
@@ -758,7 +766,7 @@ withTarballLocalDirectory
srcrootdir
pkgid
dparams
- buildPkg srcdir builddir
+ buildPkg (makeSymbolicPath srcdir) builddir
unpackPackageTarball
:: Verbosity
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
index 5b651746dc..065334d5c6 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
@@ -42,7 +43,9 @@ import Distribution.Client.DistDirLayout
import Distribution.Client.FileMonitor
import Distribution.Client.JobControl
import Distribution.Client.Setup
- ( filterConfigureFlags
+ ( CommonSetupFlags
+ , filterCommonFlags
+ , filterConfigureFlags
, filterHaddockArgs
, filterHaddockFlags
, filterTestFlags
@@ -85,6 +88,10 @@ import Distribution.Types.PackageDescription.Lens (componentModules)
import Distribution.Simple.Utils
import Distribution.System (Platform (..))
+import Distribution.Utils.Path hiding
+ ( (<.>)
+ , (</>)
+ )
import Distribution.Version
import qualified Data.ByteString as BS
@@ -151,9 +158,9 @@ buildAndRegisterUnpackedPackage
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
- -> FilePath
- -> FilePath
- -> Maybe (FilePath)
+ -> SymbolicPath CWD (Dir Pkg)
+ -> SymbolicPath Pkg (Dir Dist)
+ -> Maybe FilePath
-- ^ The path to an /initialized/ log file
-> (PackageBuildingPhase -> IO ())
-> IO ()
@@ -178,27 +185,27 @@ buildAndRegisterUnpackedPackage
delegate $
PBConfigurePhase $
annotateFailure mlogFile ConfigureFailed $
- setup configureCommand configureFlags configureArgs
+ setup configureCommand Cabal.configCommonFlags configureFlags configureArgs
-- Build phase
delegate $
PBBuildPhase $
annotateFailure mlogFile BuildFailed $ do
- setup buildCommand buildFlags buildArgs
+ setup buildCommand Cabal.buildCommonFlags buildFlags buildArgs
-- Haddock phase
whenHaddock $
delegate $
PBHaddockPhase $
annotateFailure mlogFile HaddocksFailed $ do
- setup haddockCommand haddockFlags haddockArgs
+ setup haddockCommand Cabal.haddockCommonFlags haddockFlags haddockArgs
-- Install phase
delegate $
PBInstallPhase
{ runCopy = \destdir ->
annotateFailure mlogFile InstallFailed $
- setup Cabal.copyCommand (copyFlags destdir) copyArgs
+ setup Cabal.copyCommand Cabal.copyCommonFlags (copyFlags destdir) copyArgs
, runRegister = \pkgDBStack registerOpts ->
annotateFailure mlogFile InstallFailed $ do
-- We register ourselves rather than via Setup.hs. We need to
@@ -211,6 +218,7 @@ buildAndRegisterUnpackedPackage
verbosity
compiler
progdb
+ Nothing
pkgDBStack
ipkg
registerOpts
@@ -222,21 +230,21 @@ buildAndRegisterUnpackedPackage
delegate $
PBTestPhase $
annotateFailure mlogFile TestsFailed $
- setup testCommand testFlags testArgs
+ setup testCommand Cabal.testCommonFlags testFlags testArgs
-- Bench phase
whenBench $
delegate $
PBBenchPhase $
annotateFailure mlogFile BenchFailed $
- setup benchCommand benchFlags benchArgs
+ setup benchCommand Cabal.benchmarkCommonFlags benchFlags benchArgs
-- Repl phase
whenRepl $
delegate $
PBReplPhase $
annotateFailure mlogFile ReplFailed $
- setupInteractive replCommand replFlags replArgs
+ setupInteractive replCommand Cabal.replCommonFlags replFlags replArgs
return ()
where
@@ -262,6 +270,11 @@ buildAndRegisterUnpackedPackage
| hasValidHaddockTargets pkg = action
| otherwise = return ()
+ mbWorkDir = useWorkingDir scriptOptions
+ commonFlags v =
+ flip filterCommonFlags v $
+ setupHsCommonFlags verbosity mbWorkDir builddir
+
configureCommand = Cabal.configureCommand defaultProgramDb
configureFlags v =
flip filterConfigureFlags v $
@@ -269,20 +282,18 @@ buildAndRegisterUnpackedPackage
plan
rpkg
pkgshared
- verbosity
- builddir
+ (commonFlags v)
configureArgs _ = setupHsConfigureArgs pkg
buildCommand = Cabal.buildCommand defaultProgramDb
- buildFlags _ = setupHsBuildFlags comp_par_strat pkg pkgshared verbosity builddir
+ buildFlags v = setupHsBuildFlags comp_par_strat pkg pkgshared $ commonFlags v
buildArgs _ = setupHsBuildArgs pkg
- copyFlags destdir _ =
+ copyFlags destdir v =
setupHsCopyFlags
pkg
pkgshared
- verbosity
- builddir
+ (commonFlags v)
destdir
-- In theory, we could want to copy less things than those that were
-- built, but instead, we simply copy the targets that were built.
@@ -293,26 +304,23 @@ buildAndRegisterUnpackedPackage
flip filterTestFlags v $
setupHsTestFlags
pkg
- verbosity
- builddir
+ (commonFlags v)
testArgs _ = setupHsTestArgs pkg
benchCommand = Cabal.benchmarkCommand
- benchFlags _ =
+ benchFlags v =
setupHsBenchFlags
pkg
pkgshared
- verbosity
- builddir
+ (commonFlags v)
benchArgs _ = setupHsBenchArgs pkg
replCommand = Cabal.replCommand defaultProgramDb
- replFlags _ =
+ replFlags v =
setupHsReplFlags
pkg
pkgshared
- verbosity
- builddir
+ (commonFlags v)
replArgs _ = setupHsReplArgs pkg
haddockCommand = Cabal.haddockCommand
@@ -321,8 +329,7 @@ buildAndRegisterUnpackedPackage
setupHsHaddockFlags
pkg
pkgshared
- verbosity
- builddir
+ (commonFlags v)
haddockArgs v =
flip filterHaddockArgs v $
setupHsHaddockArgs pkg
@@ -340,10 +347,11 @@ buildAndRegisterUnpackedPackage
setup
:: CommandUI flags
+ -> (flags -> CommonSetupFlags)
-> (Version -> flags)
-> (Version -> [String])
-> IO ()
- setup cmd flags args =
+ setup cmd getCommonFlags flags args =
withLogging $ \mLogFileHandle ->
setupWrapper
verbosity
@@ -356,20 +364,23 @@ buildAndRegisterUnpackedPackage
}
(Just (elabPkgDescription pkg))
cmd
+ getCommonFlags
flags
args
setupInteractive
:: CommandUI flags
+ -> (flags -> CommonSetupFlags)
-> (Version -> flags)
-> (Version -> [String])
-> IO ()
- setupInteractive cmd flags args =
+ setupInteractive cmd getCommonFlags flags args =
setupWrapper
verbosity
scriptOptions{isInteractive = True}
(Just (elabPkgDescription pkg))
cmd
+ getCommonFlags
flags
args
@@ -379,14 +390,13 @@ buildAndRegisterUnpackedPackage
verbosity
distTempDirectory
$ \pkgConfDest -> do
- let registerFlags _ =
+ let registerFlags v =
setupHsRegisterFlags
pkg
pkgshared
- verbosity
- builddir
+ (commonFlags v)
pkgConfDest
- setup Cabal.registerCommand registerFlags (const [])
+ setup (Cabal.registerCommand) Cabal.registerCommonFlags registerFlags (const [])
withLogging :: (Maybe Handle -> IO r) -> IO r
withLogging action =
@@ -411,8 +421,8 @@ buildInplaceUnpackedPackage
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatusRebuild
- -> FilePath
- -> FilePath
+ -> SymbolicPath CWD (Dir Pkg)
+ -> SymbolicPath Pkg (Dir Dist)
-> IO BuildResult
buildInplaceUnpackedPackage
verbosity
@@ -434,7 +444,7 @@ buildInplaceUnpackedPackage
-- TODO: [code cleanup] there is duplication between the
-- distdirlayout and the builddir here builddir is not
-- enough, we also need the per-package cachedir
- createDirectoryIfMissingVerbose verbosity True builddir
+ createDirectoryIfMissingVerbose verbosity True $ getSymbolicPath builddir
createDirectoryIfMissingVerbose
verbosity
True
@@ -464,17 +474,17 @@ buildInplaceUnpackedPackage
whenReConfigure $ do
runConfigure
invalidatePackageRegFileMonitor packageFileMonitor
- updatePackageConfigFileMonitor packageFileMonitor srcdir pkg
+ updatePackageConfigFileMonitor packageFileMonitor (getSymbolicPath srcdir) pkg
PBBuildPhase{runBuild} -> do
whenRebuild $ do
timestamp <- beginUpdateFileMonitor
runBuild
let listSimple =
- execRebuild srcdir (needElaboratedConfiguredPackage pkg)
+ execRebuild (getSymbolicPath srcdir) (needElaboratedConfiguredPackage pkg)
listSdist =
fmap (map monitorFileHashed) $
- allPackageSourceFiles verbosity srcdir
+ allPackageSourceFiles verbosity (getSymbolicPath srcdir)
ifNullThen m m' = do
xs <- m
if null xs then m' else return xs
@@ -507,7 +517,7 @@ buildInplaceUnpackedPackage
pkg
updatePackageBuildFileMonitor
packageFileMonitor
- srcdir
+ (getSymbolicPath srcdir)
timestamp
pkg
buildStatus
@@ -554,7 +564,7 @@ buildInplaceUnpackedPackage
return (Just ipkg)
else return Nothing
- updatePackageRegFileMonitor packageFileMonitor srcdir mipkg
+ updatePackageRegFileMonitor packageFileMonitor (getSymbolicPath srcdir) mipkg
PBTestPhase{runTest} -> runTest
PBBenchPhase{runBench} -> runBench
PBReplPhase{runRepl} -> runRepl
@@ -613,8 +623,8 @@ buildAndInstallUnpackedPackage
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
- -> FilePath
- -> FilePath
+ -> SymbolicPath CWD (Dir Pkg)
+ -> SymbolicPath Pkg (Dir Dist)
-> IO BuildResult
buildAndInstallUnpackedPackage
verbosity
@@ -634,7 +644,7 @@ buildAndInstallUnpackedPackage
rpkg@(ReadyPackage pkg)
srcdir
builddir = do
- createDirectoryIfMissingVerbose verbosity True (srcdir </> builddir)
+ createDirectoryIfMissingVerbose verbosity True (interpretSymbolicPath (Just srcdir) builddir)
-- TODO: [code cleanup] deal consistently with talking to older
-- Setup.hs versions, much like we do for ghc, with a proper
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs
index 23d8cbab93..151d13ca8e 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs
@@ -106,6 +106,7 @@ import Distribution.Solver.Types.PackageConstraint
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SourcePackage
+import Distribution.Client.Errors
import Distribution.Client.Setup
( defaultMaxBackjumps
, defaultSolver
@@ -209,7 +210,6 @@ import qualified Data.Map as Map
import qualified Data.Set as Set
import Numeric (showHex)
-import Distribution.Client.Errors
import Network.URI
( URI (..)
, URIAuth (..)
@@ -217,6 +217,13 @@ import Network.URI
, uriToString
)
import System.Directory
+ ( canonicalizePath
+ , doesDirectoryExist
+ , doesFileExist
+ , getCurrentDirectory
+ , getDirectoryContents
+ , getHomeDirectory
+ )
import System.FilePath hiding (combine)
import System.IO
( IOMode (ReadMode)
@@ -552,7 +559,7 @@ findProjectRoot verbosity mprojectDir mprojectFile = do
probeProjectRoot :: Maybe FilePath -> IO (Either BadProjectRoot ProjectRoot)
probeProjectRoot mprojectFile = do
- startdir <- getCurrentDirectory
+ startdir <- System.Directory.getCurrentDirectory
homedir <- getHomeDirectory
probe startdir homedir
where
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
index d949437f5d..e76dbea443 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -97,6 +98,7 @@ import Distribution.Simple.Program.Db
)
import Distribution.Simple.Setup
( BenchmarkFlags (..)
+ , CommonSetupFlags (..)
, ConfigFlags (..)
, DumpBuildInfo (DumpBuildInfo, NoDumpBuildInfo)
, Flag (..)
@@ -135,7 +137,9 @@ import Distribution.Utils.NubList
, toNubList
)
+import Distribution.Client.HttpUtils
import Distribution.Client.ParseUtils
+import Distribution.Client.ReplFlags (multiReplOption)
import Distribution.Deprecated.ParseUtils
( PError (..)
, PWarning (..)
@@ -155,6 +159,7 @@ import Distribution.Deprecated.ReadP
, (+++)
)
import qualified Distribution.Deprecated.ReadP as Parse
+import Distribution.Fields.ConfVar (parseConditionConfVarFromClause)
import Distribution.Parsec (ParsecParser, parsecToken)
import Distribution.Simple.Command
( CommandUI (commandOptions)
@@ -167,24 +172,22 @@ import Distribution.System (Arch, OS)
import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint
)
-import Text.PrettyPrint
- ( Doc
- , ($+$)
+import Distribution.Utils.Path hiding
+ ( (<.>)
+ , (</>)
)
-import qualified Text.PrettyPrint as Disp
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as Map
import qualified Data.Set as Set
-
import Network.URI (URI (..), parseURI)
-
-import Distribution.Fields.ConfVar (parseConditionConfVarFromClause)
-
-import Distribution.Client.HttpUtils
-import Distribution.Client.ReplFlags (multiReplOption)
import System.Directory (createDirectoryIfMissing)
import System.FilePath (isAbsolute, isPathSeparator, makeValid, takeDirectory, (</>))
+import Text.PrettyPrint
+ ( Doc
+ , ($+$)
+ )
+import qualified Text.PrettyPrint as Disp
------------------------------------------------------------------
-- Handle extended project config files with conditionals and imports.
@@ -627,7 +630,7 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
} = globalFlags
ConfigFlags
- { configDistPref = projectConfigDistDir
+ { configCommonFlags = commonFlags
, configHcFlavor = projectConfigHcFlavor
, configHcPath = projectConfigHcPath
, configHcPkg = projectConfigHcPkg
@@ -637,6 +640,12 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
configPackageDBs = projectConfigPackageDBs
} = configFlags
+ CommonSetupFlags
+ { setupDistPref = projectConfigAbsoluteDistDir
+ } = commonFlags
+
+ projectConfigDistDir = fmap getSymbolicPath projectConfigAbsoluteDistDir
+
ConfigExFlags
{ configCabalVersion = projectConfigCabalVersion
, configExConstraints = projectConfigConstraints
@@ -715,10 +724,6 @@ convertLegacyPerPackageFlags
, configSplitObjs = packageConfigSplitObjs
, configStripExes = packageConfigStripExes
, configStripLibs = packageConfigStripLibs
- , configExtraLibDirs = packageConfigExtraLibDirs
- , configExtraLibDirsStatic = packageConfigExtraLibDirsStatic
- , configExtraFrameworkDirs = packageConfigExtraFrameworkDirs
- , configExtraIncludeDirs = packageConfigExtraIncludeDirs
, configConfigurationsFlags = packageConfigFlagAssignment
, configTests = packageConfigTests
, configBenchmarks = packageConfigBenchmarks
@@ -729,6 +734,10 @@ convertLegacyPerPackageFlags
, configRelocatable = packageConfigRelocatable
, configCoverageFor = _
} = configFlags
+ packageConfigExtraLibDirs = fmap getSymbolicPath $ configExtraLibDirs configFlags
+ packageConfigExtraLibDirsStatic = fmap getSymbolicPath $ configExtraLibDirsStatic configFlags
+ packageConfigExtraFrameworkDirs = fmap getSymbolicPath $ configExtraFrameworkDirs configFlags
+ packageConfigExtraIncludeDirs = fmap getSymbolicPath $ configExtraIncludeDirs configFlags
packageConfigProgramPaths = MapLast (Map.fromList configProgramPaths)
packageConfigProgramArgs = MapMappend (Map.fromListWith (++) configProgramArgs)
@@ -805,9 +814,13 @@ convertLegacyBuildOnlyFlags
} = globalFlags
ConfigFlags
- { configVerbosity = projectConfigVerbosity
+ { configCommonFlags = commonFlags
} = configFlags
+ CommonSetupFlags
+ { setupVerbosity = projectConfigVerbosity
+ } = commonFlags
+
InstallFlags
{ installDryRun = projectConfigDryRun
, installOnlyDownload = projectConfigOnlyDownload
@@ -897,10 +910,15 @@ convertToLegacySharedConfig
, globalProgPathExtra = projectConfigProgPathExtra
}
+ commonFlags =
+ mempty
+ { setupVerbosity = projectConfigVerbosity
+ , setupDistPref = fmap makeSymbolicPath $ projectConfigDistDir
+ }
+
configFlags =
mempty
- { configVerbosity = projectConfigVerbosity
- , configDistPref = projectConfigDistDir
+ { configCommonFlags = commonFlags
, configPackageDBs = projectConfigPackageDBs
, configInstallDirs = projectConfigInstallDirs
}
@@ -979,9 +997,12 @@ convertToLegacyAllPackageConfig
, legacyBenchmarkFlags = mempty
}
where
+ commonFlags =
+ mempty
+
configFlags =
ConfigFlags
- { configArgs = mempty
+ { configCommonFlags = commonFlags
, configPrograms_ = mempty
, configProgramPaths = mempty
, configProgramArgs = mempty
@@ -1006,9 +1027,6 @@ convertToLegacyAllPackageConfig
, configProgSuffix = mempty
, configInstallDirs = projectConfigInstallDirs
, configScratchDir = mempty
- , configDistPref = mempty
- , configCabalFilePath = mempty
- , configVerbosity = mempty
, configUserInstall = mempty -- projectConfigUserInstall,
, configPackageDBs = mempty
, configGHCiLib = mempty
@@ -1056,9 +1074,11 @@ convertToLegacyPerPackageConfig PackageConfig{..} =
, legacyBenchmarkFlags = benchmarkFlags
}
where
+ commonFlags =
+ mempty
configFlags =
ConfigFlags
- { configArgs = mempty
+ { configCommonFlags = commonFlags
, configPrograms_ = configPrograms_ mempty
, configProgramPaths = Map.toList (getMapLast packageConfigProgramPaths)
, configProgramArgs = Map.toList (getMapMappend packageConfigProgramArgs)
@@ -1083,9 +1103,6 @@ convertToLegacyPerPackageConfig PackageConfig{..} =
, configProgSuffix = packageConfigProgSuffix
, configInstallDirs = mempty
, configScratchDir = mempty
- , configDistPref = mempty
- , configCabalFilePath = mempty
- , configVerbosity = mempty
, configUserInstall = mempty
, configPackageDBs = mempty
, configGHCiLib = packageConfigGHCiLib
@@ -1093,13 +1110,13 @@ convertToLegacyPerPackageConfig PackageConfig{..} =
, configSplitObjs = packageConfigSplitObjs
, configStripExes = packageConfigStripExes
, configStripLibs = packageConfigStripLibs
- , configExtraLibDirs = packageConfigExtraLibDirs
- , configExtraLibDirsStatic = packageConfigExtraLibDirsStatic
- , configExtraFrameworkDirs = packageConfigExtraFrameworkDirs
+ , configExtraLibDirs = fmap makeSymbolicPath $ packageConfigExtraLibDirs
+ , configExtraLibDirsStatic = fmap makeSymbolicPath $ packageConfigExtraLibDirsStatic
+ , configExtraFrameworkDirs = fmap makeSymbolicPath $ packageConfigExtraFrameworkDirs
, configConstraints = mempty
, configDependencies = mempty
, configPromisedDependencies = mempty
- , configExtraIncludeDirs = packageConfigExtraIncludeDirs
+ , configExtraIncludeDirs = fmap makeSymbolicPath $ packageConfigExtraIncludeDirs
, configIPID = mempty
, configCID = mempty
, configDeterministic = mempty
@@ -1126,7 +1143,8 @@ convertToLegacyPerPackageConfig PackageConfig{..} =
haddockFlags =
HaddockFlags
- { haddockProgramPaths = mempty
+ { haddockCommonFlags = commonFlags
+ , haddockProgramPaths = mempty
, haddockProgramArgs = mempty
, haddockHoogle = packageConfigHaddockHoogle
, haddockHtml = packageConfigHaddockHtml
@@ -1142,21 +1160,16 @@ convertToLegacyPerPackageConfig PackageConfig{..} =
, haddockQuickJump = packageConfigHaddockQuickJump
, haddockHscolourCss = packageConfigHaddockHscolourCss
, haddockContents = packageConfigHaddockContents
- , haddockDistPref = mempty
, haddockKeepTempFiles = mempty
- , haddockVerbosity = mempty
- , haddockCabalFilePath = mempty
, haddockIndex = packageConfigHaddockIndex
, haddockBaseUrl = packageConfigHaddockBaseUrl
, haddockLib = packageConfigHaddockLib
, haddockOutputDir = packageConfigHaddockOutputDir
- , haddockArgs = mempty
}
testFlags =
TestFlags
- { testDistPref = mempty
- , testVerbosity = mempty
+ { testCommonFlags = commonFlags
, testHumanLog = packageConfigTestHumanLog
, testMachineLog = packageConfigTestMachineLog
, testShowDetails = packageConfigTestShowDetails
@@ -1168,8 +1181,7 @@ convertToLegacyPerPackageConfig PackageConfig{..} =
benchmarkFlags =
BenchmarkFlags
- { benchmarkDistPref = mempty
- , benchmarkVerbosity = mempty
+ { benchmarkCommonFlags = commonFlags
, benchmarkOptions = packageConfigBenchmarkOptions
}
@@ -1432,26 +1444,26 @@ legacyPackageConfigFieldDescrs =
"extra-include-dirs"
showTokenQ
parseTokenQ
- configExtraIncludeDirs
- (\v conf -> conf{configExtraIncludeDirs = v})
+ (fmap getSymbolicPath . configExtraIncludeDirs)
+ (\v conf -> conf{configExtraIncludeDirs = fmap makeSymbolicPath v})
, newLineListField
"extra-lib-dirs"
showTokenQ
parseTokenQ
- configExtraLibDirs
- (\v conf -> conf{configExtraLibDirs = v})
+ (fmap getSymbolicPath . configExtraLibDirs)
+ (\v conf -> conf{configExtraLibDirs = fmap makeSymbolicPath v})
, newLineListField
"extra-lib-dirs-static"
showTokenQ
parseTokenQ
- configExtraLibDirsStatic
- (\v conf -> conf{configExtraLibDirsStatic = v})
+ (fmap getSymbolicPath . configExtraLibDirsStatic)
+ (\v conf -> conf{configExtraLibDirsStatic = fmap makeSymbolicPath v})
, newLineListField
"extra-framework-dirs"
showTokenQ
parseTokenQ
- configExtraFrameworkDirs
- (\v conf -> conf{configExtraFrameworkDirs = v})
+ (fmap getSymbolicPath . configExtraFrameworkDirs)
+ (\v conf -> conf{configExtraFrameworkDirs = fmap makeSymbolicPath v})
, newLineListField
"extra-prog-path"
showTokenQ
diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
index c3fa259b41..2d963b0e07 100644
--- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -216,6 +216,7 @@ import Distribution.Types.Flag
import Distribution.Utils.NubList
( fromNubList
)
+import Distribution.Utils.Path (makeSymbolicPath)
import Distribution.Verbosity
import Distribution.Version
( mkVersion
@@ -1042,13 +1043,17 @@ printPlan
showConfigureFlags :: ElaboratedConfiguredPackage -> String
showConfigureFlags elab =
- let fullConfigureFlags =
+ let commonFlags =
+ setupHsCommonFlags
+ verbosity
+ Nothing -- omit working directory
+ (makeSymbolicPath "$builddir")
+ fullConfigureFlags =
setupHsConfigureFlags
elaboratedPlan
(ReadyPackage elab)
elaboratedShared
- verbosity
- "$builddir"
+ commonFlags
-- \| Given a default value @x@ for a flag, nub @Flag x@
-- into @NoFlag@. This gives us a tidier command line
-- rendering.
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs
index 0e4fb108a1..d38f07037a 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -70,6 +71,10 @@ import Distribution.System
import Distribution.Types.Version
( mkVersion
)
+import Distribution.Utils.Path hiding
+ ( (<.>)
+ , (</>)
+ )
import Distribution.Verbosity
import Distribution.Client.Compat.Prelude
@@ -225,7 +230,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
| elabSetupScriptCliVersion elab < mkVersion [3, 7, 0, 0] =
"build-info" J..= J.Null
| otherwise =
- "build-info" J..= J.String (buildInfoPref dist_dir)
+ "build-info" J..= J.String (getSymbolicPath $ buildInfoPref $ makeSymbolicPath dist_dir)
packageLocationToJ :: PackageLocation (Maybe FilePath) -> J.Value
packageLocationToJ pkgloc =
@@ -1024,4 +1029,4 @@ relativePackageDBPath relroot pkgdb =
UserPackageDB -> UserPackageDB
SpecificPackageDB path -> SpecificPackageDB relpath
where
- relpath = makeRelative relroot path
+ relpath = makeRelative (normalise relroot) path
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 6344249a8a..304331e1f9 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
@@ -74,6 +75,7 @@ module Distribution.Client.ProjectPlanning
-- * Setup.hs CLI flags for building
, setupHsScriptOptions
+ , setupHsCommonFlags
, setupHsConfigureFlags
, setupHsConfigureArgs
, setupHsBuildFlags
@@ -135,6 +137,10 @@ import Distribution.CabalSpecVersion
import Distribution.Utils.LogProgress
import Distribution.Utils.MapAccum
import Distribution.Utils.NubList
+import Distribution.Utils.Path hiding
+ ( (<.>)
+ , (</>)
+ )
import qualified Hackage.Security.Client as Sec
@@ -456,7 +462,7 @@ configureCompiler
, packageConfigProgramPathExtra
}
} = do
- let fileMonitorCompiler = newFileMonitor . distProjectCacheFile $ "compiler"
+ let fileMonitorCompiler = newFileMonitor $ distProjectCacheFile "compiler"
progsearchpath <- liftIO $ getSystemSearchPath
rerunIfChanged
@@ -946,6 +952,7 @@ getInstalledPackages verbosity compiler progdb platform packagedbs = do
( IndexUtils.getInstalledPackagesMonitorFiles
verbosity
compiler
+ Nothing -- use ambient working directory
packagedbs
progdb
platform
@@ -3649,8 +3656,8 @@ setupHsScriptOptions
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
- -> FilePath
- -> FilePath
+ -> SymbolicPath CWD (Dir Pkg)
+ -> SymbolicPath Pkg (Dir Dist)
-> Bool
-> Lock
-> SetupScriptOptions
@@ -3790,15 +3797,13 @@ setupHsConfigureFlags
:: ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> ElaboratedSharedConfig
- -> Verbosity
- -> FilePath
+ -> Cabal.CommonSetupFlags
-> Cabal.ConfigFlags
setupHsConfigureFlags
plan
(ReadyPackage elab@ElaboratedConfiguredPackage{..})
sharedConfig@ElaboratedSharedConfig{..}
- verbosity
- builddir =
+ configCommonFlags =
sanityCheckElaboratedConfiguredPackage
sharedConfig
elab
@@ -3829,11 +3834,6 @@ setupHsConfigureFlags
configProfExe = mempty
configProf = toFlag $ LBC.withProfExe elabBuildOptions
- configArgs = mempty -- unused, passed via args
- configDistPref = toFlag builddir
- configCabalFilePath = mempty
- configVerbosity = toFlag verbosity
-
configInstantiateWith = Map.toList elabInstantiatedWith
configDeterministic = mempty -- doesn't matter, configIPID/configCID overridese
@@ -3874,10 +3874,10 @@ setupHsConfigureFlags
configConfigurationsFlags = elabFlagAssignment
configConfigureArgs = elabConfigureScriptArgs
- configExtraLibDirs = elabExtraLibDirs
- configExtraLibDirsStatic = elabExtraLibDirsStatic
- configExtraFrameworkDirs = elabExtraFrameworkDirs
- configExtraIncludeDirs = elabExtraIncludeDirs
+ configExtraLibDirs = fmap makeSymbolicPath $ elabExtraLibDirs
+ configExtraLibDirsStatic = fmap makeSymbolicPath $ elabExtraLibDirsStatic
+ configExtraFrameworkDirs = fmap makeSymbolicPath $ elabExtraFrameworkDirs
+ configExtraIncludeDirs = fmap makeSymbolicPath $ elabExtraIncludeDirs
configProgPrefix = maybe mempty toFlag elabProgPrefix
configProgSuffix = maybe mempty toFlag elabProgSuffix
@@ -3953,27 +3953,37 @@ setupHsConfigureArgs elab@(ElaboratedConfiguredPackage{elabPkgOrComp = ElabCompo
(error "setupHsConfigureArgs: trying to configure setup")
(compComponentName comp)
+setupHsCommonFlags
+ :: Verbosity
+ -> Maybe (SymbolicPath CWD (Dir Pkg))
+ -> SymbolicPath Pkg (Dir Dist)
+ -> Cabal.CommonSetupFlags
+setupHsCommonFlags verbosity mbWorkDir builddir =
+ Cabal.CommonSetupFlags
+ { setupDistPref = toFlag builddir
+ , setupVerbosity = toFlag verbosity
+ , setupCabalFilePath = mempty
+ , setupWorkingDir = maybeToFlag mbWorkDir
+ , setupTargets = []
+ }
+
setupHsBuildFlags
:: Flag String
-> ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
- -> Verbosity
- -> FilePath
+ -> Cabal.CommonSetupFlags
-> Cabal.BuildFlags
-setupHsBuildFlags par_strat elab _ verbosity builddir =
+setupHsBuildFlags par_strat elab _ common =
Cabal.BuildFlags
- { buildProgramPaths = mempty -- unused, set at configure time
+ { buildCommonFlags = common
+ , buildProgramPaths = mempty -- unused, set at configure time
, buildProgramArgs = mempty -- unused, set at configure time
- , buildVerbosity = toFlag verbosity
- , buildDistPref = toFlag builddir
, buildNumJobs = mempty -- TODO: [nice to have] sometimes want to use toFlag (Just numBuildJobs),
, buildUseSemaphore =
if elabSetupScriptCliVersion elab >= mkVersion [3, 11, 0, 0]
then -- Cabal 3.11 is the first version that supports parallelism semaphores
par_strat
else mempty
- , buildArgs = mempty -- unused, passed via args not flags
- , buildCabalFilePath = mempty
}
setupHsBuildArgs :: ElaboratedConfiguredPackage -> [String]
@@ -3988,13 +3998,11 @@ setupHsBuildArgs (ElaboratedConfiguredPackage{elabPkgOrComp = ElabComponent _})
setupHsTestFlags
:: ElaboratedConfiguredPackage
- -> Verbosity
- -> FilePath
+ -> Cabal.CommonSetupFlags
-> Cabal.TestFlags
-setupHsTestFlags (ElaboratedConfiguredPackage{..}) verbosity builddir =
+setupHsTestFlags (ElaboratedConfiguredPackage{..}) common =
Cabal.TestFlags
- { testDistPref = toFlag builddir
- , testVerbosity = toFlag verbosity
+ { testCommonFlags = common
, testMachineLog = maybe mempty toFlag elabTestMachineLog
, testHumanLog = maybe mempty toFlag elabTestHumanLog
, testShowDetails = maybe (Flag Cabal.Always) toFlag elabTestShowDetails
@@ -4012,13 +4020,11 @@ setupHsTestArgs elab =
setupHsBenchFlags
:: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
- -> Verbosity
- -> FilePath
+ -> Cabal.CommonSetupFlags
-> Cabal.BenchmarkFlags
-setupHsBenchFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir =
+setupHsBenchFlags (ElaboratedConfiguredPackage{..}) _ common =
Cabal.BenchmarkFlags
- { benchmarkDistPref = toFlag builddir
- , benchmarkVerbosity = toFlag verbosity
+ { benchmarkCommonFlags = common
, benchmarkOptions = elabBenchmarkOptions
}
@@ -4029,15 +4035,13 @@ setupHsBenchArgs elab =
setupHsReplFlags
:: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
- -> Verbosity
- -> FilePath
+ -> Cabal.CommonSetupFlags
-> Cabal.ReplFlags
-setupHsReplFlags _ sharedConfig verbosity builddir =
+setupHsReplFlags _ sharedConfig common =
Cabal.ReplFlags
- { replProgramPaths = mempty -- unused, set at configure time
+ { replCommonFlags = common
+ , replProgramPaths = mempty -- unused, set at configure time
, replProgramArgs = mempty -- unused, set at configure time
- , replVerbosity = toFlag verbosity
- , replDistPref = toFlag builddir
, replReload = mempty -- only used as callback from repl
, replReplOptions = pkgConfigReplOptions sharedConfig -- runtime override for repl flags
}
@@ -4049,55 +4053,46 @@ setupHsReplArgs elab =
setupHsCopyFlags
:: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
- -> Verbosity
- -> FilePath
+ -> Cabal.CommonSetupFlags
-> FilePath
-> Cabal.CopyFlags
-setupHsCopyFlags _ _ verbosity builddir destdir =
+setupHsCopyFlags _ _ common destdir =
Cabal.CopyFlags
- { copyArgs = [] -- TODO: could use this to only copy what we enabled
+ { copyCommonFlags = common
, copyDest = toFlag (InstallDirs.CopyTo destdir)
- , copyDistPref = toFlag builddir
- , copyVerbosity = toFlag verbosity
- , copyCabalFilePath = mempty
}
setupHsRegisterFlags
:: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
- -> Verbosity
- -> FilePath
+ -> Cabal.CommonSetupFlags
-> FilePath
-> Cabal.RegisterFlags
setupHsRegisterFlags
ElaboratedConfiguredPackage{..}
_
- verbosity
- builddir
+ common
pkgConfFile =
Cabal.RegisterFlags
- { regPackageDB = mempty -- misfeature
+ { registerCommonFlags = common
+ , regPackageDB = mempty -- misfeature
, regGenScript = mempty -- never use
, regGenPkgConf = toFlag (Just pkgConfFile)
, regInPlace = case elabBuildStyle of
BuildInplaceOnly{} -> toFlag True
BuildAndInstall -> toFlag False
, regPrintId = mempty -- never use
- , regDistPref = toFlag builddir
- , regArgs = []
- , regVerbosity = toFlag verbosity
- , regCabalFilePath = mempty
}
setupHsHaddockFlags
:: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
- -> Verbosity
- -> FilePath
+ -> Cabal.CommonSetupFlags
-> Cabal.HaddockFlags
-setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) (ElaboratedSharedConfig{..}) verbosity builddir =
+setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) (ElaboratedSharedConfig{..}) common =
Cabal.HaddockFlags
- { haddockProgramPaths =
+ { haddockCommonFlags = common
+ , haddockProgramPaths =
case lookupProgram haddockProgram pkgConfigCompilerProgs of
Nothing -> mempty
Just prg ->
@@ -4121,15 +4116,11 @@ setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) (ElaboratedSharedConfig{..
, haddockQuickJump = toFlag elabHaddockQuickJump
, haddockHscolourCss = maybe mempty toFlag elabHaddockHscolourCss
, haddockContents = maybe mempty toFlag elabHaddockContents
- , haddockDistPref = toFlag builddir
, haddockKeepTempFiles = mempty -- TODO: from build settings
- , haddockVerbosity = toFlag verbosity
- , haddockCabalFilePath = mempty
, haddockIndex = maybe mempty toFlag elabHaddockIndex
, haddockBaseUrl = maybe mempty toFlag elabHaddockBaseUrl
, haddockLib = maybe mempty toFlag elabHaddockLib
, haddockOutputDir = maybe mempty toFlag elabHaddockOutputDir
- , haddockArgs = mempty
}
setupHsHaddockArgs :: ElaboratedConfiguredPackage -> [String]
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
index 178ffdcbc7..f344db1e38 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
@@ -86,6 +86,7 @@ import Distribution.Client.Types
import Distribution.Backpack
import Distribution.Backpack.ModuleShape
+import Distribution.Compat.Graph (IsNode (..))
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import Distribution.ModuleName (ModuleName)
import Distribution.Package
@@ -106,20 +107,19 @@ import Distribution.Simple.Setup
, ReplOptions
, TestShowDetails
)
+import Distribution.Simple.Utils (ordNub)
+import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
+import qualified Distribution.Solver.Types.ComponentDeps as CD
+import Distribution.Solver.Types.OptionalStanza
import Distribution.System
import Distribution.Types.ComponentRequestedSpec
import qualified Distribution.Types.LocalBuildConfig as LBC
import Distribution.Types.PackageDescription (PackageDescription (..))
import Distribution.Types.PkgconfigVersion
+import Distribution.Utils.Path (getSymbolicPath)
import Distribution.Verbosity (normal)
import Distribution.Version
-import Distribution.Compat.Graph (IsNode (..))
-import Distribution.Simple.Utils (ordNub)
-import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
-import qualified Distribution.Solver.Types.ComponentDeps as CD
-import Distribution.Solver.Types.OptionalStanza
-
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
@@ -457,9 +457,7 @@ dataDirEnvVarForPackage distDirLayout pkg =
BuildInplaceOnly{} ->
Just
( pkgPathEnvVar (elabPkgDescription pkg) "datadir"
- , Just $
- srcPath (elabPkgSourceLocation pkg)
- </> dataDir (elabPkgDescription pkg)
+ , Just dataDirPath
)
where
srcPath (LocalUnpackedPackage path) = path
@@ -473,6 +471,16 @@ dataDirEnvVarForPackage distDirLayout pkg =
"calling dataDirEnvVarForPackage on a not-downloaded repo is an error"
unpackedPath =
distUnpackedSrcDirectory distDirLayout $ elabPkgSourceId pkg
+ rawDataDir = getSymbolicPath $ dataDir (elabPkgDescription pkg)
+ pkgDir = srcPath (elabPkgSourceLocation pkg)
+ dataDirPath
+ | null rawDataDir =
+ pkgDir
+ | otherwise =
+ pkgDir </> rawDataDir
+
+-- NB: rawDataDir may be absolute, in which case
+-- (</>) drops its first argument.
instance Package ElaboratedConfiguredPackage where
packageId = elabPkgSourceId
diff --git a/cabal-install/src/Distribution/Client/RebuildMonad.hs b/cabal-install/src/Distribution/Client/RebuildMonad.hs
index 33303ea324..2950d9f7a3 100644
--- a/cabal-install/src/Distribution/Client/RebuildMonad.hs
+++ b/cabal-install/src/Distribution/Client/RebuildMonad.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
diff --git a/cabal-install/src/Distribution/Client/Reconfigure.hs b/cabal-install/src/Distribution/Client/Reconfigure.hs
index a5ba2a0853..6942875e99 100644
--- a/cabal-install/src/Distribution/Client/Reconfigure.hs
+++ b/cabal-install/src/Distribution/Client/Reconfigure.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+
module Distribution.Client.Reconfigure (Check (..), reconfigure) where
import Distribution.Client.Compat.Prelude
@@ -8,10 +10,11 @@ import System.Directory (doesFileExist)
import Distribution.Simple.Configure (localBuildInfoFile)
import Distribution.Simple.Setup (Flag, flagToMaybe, toFlag)
import Distribution.Simple.Utils
- ( defaultPackageDesc
+ ( defaultPackageDescCwd
, existsAndIsMoreRecentThan
, info
)
+import Distribution.Utils.Path
import Distribution.Client.Config (SavedConfig (..))
import Distribution.Client.Configure (readConfigFlags)
@@ -21,7 +24,8 @@ import Distribution.Client.Sandbox.PackageEnvironment
( userPackageEnvironmentFile
)
import Distribution.Client.Setup
- ( ConfigExFlags
+ ( CommonSetupFlags (..)
+ , ConfigExFlags
, ConfigFlags (..)
, GlobalFlags (..)
)
@@ -80,7 +84,7 @@ reconfigure
-- ^ configure action
-> Verbosity
-- ^ Verbosity setting
- -> FilePath
+ -> SymbolicPath Pkg (Dir Dist)
-- ^ \"dist\" prefix
-> Flag (Maybe Int)
-- ^ -j flag for reinstalling add-source deps.
@@ -104,7 +108,7 @@ reconfigure
globalFlags
config =
do
- savedFlags@(_, _) <- readConfigFlags dist
+ savedFlags@(_, _) <- readConfigFlags $ getSymbolicPath dist
useNix <- fmap isJust (findNixExpr globalFlags config)
alreadyInNixShell <- inNixShell
@@ -121,7 +125,7 @@ reconfigure
-- No, because 'nixShell' doesn't spawn a new process if it is already
-- running in a Nix shell.
- nixInstantiate verbosity dist False globalFlags config
+ nixInstantiate verbosity (getSymbolicPath dist) False globalFlags config
return config
else do
let checks :: Check (ConfigFlags, ConfigExFlags)
@@ -138,12 +142,18 @@ reconfigure
when frc $ configureAction flags extraArgs globalFlags
return config'
where
+ mbWorkDir = flagToMaybe $ configWorkingDir $ savedConfigureFlags config
-- Changing the verbosity does not require reconfiguration, but the new
-- verbosity should be used if reconfiguring.
checkVerb :: Check (ConfigFlags, b)
checkVerb = Check $ \_ (configFlags, configExFlags) -> do
- let configFlags' :: ConfigFlags
- configFlags' = configFlags{configVerbosity = toFlag verbosity}
+ let common = configCommonFlags configFlags
+ configFlags' :: ConfigFlags
+ configFlags' =
+ configFlags
+ { configCommonFlags =
+ common{setupVerbosity = toFlag verbosity}
+ }
return (mempty, (configFlags', configExFlags))
-- Reconfiguration is required if @--build-dir@ changes.
@@ -151,18 +161,25 @@ reconfigure
checkDist = Check $ \_ (configFlags, configExFlags) -> do
-- Always set the chosen @--build-dir@ before saving the flags,
-- or bad things could happen.
- savedDist <- findSavedDistPref config (configDistPref configFlags)
+ let common = configCommonFlags configFlags
+ savedDist <- findSavedDistPref config (setupDistPref common)
let distChanged :: Bool
distChanged = dist /= savedDist
when distChanged $ info verbosity "build directory changed"
let configFlags' :: ConfigFlags
- configFlags' = configFlags{configDistPref = toFlag dist}
+ configFlags' =
+ configFlags
+ { configCommonFlags =
+ common{setupDistPref = toFlag dist}
+ }
return (Any distChanged, (configFlags', configExFlags))
checkOutdated :: Check (ConfigFlags, b)
checkOutdated = Check $ \_ flags@(configFlags, _) -> do
- let buildConfig :: FilePath
- buildConfig = localBuildInfoFile dist
+ let common = configCommonFlags configFlags
+ buildConfig, userCabalConfig :: FilePath
+ buildConfig = interpretSymbolicPath mbWorkDir $ localBuildInfoFile dist
+ userCabalConfig = userPackageEnvironmentFile
-- Has the package ever been configured? If not, reconfiguration is
-- required.
@@ -173,7 +190,7 @@ reconfigure
-- to force reconfigure. Note that it's possible to use @cabal.config@
-- even without sandboxes.
userPackageEnvironmentFileModified <-
- existsAndIsMoreRecentThan userPackageEnvironmentFile buildConfig
+ existsAndIsMoreRecentThan userCabalConfig buildConfig
when userPackageEnvironmentFileModified $
info
verbosity
@@ -185,11 +202,12 @@ reconfigure
-- Is the configuration older than the package description?
descrFile <-
maybe
- (defaultPackageDesc verbosity)
+ (relativeSymbolicPath <$> defaultPackageDescCwd verbosity)
return
- (flagToMaybe (configCabalFilePath configFlags))
- outdated <- existsAndIsMoreRecentThan descrFile buildConfig
- when outdated $ info verbosity (descrFile ++ " was changed")
+ (flagToMaybe (setupCabalFilePath common))
+ let descrPath = interpretSymbolicPath mbWorkDir descrFile
+ outdated <- existsAndIsMoreRecentThan descrPath buildConfig
+ when outdated $ info verbosity (getSymbolicPath descrFile ++ " was changed")
let failed :: Any
failed =
diff --git a/cabal-install/src/Distribution/Client/Run.hs b/cabal-install/src/Distribution/Client/Run.hs
index 6784e3bfe1..108fedc935 100644
--- a/cabal-install/src/Distribution/Client/Run.hs
+++ b/cabal-install/src/Distribution/Client/Run.hs
@@ -1,4 +1,5 @@
-----------------------------------------------------------------------------
+{-# LANGUAGE DataKinds #-}
-----------------------------------------------------------------------------
@@ -34,12 +35,14 @@ import Distribution.Simple.LocalBuildInfo
, LocalBuildInfo (..)
, buildDir
, depLibraryPaths
+ , interpretSymbolicPathLBI
+ , mbWorkDirLBI
)
import Distribution.Simple.Utils
( addLibraryPath
, dieWithException
, notice
- , rawSystemExitWithEnv
+ , rawSystemExitWithEnvCwd
, warn
)
import Distribution.System (Platform (..))
@@ -49,8 +52,7 @@ import qualified Distribution.Simple.GHCJS as GHCJS
import Distribution.Client.Errors
import Distribution.Compat.Environment (getEnvironment)
-import System.Directory (getCurrentDirectory)
-import System.FilePath ((<.>), (</>))
+import Distribution.Utils.Path
-- | Return the executable to run and any extra arguments that should be
-- forwarded to it. Die in case of error.
@@ -133,12 +135,19 @@ splitRunArgs verbosity lbi args =
-- | Run a given executable.
run :: Verbosity -> LocalBuildInfo -> Executable -> [String] -> IO ()
run verbosity lbi exe exeArgs = do
- curDir <- getCurrentDirectory
let buildPref = buildDir lbi
pkg_descr = localPkgDescr lbi
+ i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
+ mbWorkDir = mbWorkDirLBI lbi
+ rawDataDir = dataDir pkg_descr
+ datDir
+ | null $ getSymbolicPath rawDataDir =
+ i sameDirectory
+ | otherwise =
+ i rawDataDir
dataDirEnvVar =
( pkgPathEnvVar pkg_descr "datadir"
- , curDir </> dataDir pkg_descr
+ , datDir
)
(path, runArgs) <-
@@ -148,13 +157,13 @@ run verbosity lbi exe exeArgs = do
let (script, cmd, cmdArgs) =
GHCJS.runCmd
(withPrograms lbi)
- (buildPref </> exeName' </> exeName')
+ (i buildPref </> exeName' </> exeName')
script' <- tryCanonicalizePath script
return (cmd, cmdArgs ++ [script'])
_ -> do
p <-
tryCanonicalizePath $
- buildPref </> exeName' </> (exeName' <.> exeExtension (hostPlatform lbi))
+ i buildPref </> exeName' </> (exeName' <.> exeExtension (hostPlatform lbi))
return (p, [])
env <- (dataDirEnvVar :) <$> getEnvironment
@@ -171,4 +180,4 @@ run verbosity lbi exe exeArgs = do
return (addLibraryPath os paths env)
else return env
notice verbosity $ "Running " ++ prettyShow (exeName exe) ++ "..."
- rawSystemExitWithEnv verbosity path (runArgs ++ exeArgs) env'
+ rawSystemExitWithEnvCwd verbosity mbWorkDir path (runArgs ++ exeArgs) env'
diff --git a/cabal-install/src/Distribution/Client/Sandbox.hs b/cabal-install/src/Distribution/Client/Sandbox.hs
index 82e7492a02..d4523d784c 100644
--- a/cabal-install/src/Distribution/Client/Sandbox.hs
+++ b/cabal-install/src/Distribution/Client/Sandbox.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
@@ -28,7 +29,8 @@ import Distribution.Client.Config
, loadConfig
)
import Distribution.Client.Setup
- ( ConfigFlags (..)
+ ( CommonSetupFlags (..)
+ , ConfigFlags (..)
, GlobalFlags (..)
, configCompilerAux'
)
@@ -56,8 +58,14 @@ import Distribution.Simple.Setup
, fromFlagOrDefault
)
import Distribution.System (Platform)
+import Distribution.Utils.Path hiding
+ ( (<.>)
+ , (</>)
+ )
-import System.Directory (getCurrentDirectory)
+import System.Directory
+ ( getCurrentDirectory
+ )
-- * Basic sandbox functions.
@@ -116,11 +124,11 @@ loadConfigOrSandboxConfig verbosity globalFlags = do
return config'
-- | Return the saved \"dist/\" prefix, or the default prefix.
-findSavedDistPref :: SavedConfig -> Flag FilePath -> IO FilePath
+findSavedDistPref :: SavedConfig -> Flag (SymbolicPath Pkg (Dir Dist)) -> IO (SymbolicPath Pkg (Dir Dist))
findSavedDistPref config flagDistPref = do
let defDistPref = useDistPref defaultSetupScriptOptions
flagDistPref' =
- configDistPref (savedConfigureFlags config)
+ (setupDistPref (configCommonFlags $ savedConfigureFlags config))
`mappend` flagDistPref
findDistPref defDistPref flagDistPref'
@@ -134,8 +142,9 @@ getPersistOrConfigCompiler
:: ConfigFlags
-> IO (Compiler, Platform, ProgramDb)
getPersistOrConfigCompiler configFlags = do
- distPref <- findDistPrefOrDefault (configDistPref configFlags)
- mlbi <- maybeGetPersistBuildConfig distPref
+ let common = configCommonFlags configFlags
+ distPref <- findDistPrefOrDefault (setupDistPref common)
+ mlbi <- maybeGetPersistBuildConfig (flagToMaybe $ setupWorkingDir common) distPref
case mlbi of
Nothing -> do configCompilerAux' configFlags
Just lbi ->
diff --git a/cabal-install/src/Distribution/Client/Sandbox/PackageEnvironment.hs b/cabal-install/src/Distribution/Client/Sandbox/PackageEnvironment.hs
index 3033356493..57e45ddb2b 100644
--- a/cabal-install/src/Distribution/Client/Sandbox/PackageEnvironment.hs
+++ b/cabal-install/src/Distribution/Client/Sandbox/PackageEnvironment.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs
index 1793f6aa07..20f644668e 100644
--- a/cabal-install/src/Distribution/Client/ScriptUtils.hs
+++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs
@@ -74,7 +74,8 @@ import Distribution.Client.RebuildMonad
( runRebuild
)
import Distribution.Client.Setup
- ( ConfigFlags (..)
+ ( CommonSetupFlags (..)
+ , ConfigFlags (..)
, GlobalFlags (..)
)
import Distribution.Client.TargetSelector
@@ -194,6 +195,9 @@ import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Lazy ()
import qualified Data.Set as S
import Distribution.Client.Errors
+import Distribution.Utils.Path
+ ( unsafeMakeSymbolicPath
+ )
import System.Directory
( canonicalizePath
, doesFileExist
@@ -202,6 +206,7 @@ import System.Directory
)
import System.FilePath
( makeRelative
+ , normalise
, takeDirectory
, takeFileName
, (</>)
@@ -323,7 +328,7 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings glo
act tc' ctx' sels
where
- verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
ignoreProject = flagIgnoreProject projectFlags
cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty
globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
@@ -373,7 +378,7 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings glo
build_dir = distBuildDirectory (distDirLayout ctx') $ (scriptDistDirParams script) ctx' compiler platform
exePath = build_dir </> "bin" </> scriptExeFileName script
- exePathRel = makeRelative projectRoot exePath
+ exePathRel = makeRelative (normalise projectRoot) exePath
executable' =
executable
@@ -393,7 +398,9 @@ withTemporaryTempDirectory act = newEmptyMVar >>= \m -> bracket (getMkTmp m) (rm
-- but still grantee that it's deleted if they do create it
-- 2) Because the path returned by createTempDirectory is not predicable
getMkTmp m = return $ do
- tmpDir <- getTemporaryDirectory >>= flip createTempDirectory "cabal-repl."
+ tmpBaseDir <- getTemporaryDirectory
+ tmpRelDir <- createTempDirectory tmpBaseDir "cabal-repl."
+ let tmpDir = tmpBaseDir </> tmpRelDir
putMVar m tmpDir
return tmpDir
rmTmp m _ = tryTakeMVar m >>= maybe (return ()) (handleDoesNotExist () . removeDirectoryRecursive)
@@ -449,12 +456,12 @@ updateContextAndWriteProjectFile' ctx srcPkg = do
else writePackageFile
return (ctx & lLocalPackages %~ (++ [SpecificSourcePackage srcPkg]))
--- | Add add the executable metadata to the context and write a .cabal file.
+-- | Add the executable metadata to the context and write a .cabal file.
updateContextAndWriteProjectFile :: ProjectBaseContext -> FilePath -> Executable -> IO ProjectBaseContext
updateContextAndWriteProjectFile ctx scriptPath scriptExecutable = do
let projectRoot = distProjectRootDirectory $ distDirLayout ctx
- absScript <- canonicalizePath scriptPath
+ absScript <- unsafeMakeSymbolicPath . makeRelative (normalise projectRoot) <$> canonicalizePath scriptPath
let
sourcePackage =
fakeProjectSourcePackage projectRoot
diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs
index 85f00dd960..95ac8dbfff 100644
--- a/cabal-install/src/Distribution/Client/Setup.hs
+++ b/cabal-install/src/Distribution/Client/Setup.hs
@@ -23,8 +23,10 @@ module Distribution.Client.Setup
, RepoContext (..)
, withRepoContext
, configureCommand
+ , CommonSetupFlags (..)
, ConfigFlags (..)
, configureOptions
+ , filterCommonFlags
, filterConfigureFlags
, configPackageDB'
, configCompilerAux'
@@ -189,6 +191,7 @@ import Distribution.Simple.Setup
, BooleanFlag (..)
, BuildFlags (..)
, CleanFlags (..)
+ , CommonSetupFlags (..)
, ConfigFlags (..)
, CopyFlags (..)
, HaddockFlags (..)
@@ -201,6 +204,7 @@ import Distribution.Simple.Setup
, optionVerbosity
, readPackageDbList
, showPackageDbList
+ , testCommonFlags
, trueArg
)
import qualified Distribution.Simple.Setup as Cabal
@@ -631,6 +635,34 @@ configureCommand =
configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags]
configureOptions = commandOptions configureCommand
+filterCommonFlags :: CommonSetupFlags -> Version -> CommonSetupFlags
+filterCommonFlags flags cabalLibVersion
+ -- NB: we expect the latest version to be the most common case,
+ -- so test it first.
+ | cabalLibVersion >= mkVersion [3, 11, 0] = flags_latest
+ | cabalLibVersion < mkVersion [1, 2, 5] = flags_1_2_5
+ | cabalLibVersion < mkVersion [2, 1, 0] = flags_2_1_0
+ | cabalLibVersion < mkVersion [3, 11, 0] = flags_3_11_0
+ | otherwise = error "the impossible just happened" -- see first guard
+ where
+ flags_latest = flags
+ flags_3_11_0 =
+ flags_latest
+ { setupWorkingDir = NoFlag
+ }
+ -- Cabal < 3.11 does not support the --working-dir flag.
+ flags_2_1_0 =
+ flags_3_11_0
+ { -- Cabal < 2.1 doesn't know about -v +timestamp modifier
+ setupVerbosity = fmap verboseNoTimestamp (setupVerbosity flags_3_11_0)
+ }
+ flags_1_2_5 =
+ flags_2_1_0
+ { -- Cabal < 1.25 doesn't have extended verbosity syntax
+ setupVerbosity =
+ fmap verboseNoFlags (setupVerbosity flags_2_1_0)
+ }
+
-- | Given some 'ConfigFlags' for the version of Cabal that
-- cabal-install was built with, and a target older 'Version' of
-- Cabal that we want to pass these flags to, convert the
@@ -640,7 +672,15 @@ configureOptions = commandOptions configureCommand
-- in some cases it may also mean "emulating" a feature using
-- some more legacy flags.
filterConfigureFlags :: ConfigFlags -> Version -> ConfigFlags
-filterConfigureFlags flags cabalLibVersion
+filterConfigureFlags flags cabalLibVersion =
+ let flags' = filterConfigureFlags' flags cabalLibVersion
+ in flags'
+ { configCommonFlags =
+ filterCommonFlags (configCommonFlags flags') cabalLibVersion
+ }
+
+filterConfigureFlags' :: ConfigFlags -> Version -> ConfigFlags
+filterConfigureFlags' flags cabalLibVersion
-- NB: we expect the latest version to be the most common case,
-- so test it first.
| cabalLibVersion >= mkVersion [3, 11, 0] = flags_latest
@@ -721,9 +761,7 @@ filterConfigureFlags flags cabalLibVersion
flags_2_1_0 =
flags_2_5_0
- { -- Cabal < 2.1 doesn't know about -v +timestamp modifier
- configVerbosity = fmap verboseNoTimestamp (configVerbosity flags_latest)
- , -- Cabal < 2.1 doesn't know about --<enable|disable>-static
+ { -- Cabal < 2.1 doesn't know about --<enable|disable>-static
configStaticLib = NoFlag
, configSplitSections = NoFlag
}
@@ -732,8 +770,6 @@ filterConfigureFlags flags cabalLibVersion
flags_2_1_0
{ -- Cabal < 1.25.0 doesn't know about --dynlibdir.
configInstallDirs = configInstallDirs_1_25_0
- , -- Cabal < 1.25 doesn't have extended verbosity syntax
- configVerbosity = fmap verboseNoFlags (configVerbosity flags_2_1_0)
, -- Cabal < 1.25 doesn't support --deterministic
configDeterministic = mempty
}
@@ -826,11 +862,15 @@ configPackageDB' cfg =
-- | Configure the compiler, but reduce verbosity during this step.
configCompilerAux' :: ConfigFlags -> IO (Compiler, Platform, ProgramDb)
-configCompilerAux' configFlags =
+configCompilerAux' configFlags = do
+ let commonFlags = configCommonFlags configFlags
configCompilerAuxEx
configFlags
{ -- FIXME: make configCompilerAux use a sensible verbosity
- configVerbosity = fmap lessVerbose (configVerbosity configFlags)
+ configCommonFlags =
+ commonFlags
+ { setupVerbosity = fmap lessVerbose (setupVerbosity commonFlags)
+ }
}
-- ------------------------------------------------------------
@@ -1101,7 +1141,15 @@ buildCommand =
-- in some cases it may also mean "emulating" a feature using
-- some more legacy flags.
filterTestFlags :: TestFlags -> Version -> TestFlags
-filterTestFlags flags cabalLibVersion
+filterTestFlags flags cabalLibVersion =
+ let flags' = filterTestFlags' flags cabalLibVersion
+ in flags'
+ { testCommonFlags =
+ filterCommonFlags (testCommonFlags flags') cabalLibVersion
+ }
+
+filterTestFlags' :: TestFlags -> Version -> TestFlags
+filterTestFlags' flags cabalLibVersion
-- NB: we expect the latest version to be the most common case,
-- so test it first.
| cabalLibVersion >= mkVersion [3, 0, 0] = flags_latest
@@ -2339,7 +2387,15 @@ filterHaddockArgs args cabalLibVersion
args_2_3_0 = []
filterHaddockFlags :: HaddockFlags -> Version -> HaddockFlags
-filterHaddockFlags flags cabalLibVersion
+filterHaddockFlags flags cabalLibVersion =
+ let flags' = filterHaddockFlags' flags cabalLibVersion
+ in flags'
+ { haddockCommonFlags =
+ filterCommonFlags (haddockCommonFlags flags') cabalLibVersion
+ }
+
+filterHaddockFlags' :: HaddockFlags -> Version -> HaddockFlags
+filterHaddockFlags' flags cabalLibVersion
| cabalLibVersion >= mkVersion [2, 3, 0] = flags_latest
| cabalLibVersion < mkVersion [2, 3, 0] = flags_2_3_0
| otherwise = flags_latest
@@ -2349,7 +2405,10 @@ filterHaddockFlags flags cabalLibVersion
flags_2_3_0 =
flags_latest
{ -- Cabal < 2.3 doesn't know about per-component haddock
- haddockArgs = []
+ haddockCommonFlags =
+ (haddockCommonFlags flags_latest)
+ { setupTargets = []
+ }
}
haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags]
diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs
index b3174c9675..f5432dad1c 100644
--- a/cabal-install/src/Distribution/Client/SetupWrapper.hs
+++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{- FOURMOLU_DISABLE -}
@@ -82,11 +83,11 @@ import Distribution.Simple.PreProcess
import Distribution.Simple.Program
( ProgramDb
, emptyProgramDb
- , getDbProgramOutput
+ , getDbProgramOutputCwd
, getProgramSearchPath
, ghcProgram
, ghcjsProgram
- , runDbProgram
+ , runDbProgramCwd
)
import Distribution.Simple.Program.Db
( prependProgramSearchPath
@@ -123,7 +124,6 @@ import Distribution.Client.JobControl
import Distribution.Client.Types
import Distribution.Client.Utils
( existsAndIsMoreRecentThan
- , inDir
#ifdef mingw32_HOST_OS
, canonicalizePathNoThrow
#endif
@@ -133,6 +133,9 @@ import Distribution.Client.Utils
, withEnvOverrides
, withExtraPathEnv
)
+import Distribution.Utils.Path
+ hiding ( (</>), (<.>) )
+import qualified Distribution.Utils.Path as Cabal.Path
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Simple.Command
( CommandUI (..)
@@ -146,7 +149,7 @@ import Distribution.Simple.Program.GHC
, renderGhcOptions
)
import Distribution.Simple.Setup
- ( Flag (..)
+ ( Flag (..), CommonSetupFlags (..), GlobalFlags (..)
)
import Distribution.Simple.Utils
( cabalVersion
@@ -176,6 +179,7 @@ import Distribution.Utils.NubList
import Distribution.Verbosity
import Data.List (foldl1')
+import Distribution.Simple.Setup (globalCommand)
import Distribution.Client.Compat.ExecutablePath (getExecutablePath)
import Distribution.Compat.Process (proc)
import System.Directory (doesFileExist)
@@ -253,9 +257,9 @@ data SetupScriptOptions = SetupScriptOptions
, usePackageDB :: PackageDBStack
, usePackageIndex :: Maybe InstalledPackageIndex
, useProgramDb :: ProgramDb
- , useDistPref :: FilePath
+ , useDistPref :: SymbolicPath Pkg (Dir Dist)
, useLoggingHandle :: Maybe Handle
- , useWorkingDir :: Maybe FilePath
+ , useWorkingDir :: Maybe (SymbolicPath CWD (Dir Pkg))
, useExtraPathEnv :: [FilePath]
-- ^ Extra things to add to PATH when invoking the setup script.
, useExtraEnvOverrides :: [(String, Maybe FilePath)]
@@ -339,10 +343,12 @@ defaultSetupScriptOptions =
}
workingDir :: SetupScriptOptions -> FilePath
-workingDir options =
- case fromMaybe "" (useWorkingDir options) of
- [] -> "."
- dir -> dir
+workingDir options = case useWorkingDir options of
+ Just dir
+ | let fp = getSymbolicPath dir
+ , not $ null fp
+ -> fp
+ _ -> "."
-- | A @SetupRunner@ implements a 'SetupMethod'.
type SetupRunner =
@@ -382,9 +388,10 @@ getSetup verbosity options mpkg = do
, setupPackage = pkg
}
where
+ mbWorkDir = useWorkingDir options
getPkg =
- tryFindPackageDesc verbosity (fromMaybe "." (useWorkingDir options))
- >>= readGenericPackageDescription verbosity
+ (relativeSymbolicPath <$> tryFindPackageDesc verbosity mbWorkDir)
+ >>= readGenericPackageDescription verbosity mbWorkDir
>>= return . packageDescription
-- | Decide if we're going to be able to do a direct internal call to the
@@ -476,14 +483,20 @@ runSetupCommand
-> Setup
-> CommandUI flags
-- ^ command definition
+ -> (flags -> CommonSetupFlags)
-> flags
-- ^ command flags
-> [String]
-- ^ extra command-line arguments
-> IO ()
-runSetupCommand verbosity setup cmd flags extraArgs = do
- let args = commandName cmd : commandShowOptions cmd flags ++ extraArgs
- runSetup verbosity setup args
+runSetupCommand verbosity setup cmd getCommonFlags flags extraArgs =
+ -- The 'setupWorkingDir' flag corresponds to a global argument which needs to
+ -- be passed before the individual command (e.g. 'configure' or 'build').
+ let common = getCommonFlags flags
+ globalFlags = mempty { globalWorkingDir = setupWorkingDir common }
+ args = commandShowOptions (globalCommand []) globalFlags
+ ++ (commandName cmd : commandShowOptions cmd flags ++ extraArgs)
+ in runSetup verbosity setup args
-- | Configure a 'Setup' and run a command in one step. The command flags
-- may depend on the Cabal library version in use.
@@ -492,18 +505,23 @@ setupWrapper
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
+ -> (flags -> CommonSetupFlags)
-> (Version -> flags)
-- ^ produce command flags given the Cabal library version
-> (Version -> [String])
-> IO ()
-setupWrapper verbosity options mpkg cmd flags extraArgs = do
+setupWrapper verbosity options mpkg cmd getCommonFlags getFlags getExtraArgs = do
setup <- getSetup verbosity options mpkg
+ let version = setupVersion setup
+ flags = getFlags version
+ extraArgs = getExtraArgs version
runSetupCommand
verbosity
setup
cmd
- (flags $ setupVersion setup)
- (extraArgs $ setupVersion setup)
+ getCommonFlags
+ flags
+ extraArgs
-- ------------------------------------------------------------
@@ -511,6 +529,7 @@ setupWrapper verbosity options mpkg cmd flags extraArgs = do
-- ------------------------------------------------------------
+-- | Run a Setup script by directly invoking the @Cabal@ library.
internalSetupMethod :: SetupRunner
internalSetupMethod verbosity options bt args = do
info verbosity $
@@ -518,11 +537,18 @@ internalSetupMethod verbosity options bt args = do
++ show bt
++ " and args:\n "
++ show args
- inDir (useWorkingDir options) $ do
- withEnv "HASKELL_DIST_DIR" (useDistPref options) $
- withExtraPathEnv (useExtraPathEnv options) $
- withEnvOverrides (useExtraEnvOverrides options) $
- buildTypeAction bt args
+ -- NB: we do not set the working directory of the process here, because
+ -- we will instead pass the -working-dir flag when invoking the Setup script.
+ -- Note that the Setup script is guaranteed to support this flag, because
+ -- the logic in 'getSetupMethod' guarantees we have an up-to-date Cabal version.
+ --
+ -- In the future, it would be desirable to also stop relying on the following
+ -- pieces of process-global state, as this would allow us to use this internal
+ -- setup method in concurrent contexts.
+ withEnv "HASKELL_DIST_DIR" (getSymbolicPath $ useDistPref options) $
+ withExtraPathEnv (useExtraPathEnv options) $
+ withEnvOverrides (useExtraEnvOverrides options) $
+ buildTypeAction bt args
buildTypeAction :: BuildType -> ([String] -> IO ())
buildTypeAction Simple = Simple.defaultMainArgs
@@ -547,7 +573,7 @@ invoke verbosity path args options = do
env <-
getEffectiveEnvironment $
[ ("PATH", Just searchpath)
- , ("HASKELL_DIST_DIR", Just (useDistPref options))
+ , ("HASKELL_DIST_DIR", Just (getSymbolicPath $ useDistPref options))
]
++ useExtraEnvOverrides options
@@ -556,7 +582,7 @@ invoke verbosity path args options = do
Just hdl -> UseHandle hdl
cp =
(proc path args)
- { Process.cwd = useWorkingDir options
+ { Process.cwd = fmap getSymbolicPath $ useWorkingDir options
, Process.env = env
, Process.std_out = loggingHandle
, Process.std_err = loggingHandle
@@ -642,7 +668,7 @@ getExternalSetupMethod verbosity options pkg bt = do
debug verbosity $
"Using explicit dependencies: "
++ show (useDependenciesExclusive options)
- createDirectoryIfMissingVerbose verbosity True setupDir
+ createDirectoryIfMissingVerbose verbosity True $ i setupDir
(cabalLibVersion, mCabalLibInstalledPkgId, options') <- cabalLibVersionToUse
debug verbosity $ "Using Cabal library version " ++ prettyShow cabalLibVersion
path <-
@@ -668,7 +694,7 @@ getExternalSetupMethod verbosity options pkg bt = do
-- See 'Note: win32 clean hack' above.
#ifdef mingw32_HOST_OS
-- setupProgFile may not exist if we're using a cached program
- setupProgFile' <- canonicalizePathNoThrow setupProgFile
+ setupProgFile' <- canonicalizePathNoThrow $ i setupProgFile
let win32CleanHackNeeded =
(useWin32CleanHack options)
-- Skip when a cached setup script is used.
@@ -680,13 +706,18 @@ getExternalSetupMethod verbosity options pkg bt = do
return (cabalLibVersion, ExternalMethod path', options'')
where
- setupDir = workingDir options </> useDistPref options </> "setup"
- setupVersionFile = setupDir </> "setup" <.> "version"
- setupHs = setupDir </> "setup" <.> "hs"
- setupProgFile = setupDir </> "setup" <.> exeExtension buildPlatform
+ mbWorkDir = useWorkingDir options
+ -- See Note [Symbolic paths] in Distribution.Utils.Path
+ i = interpretSymbolicPath mbWorkDir
+ setupDir = useDistPref options Cabal.Path.</> makeRelativePathEx "setup"
+ setupVersionFile = setupDir Cabal.Path.</> makeRelativePathEx ("setup" <.> "version")
+ setupHs = setupDir Cabal.Path.</> makeRelativePathEx ("setup" <.> "hs")
+ setupProgFile = setupDir Cabal.Path.</> makeRelativePathEx ("setup" <.> exeExtension buildPlatform)
+
platform = fromMaybe buildPlatform (usePlatform options)
- useCachedSetupExecutable = (bt == Simple || bt == Configure || bt == Make)
+ useCachedSetupExecutable =
+ bt == Simple || bt == Configure || bt == Make
maybeGetInstalledPackages
:: SetupScriptOptions
@@ -760,12 +791,12 @@ getExternalSetupMethod verbosity options pkg bt = do
doesFileExist cachedSetupProgFile
else
(&&)
- <$> setupProgFile `existsAndIsMoreRecentThan` setupHs
- <*> setupProgFile `existsAndIsMoreRecentThan` setupVersionFile
+ <$> i setupProgFile `existsAndIsMoreRecentThan` i setupHs
+ <*> i setupProgFile `existsAndIsMoreRecentThan` i setupVersionFile
writeSetupVersionFile :: Version -> IO ()
writeSetupVersionFile version =
- writeFile setupVersionFile (show version ++ "\n")
+ writeFile (i setupVersionFile) (show version ++ "\n")
installedVersion
:: IO
@@ -786,7 +817,7 @@ getExternalSetupMethod verbosity options pkg bt = do
savedVersion :: IO (Maybe Version)
savedVersion = do
- versionString <- readFile setupVersionFile `catchIO` \_ -> return ""
+ versionString <- readFile (i setupVersionFile) `catchIO` \_ -> return ""
case reads versionString of
[(version, s)] | all isSpace s -> return (Just version)
_ -> return Nothing
@@ -799,16 +830,16 @@ getExternalSetupMethod verbosity options pkg bt = do
unless (useHs || useLhs) $
dieWithException verbosity UpdateSetupScript
let src = (if useHs then customSetupHs else customSetupLhs)
- srcNewer <- src `moreRecentFile` setupHs
+ srcNewer <- src `moreRecentFile` i setupHs
when srcNewer $
if useHs
- then copyFileVerbose verbosity src setupHs
- else runSimplePreProcessor ppUnlit src setupHs verbosity
+ then copyFileVerbose verbosity src (i setupHs)
+ else runSimplePreProcessor ppUnlit src (i setupHs) verbosity
where
customSetupHs = workingDir options </> "Setup.hs"
customSetupLhs = workingDir options </> "Setup.lhs"
updateSetupScript cabalLibVersion _ =
- rewriteFileLBS verbosity setupHs (buildTypeScript cabalLibVersion)
+ rewriteFileLBS verbosity (i setupHs) (buildTypeScript cabalLibVersion)
buildTypeScript :: Version -> BS.ByteString
buildTypeScript cabalLibVersion = case bt of
@@ -1001,8 +1032,8 @@ getExternalSetupMethod verbosity options pkg bt = do
cabalLibVersion
maybeCabalLibInstalledPkgId
forceCompile = do
- setupHsNewer <- setupHs `moreRecentFile` setupProgFile
- cabalVersionNewer <- setupVersionFile `moreRecentFile` setupProgFile
+ setupHsNewer <- i setupHs `moreRecentFile` i setupProgFile
+ cabalVersionNewer <- i setupVersionFile `moreRecentFile` i setupProgFile
let outOfDate = setupHsNewer || cabalVersionNewer
when (outOfDate || forceCompile) $ do
debug verbosity "Setup executable needs to be updated, compiling..."
@@ -1043,7 +1074,7 @@ getExternalSetupMethod verbosity options pkg bt = do
( Backpack.DefiniteUnitId (unsafeMkDefUnitId (newSimpleUnitId ipid))
, defaultRenaming
)
- cppMacrosFile = setupDir </> "setup_macros.h"
+ cppMacrosFile = setupDir Cabal.Path.</> makeRelativePathEx "setup_macros.h"
ghcOptions =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
@@ -1052,12 +1083,12 @@ getExternalSetupMethod verbosity options pkg bt = do
ghcOptVerbosity = Flag (min verbosity normal)
, ghcOptMode = Flag GhcModeMake
, ghcOptInputFiles = toNubListR [setupHs]
- , ghcOptOutputFile = Flag setupProgFile
- , ghcOptObjDir = Flag setupDir
- , ghcOptHiDir = Flag setupDir
+ , ghcOptOutputFile = Flag $ setupProgFile
+ , ghcOptObjDir = Flag $ setupDir
+ , ghcOptHiDir = Flag $ setupDir
, ghcOptSourcePathClear = Flag True
, ghcOptSourcePath = case bt of
- Custom -> toNubListR [workingDir options']
+ Custom -> toNubListR [sameDirectory]
_ -> mempty
, ghcOptPackageDBs = usePackageDB options''
, ghcOptHideAllPackages = Flag (useDependenciesExclusive options')
@@ -1072,21 +1103,22 @@ getExternalSetupMethod verbosity options pkg bt = do
}
let ghcCmdLine = renderGhcOptions compiler platform ghcOptions
when (useVersionMacros options') $
- rewriteFileEx verbosity cppMacrosFile $
+ rewriteFileEx verbosity (i cppMacrosFile) $
generatePackageVersionMacros (pkgVersion $ package pkg) (map snd selectedDeps)
case useLoggingHandle options of
- Nothing -> runDbProgram verbosity program progdb ghcCmdLine
+ Nothing -> runDbProgramCwd verbosity mbWorkDir program progdb ghcCmdLine
-- If build logging is enabled, redirect compiler output to
-- the log file.
- (Just logHandle) -> do
+ Just logHandle -> do
output <-
- getDbProgramOutput
+ getDbProgramOutputCwd
verbosity
+ mbWorkDir
program
progdb
ghcCmdLine
hPutStr logHandle output
- return setupProgFile
+ return $ i setupProgFile
isCabalPkgId :: PackageIdentifier -> Bool
isCabalPkgId (PackageIdentifier pname _) = pname == mkPackageName "Cabal"
diff --git a/cabal-install/src/Distribution/Client/SourceFiles.hs b/cabal-install/src/Distribution/Client/SourceFiles.hs
index f8fdcdcc9f..1166f333f3 100644
--- a/cabal-install/src/Distribution/Client/SourceFiles.hs
+++ b/cabal-install/src/Distribution/Client/SourceFiles.hs
@@ -103,7 +103,7 @@ needForeignLib
}
) =
do
- traverse_ needIfExists fs
+ traverse_ (needIfExists . getSymbolicPath) fs
needBuildInfo pkg_descr bi []
needExecutable :: PackageDescription -> Executable -> Rebuild ()
@@ -116,14 +116,14 @@ needExecutable
) =
do
needBuildInfo pkg_descr bi []
- needMainFile bi mainPath
+ needMainFile bi $ getSymbolicPath mainPath
needTestSuite :: PackageDescription -> TestSuite -> Rebuild ()
needTestSuite pkg_descr t =
case testInterface t of
TestSuiteExeV10 _ mainPath -> do
needBuildInfo pkg_descr bi []
- needMainFile bi mainPath
+ needMainFile bi $ getSymbolicPath mainPath
TestSuiteLibV09 _ m ->
needBuildInfo pkg_descr bi [m]
TestSuiteUnsupported _ -> return () -- soft fail
@@ -157,7 +157,7 @@ needBenchmark pkg_descr bm =
case benchmarkInterface bm of
BenchmarkExeV10 _ mainPath -> do
needBuildInfo pkg_descr bi []
- needMainFile bi mainPath
+ needMainFile bi $ getSymbolicPath mainPath
BenchmarkUnsupported _ -> return () -- soft fail
where
bi :: BuildInfo
@@ -170,18 +170,21 @@ needBuildInfo pkg_descr bi modules = do
findNeededModules builtinHaskellSuffixes
findNeededModules builtinHaskellBootSuffixes
root <- askRoot
- expandedExtraSrcFiles <- liftIO $ fmap concat . for (extraSrcFiles pkg_descr) $ \fpath -> matchDirFileGlobWithDie normal (\_ _ -> return []) (specVersion pkg_descr) root fpath
+ expandedExtraSrcFiles <- liftIO $
+ fmap concat . for (extraSrcFiles pkg_descr) $
+ \fpath ->
+ matchDirFileGlobWithDie normal (\_ _ -> return []) (specVersion pkg_descr) (Just $ makeSymbolicPath root) fpath
traverse_ needIfExists $
concat
- [ cSources bi
- , cxxSources bi
- , jsSources bi
- , cmmSources bi
- , asmSources bi
- , expandedExtraSrcFiles
+ [ map getSymbolicPath $ cSources bi
+ , map getSymbolicPath $ cxxSources bi
+ , map getSymbolicPath $ jsSources bi
+ , map getSymbolicPath $ cmmSources bi
+ , map getSymbolicPath $ asmSources bi
+ , map getSymbolicPath $ expandedExtraSrcFiles
]
- for_ (installIncludes bi) $ \f ->
- findFileMonitored ("." : includeDirs bi) f
+ for_ (fmap getSymbolicPath $ installIncludes bi) $ \f ->
+ findFileMonitored ("." : fmap getSymbolicPath (includeDirs bi)) f
>>= maybe (return ()) need
where
findNeededModules :: [Suffix] -> Rebuild ()
diff --git a/cabal-install/src/Distribution/Client/SrcDist.hs b/cabal-install/src/Distribution/Client/SrcDist.hs
index eb0d6230d1..46d826cad1 100644
--- a/cabal-install/src/Distribution/Client/SrcDist.hs
+++ b/cabal-install/src/Distribution/Client/SrcDist.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
-- | Utilities to implement cabal @v2-sdist@.
module Distribution.Client.SrcDist
@@ -12,16 +13,19 @@ import Prelude ()
import Control.Monad.State.Lazy (StateT, evalStateT, gets, modify)
import Control.Monad.Trans (liftIO)
import Control.Monad.Writer.Lazy (WriterT, execWriterT, tell)
-import System.FilePath (normalise, takeDirectory, (</>))
-import Distribution.Client.Utils (tryFindAddSourcePackageDesc)
+import Distribution.Client.Errors
+import Distribution.Client.Utils (tryReadAddSourcePackageDesc)
import Distribution.Package (Package (packageId))
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
-import Distribution.Simple.PackageDescription (readGenericPackageDescription)
import Distribution.Simple.PreProcess (knownSuffixHandlers)
import Distribution.Simple.SrcDist (listPackageSourcesWithDie)
import Distribution.Simple.Utils (dieWithException)
import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
+import Distribution.Utils.Path
+ ( getSymbolicPath
+ , makeSymbolicPath
+ )
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
@@ -29,7 +33,8 @@ import qualified Codec.Compression.GZip as GZip
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Set as Set
-import Distribution.Client.Errors
+import System.Directory (canonicalizePath)
+import System.FilePath
-- | List all source files of a given add-source dependency. Exits with error if
-- something is wrong (e.g. there is no .cabal file in the given directory).
@@ -38,12 +43,17 @@ import Distribution.Client.Errors
-- TODO: when sandboxes are removed, move to ProjectBuilding.
allPackageSourceFiles :: Verbosity -> FilePath -> IO [FilePath]
allPackageSourceFiles verbosity packageDir = do
- pd <- do
- let err = "Error reading source files of package."
- desc <- tryFindAddSourcePackageDesc verbosity packageDir err
- flattenPackageDescription `fmap` readGenericPackageDescription verbosity desc
-
- listPackageSourcesWithDie verbosity (\_ _ -> return []) packageDir pd knownSuffixHandlers
+ let err = "Error reading source files of package."
+ gpd <- tryReadAddSourcePackageDesc verbosity packageDir err
+ let pd = flattenPackageDescription gpd
+ srcs <-
+ listPackageSourcesWithDie
+ verbosity
+ (\_ _ -> return [])
+ (Just $ makeSymbolicPath packageDir)
+ pd
+ knownSuffixHandlers
+ return $ map getSymbolicPath srcs
-- | Create a tarball for a package in a directory
packageDirToSdist
@@ -57,10 +67,10 @@ packageDirToSdist
packageDirToSdist verbosity gpd dir = do
-- let thisDie :: Verbosity -> String -> IO a
-- thisDie v s = die' v $ "sdist of " <> prettyShow (packageId gpd) ++ ": " ++ s
-
- files' <- listPackageSourcesWithDie verbosity dieWithException dir (flattenPackageDescription gpd) knownSuffixHandlers
+ absDir <- canonicalizePath dir
+ files' <- listPackageSourcesWithDie verbosity dieWithException (Just $ makeSymbolicPath absDir) (flattenPackageDescription gpd) knownSuffixHandlers
let files :: [FilePath]
- files = nub $ sort $ map normalise files'
+ files = nub $ sort $ map (normalise . getSymbolicPath) files'
let entriesM :: StateT (Set.Set FilePath) (WriterT [Tar.Entry] IO) ()
entriesM = do
diff --git a/cabal-install/src/Distribution/Client/Store.hs b/cabal-install/src/Distribution/Client/Store.hs
index 4e7d97d97c..a8358ec2f1 100644
--- a/cabal-install/src/Distribution/Client/Store.hs
+++ b/cabal-install/src/Distribution/Client/Store.hs
@@ -217,7 +217,7 @@ newStoreEntry
-- Atomically rename the temp dir to the final store entry location.
renameDirectory incomingEntryDir finalEntryDir
for_ otherFiles $ \file -> do
- let finalStoreFile = storeDirectory compiler </> makeRelative (incomingTmpDir </> (dropDrive (storeDirectory compiler))) file
+ let finalStoreFile = storeDirectory compiler </> makeRelative (normalise $ incomingTmpDir </> (dropDrive (storeDirectory compiler))) file
createDirectoryIfMissing True (takeDirectory finalStoreFile)
renameFile file finalStoreFile
diff --git a/cabal-install/src/Distribution/Client/TargetSelector.hs b/cabal-install/src/Distribution/Client/TargetSelector.hs
index d29413642d..856168103d 100644
--- a/cabal-install/src/Distribution/Client/TargetSelector.hs
+++ b/cabal-install/src/Distribution/Client/TargetSelector.hs
@@ -126,6 +126,8 @@ import Distribution.Simple.Utils
, ordNub
)
import Distribution.Utils.Path
+ ( getSymbolicPath
+ )
import qualified System.Directory as IO
( canonicalizePath
, doesDirectoryExist
@@ -133,18 +135,18 @@ import qualified System.Directory as IO
, getCurrentDirectory
)
import System.FilePath
- ( dropTrailingPathSeparator
- , equalFilePath
- , normalise
- , (<.>)
- , (</>)
- )
-import System.FilePath as FilePath
( dropExtension
+ , dropTrailingPathSeparator
+ , equalFilePath
, joinPath
+ , normalise
, splitDirectories
- , splitPath
+ )
+import qualified System.FilePath as FilePath
+ ( splitPath
, takeExtension
+ , (<.>)
+ , (</>)
)
import Text.EditDistance
( defaultEditCosts
@@ -468,7 +470,7 @@ getTargetStringFileStatus DirActions{..} t =
fileStatus f = do
fexists <- doesFileExist f
dexists <- doesDirectoryExist f
- case splitPath f of
+ case FilePath.splitPath f of
_
| fexists -> FileStatusExistsFile <$> canonicalizePath f
| dexists -> FileStatusExistsDir <$> canonicalizePath f
@@ -916,7 +918,7 @@ matchTargetSelector knowntargets = \usertarget ->
let ql = targetQualLevel usertarget
in foldSyntax
(<|>)
- (<//>)
+ (</>)
(\ql' match _ -> guard (ql == ql') >> match usertarget)
syntax
where
@@ -1885,8 +1887,8 @@ collectKnownPackageInfo
dirabs <- canonicalizePath dir
dirrel <- makeRelativeToCwd dirActions dirabs
-- TODO: ought to get this earlier in project reading
- let fileabs = dirabs </> prettyShow (packageName pkg) <.> "cabal"
- filerel = dirrel </> prettyShow (packageName pkg) <.> "cabal"
+ let fileabs = dirabs FilePath.</> prettyShow (packageName pkg) FilePath.<.> "cabal"
+ filerel = dirrel FilePath.</> prettyShow (packageName pkg) FilePath.<.> "cabal"
exists <- doesFileExist fileabs
return
( Just (dirabs, dirrel)
@@ -1913,8 +1915,8 @@ collectKnownComponentInfo pkg =
, cinfoSrcDirs = ordNub (map getSymbolicPath (hsSourceDirs bi))
, cinfoModules = ordNub (componentModules c)
, cinfoHsFiles = ordNub (componentHsFiles c)
- , cinfoCFiles = ordNub (cSources bi)
- , cinfoJsFiles = ordNub (jsSources bi)
+ , cinfoCFiles = ordNub (map getSymbolicPath $ cSources bi)
+ , cinfoJsFiles = ordNub (map getSymbolicPath $ jsSources bi)
}
| c <- pkgComponents pkg
, let bi = componentBuildInfo c
@@ -1938,19 +1940,19 @@ componentModules (CTest test) = testModules test
componentModules (CBench bench) = benchmarkModules bench
componentHsFiles :: Component -> [FilePath]
-componentHsFiles (CExe exe) = [modulePath exe]
+componentHsFiles (CExe exe) = [getSymbolicPath $ modulePath exe]
componentHsFiles
( CTest
TestSuite
{ testInterface = TestSuiteExeV10 _ mainfile
}
- ) = [mainfile]
+ ) = [getSymbolicPath mainfile]
componentHsFiles
( CBench
Benchmark
{ benchmarkInterface = BenchmarkExeV10 _ mainfile
}
- ) = [mainfile]
+ ) = [getSymbolicPath mainfile]
componentHsFiles _ = []
------------------------------
@@ -2075,7 +2077,7 @@ guardPackageDir str _ = matchErrorExpected "package directory" str
guardPackageFile :: String -> FileStatus -> Match ()
guardPackageFile _ (FileStatusExistsFile file)
- | takeExtension file == ".cabal" =
+ | FilePath.takeExtension file == ".cabal" =
increaseConfidence
guardPackageFile str _ = matchErrorExpected "package .cabal file" str
@@ -2083,10 +2085,10 @@ matchPackage :: [KnownPackage] -> String -> FileStatus -> Match KnownPackage
matchPackage pinfo = \str fstatus ->
orNoThingIn "project" "" $
matchPackageName pinfo str
- <//> ( matchPackageNameUnknown str
+ </> ( matchPackageNameUnknown str
<|> matchPackageDir pinfo str fstatus
<|> matchPackageFile pinfo str fstatus
- )
+ )
matchPackageName :: [KnownPackage] -> String -> Match KnownPackage
matchPackageName ps = \str -> do
@@ -2252,7 +2254,7 @@ matchComponentOtherFile
-> Match (FilePath, KnownComponent)
matchComponentOtherFile cs =
matchFile
- [ (normalise (srcdir </> file), c)
+ [ (normalise (srcdir FilePath.</> file), c)
| c <- cs
, srcdir <- cinfoSrcDirs c
, file <-
@@ -2268,7 +2270,7 @@ matchComponentModuleFile
-> Match (FilePath, KnownComponent)
matchComponentModuleFile cs str = do
matchFile
- [ (normalise (d </> toFilePath m), c)
+ [ (normalise (d FilePath.</> toFilePath m), c)
| c <- cs
, d <- cinfoSrcDirs c
, m <- cinfoModules c
@@ -2382,10 +2384,10 @@ instance MonadPlus Match where
mzero = empty
mplus = matchPlus
-(<//>) :: Match a -> Match a -> Match a
-(<//>) = matchPlusShadowing
+(</>) :: Match a -> Match a -> Match a
+(</>) = matchPlusShadowing
-infixl 3 <//>
+infixl 3 </>
-- | Combine two matchers. Exact matches are used over inexact matches
-- but if we have multiple exact, or inexact then the we collect all the
diff --git a/cabal-install/src/Distribution/Client/Targets.hs b/cabal-install/src/Distribution/Client/Targets.hs
index ea8cb85cbb..1a37c9c73b 100644
--- a/cabal-install/src/Distribution/Client/Targets.hs
+++ b/cabal-install/src/Distribution/Client/Targets.hs
@@ -78,7 +78,7 @@ import Distribution.Client.GlobalFlags
( RepoContext (..)
)
import qualified Distribution.Client.Tar as Tar
-import Distribution.Client.Utils (tryFindPackageDesc)
+import Distribution.Client.Utils (tryReadGenericPackageDesc)
import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint (..)
)
@@ -100,15 +100,13 @@ import Distribution.Version
import Distribution.PackageDescription.Parsec
( parseGenericPackageDescriptionMaybe
)
-import Distribution.Simple.PackageDescription
- ( readGenericPackageDescription
- )
import qualified Data.ByteString.Lazy as BS
import qualified Data.Map as Map
import Distribution.Client.Errors
import qualified Distribution.Client.GZipUtils as GZipUtils
import qualified Distribution.Compat.CharParsing as P
+import Distribution.Utils.Path (makeSymbolicPath)
import Network.URI
( URI (..)
, URIAuth (..)
@@ -350,7 +348,7 @@ expandUserTarget verbosity userTarget = case userTarget of
return [PackageTargetLocation (LocalUnpackedPackage dir)]
UserTargetLocalCabalFile file -> do
let dir = takeDirectory file
- _ <- tryFindPackageDesc verbosity dir (localPackageError dir) -- just as a check
+ _ <- tryReadGenericPackageDesc verbosity (makeSymbolicPath dir) (localPackageError dir) -- just as a check
return [PackageTargetLocation (LocalUnpackedPackage dir)]
UserTargetLocalTarball tarballFile ->
return [PackageTargetLocation (LocalTarballPackage tarballFile)]
@@ -389,9 +387,7 @@ readPackageTarget verbosity = traverse modifyLocation
modifyLocation :: ResolvedPkgLoc -> IO UnresolvedSourcePackage
modifyLocation location = case location of
LocalUnpackedPackage dir -> do
- pkg <-
- tryFindPackageDesc verbosity dir (localPackageError dir)
- >>= readGenericPackageDescription verbosity
+ pkg <- tryReadGenericPackageDesc verbosity (makeSymbolicPath dir) (localPackageError dir)
return
SourcePackage
{ srcpkgPackageId = packageId pkg
diff --git a/cabal-install/src/Distribution/Client/Utils.hs b/cabal-install/src/Distribution/Client/Utils.hs
index f5a10da789..87378da7f1 100644
--- a/cabal-install/src/Distribution/Client/Utils.hs
+++ b/cabal-install/src/Distribution/Client/Utils.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Client.Utils
@@ -7,7 +8,6 @@ module Distribution.Client.Utils
, duplicates
, duplicatesBy
, readMaybe
- , inDir
, withEnv
, withEnvOverrides
, logDirChange
@@ -26,8 +26,8 @@ module Distribution.Client.Utils
, canonicalizePathNoThrow
, moreRecentFile
, existsAndIsMoreRecentThan
- , tryFindAddSourcePackageDesc
- , tryFindPackageDesc
+ , tryReadAddSourcePackageDesc
+ , tryReadGenericPackageDesc
, relaxEncodingErrors
, ProgressPhase (..)
, progressMessage
@@ -64,20 +64,30 @@ import Data.List
( elemIndex
, groupBy
)
+import Distribution.Client.Errors
import Distribution.Compat.Environment
import Distribution.Compat.Time (getModTime)
import Distribution.Simple.Setup (Flag (..))
import Distribution.Simple.Utils (dieWithException, findPackageDesc, noticeNoWrap)
+import Distribution.Utils.Path
+ ( CWD
+ , FileOrDir (..)
+ , Pkg
+ , RelativePath
+ , SymbolicPath
+ , makeSymbolicPath
+ , relativeSymbolicPath
+ )
import Distribution.Version
+
import System.Directory
( canonicalizePath
, doesDirectoryExist
, doesFileExist
- , getCurrentDirectory
, getDirectoryContents
, removeFile
- , setCurrentDirectory
)
+import qualified System.Directory as Directory
import System.FilePath
import System.IO
( Handle
@@ -106,7 +116,8 @@ import qualified System.Directory as Dir
import qualified System.IO.Error as IOError
#endif
import qualified Data.Set as Set
-import Distribution.Client.Errors
+import Distribution.Simple.PackageDescription (readGenericPackageDescription)
+import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
-- | Generic merging utility. For sorted input lists this is a full outer join.
mergeBy :: forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
@@ -158,17 +169,6 @@ withTempFileName tmpDir template action =
(\(name, _) -> removeExistingFile name)
(\(name, h) -> hClose h >> action name)
--- | Executes the action in the specified directory.
---
--- Warning: This operation is NOT thread-safe, because current
--- working directory is a process-global concept.
-inDir :: Maybe FilePath -> IO a -> IO a
-inDir Nothing m = m
-inDir (Just d) m = do
- old <- getCurrentDirectory
- setCurrentDirectory d
- m `Exception.finally` setCurrentDirectory old
-
-- | Executes the action with an environment variable set to some
-- value.
--
@@ -248,14 +248,14 @@ makeAbsoluteToCwd :: FilePath -> IO FilePath
makeAbsoluteToCwd path
| isAbsolute path = return path
| otherwise = do
- cwd <- getCurrentDirectory
+ cwd <- Directory.getCurrentDirectory
return $! cwd </> path
-- | Given a path (relative or absolute), make it relative to the current
-- directory, including using @../..@ if necessary.
makeRelativeToCwd :: FilePath -> IO FilePath
makeRelativeToCwd path =
- makeRelativeCanonical <$> canonicalizePath path <*> getCurrentDirectory
+ makeRelativeCanonical <$> canonicalizePath path <*> Directory.getCurrentDirectory
-- | Given a path (relative or absolute), make it relative to the given
-- directory, including using @../..@ if necessary.
@@ -376,20 +376,41 @@ relaxEncodingErrors handle = do
return ()
-- | Like 'tryFindPackageDesc', but with error specific to add-source deps.
-tryFindAddSourcePackageDesc :: Verbosity -> FilePath -> String -> IO FilePath
-tryFindAddSourcePackageDesc verbosity depPath err =
- tryFindPackageDesc verbosity depPath $
- err
- ++ "\n"
- ++ "Failed to read cabal file of add-source dependency: "
- ++ depPath
-
--- | Try to find a @.cabal@ file, in directory @depPath@. Fails if one cannot be
+tryReadAddSourcePackageDesc
+ :: Verbosity
+ -> FilePath
+ -> String
+ -> IO GenericPackageDescription
+tryReadAddSourcePackageDesc verbosity depPath err = do
+ let pkgDir = makeSymbolicPath depPath
+ pkgDescPath <-
+ try_find_package_desc verbosity pkgDir $
+ err
+ ++ "\n"
+ ++ "Failed to read cabal file of add-source dependency: "
+ ++ depPath
+ readGenericPackageDescription verbosity (Just pkgDir) (relativeSymbolicPath pkgDescPath)
+
+-- | Try to read a @.cabal@ file, in directory @depPath@. Fails if one cannot be
-- found, with @err@ prefixing the error message. This function simply allows
-- us to give a more descriptive error than that provided by @findPackageDesc@.
-tryFindPackageDesc :: Verbosity -> FilePath -> String -> IO FilePath
-tryFindPackageDesc verbosity depPath err = do
- errOrCabalFile <- findPackageDesc depPath
+tryReadGenericPackageDesc
+ :: Verbosity
+ -> SymbolicPath CWD (Dir Pkg)
+ -> String
+ -> IO GenericPackageDescription
+tryReadGenericPackageDesc verbosity pkgDir err = do
+ pkgDescPath <- try_find_package_desc verbosity pkgDir err
+ readGenericPackageDescription verbosity (Just pkgDir) (relativeSymbolicPath pkgDescPath)
+
+-- | Internal helper function for 'tryReadAddSourcePackageDesc' and 'tryReadGenericPackageDesc'.
+try_find_package_desc
+ :: Verbosity
+ -> SymbolicPath CWD (Dir Pkg)
+ -> String
+ -> IO (RelativePath Pkg File)
+try_find_package_desc verbosity pkgDir err = do
+ errOrCabalFile <- findPackageDesc (Just pkgDir)
case errOrCabalFile of
Right file -> return file
Left _ -> dieWithException verbosity $ TryFindPackageDescErr err
@@ -410,13 +431,20 @@ progressMessage verbosity phase subject = do
noticeNoWrap verbosity $ phaseStr ++ subject ++ "\n"
where
phaseStr = case phase of
- ProgressDownloading -> "Downloading "
- ProgressDownloaded -> "Downloaded "
- ProgressStarting -> "Starting "
- ProgressBuilding -> "Building "
- ProgressHaddock -> "Haddock "
- ProgressInstalling -> "Installing "
- ProgressCompleted -> "Completed "
+ ProgressDownloading ->
+ "Downloading "
+ ProgressDownloaded ->
+ "Downloaded "
+ ProgressStarting ->
+ "Starting "
+ ProgressBuilding ->
+ "Building "
+ ProgressHaddock ->
+ "Haddock "
+ ProgressInstalling ->
+ "Installing "
+ ProgressCompleted ->
+ "Completed "
-- | Given a version, return an API-compatible (according to PVP) version range.
--
diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
index 55ea3747b9..6579b2ddcc 100644
--- a/cabal-install/tests/IntegrationTests2.hs
+++ b/cabal-install/tests/IntegrationTests2.hs
@@ -59,7 +59,7 @@ import Distribution.System
import Distribution.Version
import Distribution.ModuleName (ModuleName)
import Distribution.Text
-import Distribution.Utils.Path
+import Distribution.Utils.Path (unsafeMakeSymbolicPath)
import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject
import Distribution.Client.Setup (globalStoreDir)
import Distribution.Client.GlobalFlags (defaultGlobalFlags)
@@ -486,7 +486,7 @@ testTargetSelectorAmbiguous reportSubCase = do
withCFiles :: Executable -> [FilePath] -> Executable
withCFiles exe files =
- exe { buildInfo = (buildInfo exe) { cSources = files } }
+ exe { buildInfo = (buildInfo exe) { cSources = map unsafeMakeSymbolicPath files } }
withHsSrcDirs :: Executable -> [FilePath] -> Executable
withHsSrcDirs exe srcDirs =
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs b/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs
index 52a23a80ef..a5ec944369 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs
@@ -42,7 +42,8 @@ configureTests =
{ configFlags =
mempty
{ configOptimization = Flag MaximumOptimisation
- , configVerbosity = Flag silent
+ , configCommonFlags =
+ mempty{setupVerbosity = Flag silent}
}
}
projConfig <- configureAction' flags [] defaultGlobalFlags
@@ -59,7 +60,8 @@ configureTests =
, configFlags =
mempty
{ configOptimization = Flag NoOptimisation
- , configVerbosity = Flag silent
+ , configCommonFlags =
+ mempty{setupVerbosity = Flag silent}
}
}
(_, ProjectConfig{..}) <- configureAction' flags [] defaultGlobalFlags
@@ -75,7 +77,8 @@ configureTests =
}
, configFlags =
mempty
- { configVerbosity = Flag silent
+ { configCommonFlags =
+ mempty{setupVerbosity = Flag silent}
}
}
(_, ProjectConfig{..}) <- configureAction' flags [] defaultGlobalFlags
@@ -87,7 +90,8 @@ configureTests =
defaultTestFlags
{ configFlags =
mempty
- { configVerbosity = Flag silent
+ { configCommonFlags =
+ mempty{setupVerbosity = Flag silent}
}
}
(_, ProjectConfig{..}) <- configureAction' flags [] defaultGlobalFlags
@@ -99,7 +103,8 @@ configureTests =
defaultTestFlags
{ configFlags =
mempty
- { configVerbosity = Flag silent
+ { configCommonFlags =
+ mempty{setupVerbosity = Flag silent}
}
}
backup = projectDir </> "cabal.project.local~"
@@ -118,7 +123,8 @@ configureTests =
defaultTestFlags
{ configFlags =
mempty
- { configVerbosity = Flag silent
+ { configCommonFlags =
+ mempty{setupVerbosity = Flag silent}
, configProgramArgs = [("ghc", ghcFlags)]
}
}
diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs
index 9307aae8fe..991c5cafa0 100644
--- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs
@@ -449,7 +449,7 @@ exAvSrcPkg ex =
, C.maintainer = "maintainer"
, C.description = "description"
, C.synopsis = "synopsis"
- , C.licenseFiles = [C.unsafeMakeSymbolicPath "LICENSE"]
+ , C.licenseFiles = [C.makeRelativePathEx "LICENSE"]
, -- Version 2.0 is required for internal libraries.
C.specVersion = C.CabalSpecV2_0
}
@@ -524,21 +524,25 @@ exAvSrcPkg ex =
defaultExe =
mempty
{ C.buildInfo = defaultTopLevelBuildInfo
- , C.modulePath = "Main.hs"
+ , C.modulePath = C.makeRelativePathEx "Main.hs"
}
defaultTest :: C.TestSuite
defaultTest =
mempty
{ C.testBuildInfo = defaultTopLevelBuildInfo
- , C.testInterface = C.TestSuiteExeV10 (C.mkVersion [1, 0]) "Test.hs"
+ , C.testInterface =
+ C.TestSuiteExeV10 (C.mkVersion [1, 0]) $
+ C.makeRelativePathEx "Test.hs"
}
defaultBenchmark :: C.Benchmark
defaultBenchmark =
mempty
{ C.benchmarkBuildInfo = defaultTopLevelBuildInfo
- , C.benchmarkInterface = C.BenchmarkExeV10 (C.mkVersion [1, 0]) "Benchmark.hs"
+ , C.benchmarkInterface =
+ C.BenchmarkExeV10 (C.mkVersion [1, 0]) $
+ C.makeRelativePathEx "Benchmark.hs"
}
-- Split the set of dependencies into the set of dependencies of the library,
diff --git a/cabal-testsuite/PackageTests/AutoconfBadPaths/cabal.test.hs b/cabal-testsuite/PackageTests/AutoconfBadPaths/cabal.test.hs
index 7325eb0684..93ce9825a3 100644
--- a/cabal-testsuite/PackageTests/AutoconfBadPaths/cabal.test.hs
+++ b/cabal-testsuite/PackageTests/AutoconfBadPaths/cabal.test.hs
@@ -58,7 +58,7 @@ main = cabalTest $ do
]
configured_prog <- requireProgramM cabalProgram
r <- liftIO $ run (testVerbosity env)
- (Just (testCurrentDir env </> dir))
+ (Just $ testCurrentDir env </> dir)
(testEnvironment env)
(programPath configured_prog)
args Nothing
diff --git a/cabal-testsuite/PackageTests/AutogenModules/SrcDist/setup.test.hs b/cabal-testsuite/PackageTests/AutogenModules/SrcDist/setup.test.hs
index 84d702c57d..54e75918f4 100644
--- a/cabal-testsuite/PackageTests/AutogenModules/SrcDist/setup.test.hs
+++ b/cabal-testsuite/PackageTests/AutogenModules/SrcDist/setup.test.hs
@@ -84,7 +84,7 @@ main = setupAndCabalTest $ do
++ ".\\Dummy.hs\n"
++ ".\\MyBenchModule.hs\n"
++ "LICENSE\n"
- ++ ".\\AutogenModules.cabal\n"
+ ++ "AutogenModules.cabal\n"
#else
"./MyLibrary.hs\n"
++ "./MyLibModule.hs\n"
@@ -95,7 +95,7 @@ main = setupAndCabalTest $ do
++ "./Dummy.hs\n"
++ "./MyBenchModule.hs\n"
++ "LICENSE\n"
- ++ "./AutogenModules.cabal\n"
+ ++ "AutogenModules.cabal\n"
#endif
listSourcesStrGot <- liftIO $ readFile listSourcesFileGot
assertEqual "sdist --list-sources does not match the expected files"
diff --git a/cabal-testsuite/PackageTests/BenchmarkStanza/setup.test.hs b/cabal-testsuite/PackageTests/BenchmarkStanza/setup.test.hs
index eee6c0dd26..1dfd90ae86 100644
--- a/cabal-testsuite/PackageTests/BenchmarkStanza/setup.test.hs
+++ b/cabal-testsuite/PackageTests/BenchmarkStanza/setup.test.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
import Test.Cabal.Prelude
import Distribution.Version
@@ -18,7 +19,11 @@ main = setupAndCabalTest $ do
(mkUnqualComponentName "dummy")
(benchmarkName gotBenchmark)
assertEqual "benchmarkInterface"
- (BenchmarkExeV10 (mkVersion [1,0]) "dummy.hs")
+ (BenchmarkExeV10 (mkVersion [1,0])
+#if MIN_VERSION_Cabal(3,11,0)
+ $ makeRelativePathEx
+#endif
+ "dummy.hs")
(benchmarkInterface gotBenchmark)
-- NB: Not testing targetBuildDepends (benchmarkBuildInfo gotBenchmark),
-- as the dependency varies with cabal-install
diff --git a/cabal-testsuite/PackageTests/CCompilerOverride/custom-cc-clang.bat b/cabal-testsuite/PackageTests/CCompilerOverride/custom-cc-clang.bat
index 72012c9c9d..a2e60a9c59 100644
--- a/cabal-testsuite/PackageTests/CCompilerOverride/custom-cc-clang.bat
+++ b/cabal-testsuite/PackageTests/CCompilerOverride/custom-cc-clang.bat
@@ -8,4 +8,4 @@ IF %ERRORLEVEL% EQU 0 (
)
ECHO "Cannot find C compiler"
-EXIT /B 1
+EXIT /B 1
diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/InvalidWin/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/InvalidWin/cabal.out
index 93ecfd3c96..5e1b4087ab 100644
--- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/InvalidWin/cabal.out
+++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/InvalidWin/cabal.out
@@ -1,4 +1,4 @@
# cabal check
The following errors will cause portability problems on other environments:
-Error: [invalid-path-win] The path 'n?ul/*.a' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$".
+Error: [invalid-path-win] The path 'n?ul/*.a' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|", and there are a few reserved names including "aux", "nul", "con", "prn", "com{1-9}", "lpt{1-9}" and "clock$".
Error: Hackage would reject this package.
diff --git a/cabal-testsuite/PackageTests/CustomPreProcess/Setup.hs b/cabal-testsuite/PackageTests/CustomPreProcess/Setup.hs
index 2b7d59d629..b315119728 100644
--- a/cabal-testsuite/PackageTests/CustomPreProcess/Setup.hs
+++ b/cabal-testsuite/PackageTests/CustomPreProcess/Setup.hs
@@ -15,6 +15,10 @@ import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess
import Distribution.Simple.Utils
+#if MIN_VERSION_Cabal(3,11,0)
+import Distribution.Utils.Path (getSymbolicPath)
+#endif
+
import System.Exit
import System.FilePath
import System.Process (rawSystem)
@@ -42,7 +46,11 @@ main = defaultMainWithHooks
#endif
}
where
- builddir = buildDir lbi
+ builddir =
+#if MIN_VERSION_Cabal(3,11,0)
+ getSymbolicPath $
+#endif
+ buildDir lbi
progName = "my-custom-preprocessor"
progPath = builddir </> progName </> progName
diff --git a/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.out b/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.out
index a650ce81c4..3755a368fb 100644
--- a/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.out
+++ b/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.out
@@ -11,7 +11,7 @@ Building test suite 'test' for plain-0.1.0.0..
Running 1 test suites...
Test suite test: RUNNING...
Test suite test: PASS
-Test suite logged to: <ROOT>/cabal.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/plain-0.1.0.0/test/plain-0.1.0.0-test.log
-Test coverage report written to <ROOT>/cabal.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/plain-0.1.0.0/hpc/vanilla/html/test/hpc_index.html
+Test suite logged to: cabal.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/plain-0.1.0.0/test/plain-0.1.0.0-test.log
+Test coverage report written to cabal.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/plain-0.1.0.0/hpc/vanilla/html/test/hpc_index.html
1 of 1 test suites (1 of 1 test cases) passed.
-Package coverage report written to <ROOT>/cabal.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/plain-0.1.0.0/hpc/vanilla/html/plain-0.1.0.0/hpc_index.html
+Package coverage report written to cabal.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/plain-0.1.0.0/hpc/vanilla/html/plain-0.1.0.0/hpc_index.html
diff --git a/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs
index d9535b6050..b6a0667899 100644
--- a/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs
+++ b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs
@@ -37,7 +37,7 @@ cabal_raw_action args action = do
configured_prog <- requireProgramM cabalProgram
env <- getTestEnv
r <- liftIO $ runAction (testVerbosity env)
- (Just (testCurrentDir env))
+ (Just $ testCurrentDir env)
(testEnvironment env)
(programPath configured_prog)
args
diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs
index 4344076398..7f1728c831 100644
--- a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs
+++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs
@@ -9,7 +9,7 @@ import qualified Data.Time.Format as Time
import Data.Maybe
import System.Environment
-main = do
+main =
cabalTest $ do
res <- cabalWithStdin "v2-build" ["all"] ""
exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa"
@@ -26,7 +26,7 @@ cabal_raw_action args action = do
configured_prog <- requireProgramM cabalProgram
env <- getTestEnv
r <- liftIO $ runAction (testVerbosity env)
- (Just (testCurrentDir env))
+ (Just $ testCurrentDir env)
(testEnvironment env)
(programPath configured_prog)
args
diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs
index 96e69bbbd6..1932d49ed4 100644
--- a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs
+++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs
@@ -23,7 +23,7 @@ cabal_raw_action args action = do
configured_prog <- requireProgramM cabalProgram
env <- getTestEnv
r <- liftIO $ runAction (testVerbosity env)
- (Just (testCurrentDir env))
+ (Just $ testCurrentDir env)
(testEnvironment env)
(programPath configured_prog)
args
diff --git a/cabal-testsuite/PackageTests/ExtraProgPath/setup.out b/cabal-testsuite/PackageTests/ExtraProgPath/setup.out
index ea86cfd0f9..1011c8899e 100644
--- a/cabal-testsuite/PackageTests/ExtraProgPath/setup.out
+++ b/cabal-testsuite/PackageTests/ExtraProgPath/setup.out
@@ -1,7 +1,7 @@
# cabal v2-build
-Warning: cannot determine version of <ROOT>/./pkg-config :
+Warning: cannot determine version of <ROOT>/pkg-config :
""
-Warning: cannot determine version of <ROOT>/./pkg-config :
+Warning: cannot determine version of <ROOT>/pkg-config :
""
Resolving dependencies...
Error: [Cabal-7107]
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.cabal.out
index 8b37b69536..66dfaef906 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.cabal.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.cabal.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc is version <GHCVER> <ROOT>/ghc-pkg is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc is version <GHCVER> <ROOT>/ghc-pkg is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.out
index 8b37b69536..66dfaef906 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc is version <GHCVER> <ROOT>/ghc-pkg is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc is version <GHCVER> <ROOT>/ghc-pkg is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.cabal.out
index 914986cd6b..1cdc106cf6 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.cabal.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.cabal.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc-7.10 is version <GHCVER> <ROOT>/ghc-pkg-ghc-7.10 is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc-7.10 is version <GHCVER> <ROOT>/ghc-pkg-ghc-7.10 is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.out
index 914986cd6b..1cdc106cf6 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc-7.10 is version <GHCVER> <ROOT>/ghc-pkg-ghc-7.10 is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc-7.10 is version <GHCVER> <ROOT>/ghc-pkg-ghc-7.10 is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.cabal.out
index a04700e7ce..21a9410dbd 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.cabal.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.cabal.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc-7.10 is version <GHCVER> <ROOT>/ghc-pkg-7.10 is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc-7.10 is version <GHCVER> <ROOT>/ghc-pkg-7.10 is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.out
index a04700e7ce..21a9410dbd 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc-7.10 is version <GHCVER> <ROOT>/ghc-pkg-7.10 is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc-7.10 is version <GHCVER> <ROOT>/ghc-pkg-7.10 is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.cabal.out
index 6bc050fa06..98efa1ac3a 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.cabal.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.cabal.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc is version <GHCVER> <ROOT>/bin/ghc-pkg is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc is version <GHCVER> <ROOT>/bin/ghc-pkg is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.out
index 6bc050fa06..98efa1ac3a 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc is version <GHCVER> <ROOT>/bin/ghc-pkg is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc is version <GHCVER> <ROOT>/bin/ghc-pkg is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.cabal.out
index 2784e5e300..63c878d60a 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.cabal.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.cabal.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc is version <GHCVER> <ROOT>/bin/ghc-pkg-7.10 is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc is version <GHCVER> <ROOT>/bin/ghc-pkg-7.10 is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.out
index 2784e5e300..63c878d60a 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc is version <GHCVER> <ROOT>/bin/ghc-pkg-7.10 is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc is version <GHCVER> <ROOT>/bin/ghc-pkg-7.10 is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.cabal.out
index ef0d6cb992..37953f7728 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.cabal.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.cabal.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc is version <GHCVER> <ROOT>/bin/ghc-pkg-ghc-7.10 is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc is version <GHCVER> <ROOT>/bin/ghc-pkg-ghc-7.10 is version 9999999
diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.out
index ef0d6cb992..37953f7728 100644
--- a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.out
+++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.out
@@ -1,4 +1,4 @@
# Setup configure
Configuring SameDirectory-0.1.0.0...
Error: [Cabal-4000]
-Version mismatch between ghc and ghc-pkg: <ROOT>/./ghc is version <GHCVER> <ROOT>/bin/ghc-pkg-ghc-7.10 is version 9999999
+Version mismatch between ghc and ghc-pkg: <ROOT>/ghc is version <GHCVER> <ROOT>/bin/ghc-pkg-ghc-7.10 is version 9999999
diff --git a/cabal-testsuite/PackageTests/HaddockArgs/hoogle.out b/cabal-testsuite/PackageTests/HaddockArgs/hoogle.out
index b67d57515d..3aeb5d42e0 100644
--- a/cabal-testsuite/PackageTests/HaddockArgs/hoogle.out
+++ b/cabal-testsuite/PackageTests/HaddockArgs/hoogle.out
@@ -14,7 +14,7 @@ for sigs-0.1.0.0...
Preprocessing library for sigs-0.1.0.0...
Running Haddock on library instantiated with Data.Map = <Data.Map>
for sigs-0.1.0.0...
-Documentation created: dist/doc/html/sigs/sigs.txt
+Documentation created: <ROOT>/hoogle.dist/work/./dist/<TMPDIR>/sigs-0.1.0.0/dist/doc/html/sigs/sigs.txt
Installing library in <PATH>
Configuring library for indef-0.1.0.0...
Preprocessing library for indef-0.1.0.0...
@@ -23,7 +23,7 @@ for indef-0.1.0.0...
Preprocessing library for indef-0.1.0.0...
Running Haddock on library instantiated with Data.Map = <Data.Map>
for indef-0.1.0.0...
-Documentation created: dist/doc/html/indef/indef.txt
+Documentation created: <ROOT>/hoogle.dist/work/./dist/<TMPDIR>/indef-0.1.0.0/dist/doc/html/indef/indef.txt
Installing library in <PATH>
Configuring library for example-1.0...
Preprocessing library for example-1.0...
diff --git a/cabal-testsuite/PackageTests/HaddockArgs/quickjump.out b/cabal-testsuite/PackageTests/HaddockArgs/quickjump.out
index 52809bcc3a..f81b0b9485 100644
--- a/cabal-testsuite/PackageTests/HaddockArgs/quickjump.out
+++ b/cabal-testsuite/PackageTests/HaddockArgs/quickjump.out
@@ -14,7 +14,7 @@ for sigs-0.1.0.0...
Preprocessing library for sigs-0.1.0.0...
Running Haddock on library instantiated with Data.Map = <Data.Map>
for sigs-0.1.0.0...
-Documentation created: dist/doc/html/sigs/
+Documentation created: <ROOT>/quickjump.dist/work/./dist/<TMPDIR>/sigs-0.1.0.0/dist/doc/html/sigs/
Installing library in <PATH>
Configuring library for indef-0.1.0.0...
Preprocessing library for indef-0.1.0.0...
@@ -23,7 +23,7 @@ for indef-0.1.0.0...
Preprocessing library for indef-0.1.0.0...
Running Haddock on library instantiated with Data.Map = <Data.Map>
for indef-0.1.0.0...
-Documentation created: dist/doc/html/indef/
+Documentation created: <ROOT>/quickjump.dist/work/./dist/<TMPDIR>/indef-0.1.0.0/dist/doc/html/indef/
Installing library in <PATH>
Configuring library for example-1.0...
Preprocessing library for example-1.0...
diff --git a/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.out b/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.out
index bb6754c14a..64f999e436 100644
--- a/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.out
+++ b/cabal-testsuite/PackageTests/HaddockBuildDepends/cabal.out
@@ -17,7 +17,7 @@ Preprocessing library for lib-1...
Building library for lib-1...
Preprocessing library for lib-1...
Running Haddock on library for lib-1...
-Documentation created: dist/doc/html/lib/
+Documentation created: <ROOT>/cabal.dist/work/./dist/<TMPDIR>/lib-1/dist/doc/html/lib/
Installing library in <PATH>
Configuring library for a-0.1.0.0...
Preprocessing library for a-0.1.0.0...
diff --git a/cabal-testsuite/PackageTests/HaddockProject/haddock-project.out b/cabal-testsuite/PackageTests/HaddockProject/haddock-project.out
index cde81e2c2b..50ede874c7 100644
--- a/cabal-testsuite/PackageTests/HaddockProject/haddock-project.out
+++ b/cabal-testsuite/PackageTests/HaddockProject/haddock-project.out
@@ -16,7 +16,7 @@ Preprocessing library for async-2.2.4...
Building library for async-2.2.4...
Preprocessing library for async-2.2.4...
Running Haddock on library for async-2.2.4...
-Documentation created: dist/doc/html/async/
+Documentation created: <ROOT>/dist-newstyle/<TMPDIR>/async-2.2.4/dist/doc/html/async/
Installing library in <PATH>
Configuring library for a-0.1.0.0...
Preprocessing library for a-0.1.0.0...
diff --git a/cabal-testsuite/PackageTests/InternalLibraries/Executable/setup-static.test.hs b/cabal-testsuite/PackageTests/InternalLibraries/Executable/setup-static.test.hs
index dc674bc098..e84be70982 100644
--- a/cabal-testsuite/PackageTests/InternalLibraries/Executable/setup-static.test.hs
+++ b/cabal-testsuite/PackageTests/InternalLibraries/Executable/setup-static.test.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
import Test.Cabal.Prelude
import Control.Monad.IO.Class
import Control.Monad
@@ -11,6 +13,10 @@ import Distribution.Simple.Compiler
import Distribution.Types.TargetInfo
import Distribution.Types.LocalBuildInfo
import Distribution.Types.UnqualComponentName
+#if MIN_VERSION_Cabal(3,11,0)
+import Distribution.Utils.Path (makeSymbolicPath)
+#endif
+
import System.Directory
-- Internal libraries used by a statically linked executable:
@@ -26,7 +32,12 @@ main = setupAndCabalTest $ do
else "--disable-executable-dynamic"
, "--enable-shared"]
dist_dir <- fmap testDistDir getTestEnv
- lbi <- liftIO $ getPersistBuildConfig dist_dir
+ lbi <- liftIO $
+ getPersistBuildConfig
+#if MIN_VERSION_Cabal(3,11,0)
+ Nothing $ makeSymbolicPath
+#endif
+ dist_dir
let pkg_descr = localPkgDescr lbi
compiler_id = compilerId (compiler lbi)
cname = CLibName $ LSubLibName $ mkUnqualComponentName "foo-internal"
diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Terminate/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Terminate/cabal.test.hs
index 9d5c8f9124..44f88c2665 100644
--- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Terminate/cabal.test.hs
+++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Terminate/cabal.test.hs
@@ -65,7 +65,7 @@ cabal_raw_action args action = do
configured_prog <- requireProgramM cabalProgram
env <- getTestEnv
r <- liftIO $ runAction (testVerbosity env)
- (Just (testCurrentDir env))
+ (Just $ testCurrentDir env)
(testEnvironment env)
(programPath configured_prog)
args
diff --git a/cabal-testsuite/PackageTests/NewHaddock/ImplyDependencies/cabal.out b/cabal-testsuite/PackageTests/NewHaddock/ImplyDependencies/cabal.out
index 9397fb7d07..07fc04a111 100644
--- a/cabal-testsuite/PackageTests/NewHaddock/ImplyDependencies/cabal.out
+++ b/cabal-testsuite/PackageTests/NewHaddock/ImplyDependencies/cabal.out
@@ -11,7 +11,7 @@ Preprocessing library for A-0.1.0.0...
Building library for A-0.1.0.0...
Preprocessing library for A-0.1.0.0...
Running Haddock on library for A-0.1.0.0...
-Documentation created: dist/doc/html/A/
+Documentation created: <ROOT>/cabal.dist/work/./dist/<TMPDIR>/A-0.1.0.0/dist/doc/html/A/
Installing library in <PATH>
Configuring library for B-0.1.0.0...
Preprocessing library for B-0.1.0.0...
diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out
index 110b605264..98ffd99b30 100644
--- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out
+++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out
@@ -15,11 +15,11 @@ Warning: [unknown-directory] 'hs-source-dirs: doesnt-exist' specifies a director
Preprocessing executable 'Complex' for Complex-0.1.0.0...
Building executable 'Complex' for Complex-0.1.0.0...
# show-build-info Complex exe:Complex
-{"cabal-lib-version":"<CABALVER>","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"components":[{"type":"exe","name":"exe:Complex","unit-id":"Complex-0.1.0.0-inplace-Complex","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-odir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-hidir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-hiedir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/extra-compilation-artifacts/hie","-stubdir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-i","-iapp","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/global-autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/global-autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-optP-include","-optP<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/Complex/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-Complex","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","<ROOT>/single.dist/home/.cabal/store/ghc-<GHCVER>/package.db","-package-db","<ROOT>/single.dist/work/./dist/packagedb/ghc-<GHCVER>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-XHaskell2010","-threaded","-rtsopts","-with-rtsopts=-N -T","-Wredundant-constraints"],"modules":["Other","Paths_Complex"],"src-files":["Main.lhs"],"hs-src-dirs":["app"],"src-dir":"<ROOT>/","cabal-file":"./Complex.cabal"}]}
+{"cabal-lib-version":"<CABALVER>","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"components":[{"type":"exe","name":"exe:Complex","unit-id":"Complex-0.1.0.0-inplace-Complex","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-odir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-hidir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-hiedir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/extra-compilation-artifacts/hie","-stubdir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-i","-iapp","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/global-autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/global-autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build","-optP-include","-optPsingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/x/Complex/build/Complex/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-Complex","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","<ROOT>/single.dist/home/.cabal/store/ghc-<GHCVER>/package.db","-package-db","<ROOT>/single.dist/work/./dist/packagedb/ghc-<GHCVER>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-XHaskell2010","-threaded","-rtsopts","-with-rtsopts=-N -T","-Wredundant-constraints"],"modules":["Other","Paths_Complex"],"src-files":["Main.lhs"],"hs-src-dirs":["app"],"src-dir":"<ROOT>/","cabal-file":"Complex.cabal"}]}
# cabal build
Up to date
# show-build-info Complex lib
-{"cabal-lib-version":"<CABALVER>","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"components":[{"type":"lib","name":"lib","unit-id":"Complex-0.1.0.0-inplace","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-odir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-hidir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-hiedir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/extra-compilation-artifacts/hie","-stubdir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-i","-isrc","-idoesnt-exist","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/autogen","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/global-autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/global-autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-optP-include","-optP<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","<ROOT>/single.dist/home/.cabal/store/ghc-<GHCVER>/package.db","-package-db","<ROOT>/single.dist/work/./dist/packagedb/ghc-<GHCVER>","-package-id","<PACKAGEDEP>","-XHaskell2010","-Wall"],"modules":["A","B","C","D","Paths_Complex"],"src-files":[],"hs-src-dirs":["src","doesnt-exist"],"src-dir":"<ROOT>/","cabal-file":"./Complex.cabal"}]}
+{"cabal-lib-version":"<CABALVER>","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"components":[{"type":"lib","name":"lib","unit-id":"Complex-0.1.0.0-inplace","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-odir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-hidir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-hiedir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/extra-compilation-artifacts/hie","-stubdir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-i","-isrc","-idoesnt-exist","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/autogen","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/global-autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/global-autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build","-optP-include","-optPsingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/build/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","<ROOT>/single.dist/home/.cabal/store/ghc-<GHCVER>/package.db","-package-db","<ROOT>/single.dist/work/./dist/packagedb/ghc-<GHCVER>","-package-id","<PACKAGEDEP>","-XHaskell2010","-Wall"],"modules":["A","B","C","D","Paths_Complex"],"src-files":[],"hs-src-dirs":["src","doesnt-exist"],"src-dir":"<ROOT>/","cabal-file":"Complex.cabal"}]}
# cabal build
Build profile: -w ghc-<GHCVER> -O1
In order, the following will be built:
@@ -34,7 +34,7 @@ Warning: [unknown-directory] 'hs-source-dirs: doesnt-exist' specifies a director
Preprocessing benchmark 'complex-benchmarks' for Complex-0.1.0.0...
Building benchmark 'complex-benchmarks' for Complex-0.1.0.0...
# show-build-info Complex bench:complex-benchmarks
-{"cabal-lib-version":"<CABALVER>","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"components":[{"type":"bench","name":"bench:complex-benchmarks","unit-id":"Complex-0.1.0.0-inplace-complex-benchmarks","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-odir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-hidir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-hiedir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/extra-compilation-artifacts/hie","-stubdir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-i","-ibenchmark","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-optP-include","-optP<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-complex-benchmarks","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","<ROOT>/single.dist/home/.cabal/store/ghc-<GHCVER>/package.db","-package-db","<ROOT>/single.dist/work/./dist/packagedb/ghc-<GHCVER>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-XHaskell2010","-Wall","-rtsopts","-threaded","-with-rtsopts=-N"],"modules":["Paths_Complex"],"src-files":["Main.hs"],"hs-src-dirs":["benchmark"],"src-dir":"<ROOT>/","cabal-file":"./Complex.cabal"}]}
+{"cabal-lib-version":"<CABALVER>","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"components":[{"type":"bench","name":"bench:complex-benchmarks","unit-id":"Complex-0.1.0.0-inplace-complex-benchmarks","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-odir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-hidir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-hiedir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/extra-compilation-artifacts/hie","-stubdir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-i","-ibenchmark","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build","-optP-include","-optPsingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-complex-benchmarks","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","<ROOT>/single.dist/home/.cabal/store/ghc-<GHCVER>/package.db","-package-db","<ROOT>/single.dist/work/./dist/packagedb/ghc-<GHCVER>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-XHaskell2010","-Wall","-rtsopts","-threaded","-with-rtsopts=-N"],"modules":["Paths_Complex"],"src-files":["Main.hs"],"hs-src-dirs":["benchmark"],"src-dir":"<ROOT>/","cabal-file":"Complex.cabal"}]}
# cabal build
Build profile: -w ghc-<GHCVER> -O1
In order, the following will be built:
@@ -49,7 +49,7 @@ Warning: [unknown-directory] 'hs-source-dirs: doesnt-exist' specifies a director
Preprocessing test suite 'func-test' for Complex-0.1.0.0...
Building test suite 'func-test' for Complex-0.1.0.0...
# show-build-info Complex test:func-test
-{"cabal-lib-version":"<CABALVER>","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"components":[{"type":"test","name":"test:func-test","unit-id":"Complex-0.1.0.0-inplace-func-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-odir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-hidir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-hiedir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/extra-compilation-artifacts/hie","-stubdir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-i","-itest","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/global-autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/global-autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-optP-include","-optP<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/func-test/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-func-test","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","<ROOT>/single.dist/home/.cabal/store/ghc-<GHCVER>/package.db","-package-db","<ROOT>/single.dist/work/./dist/packagedb/ghc-<GHCVER>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-XHaskell2010"],"modules":[],"src-files":["FuncMain.hs"],"hs-src-dirs":["test"],"src-dir":"<ROOT>/","cabal-file":"./Complex.cabal"}]}
+{"cabal-lib-version":"<CABALVER>","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"components":[{"type":"test","name":"test:func-test","unit-id":"Complex-0.1.0.0-inplace-func-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-odir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-hidir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-hiedir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/extra-compilation-artifacts/hie","-stubdir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-i","-itest","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/global-autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/global-autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build","-optP-include","-optPsingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/func-test/build/func-test/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-func-test","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","<ROOT>/single.dist/home/.cabal/store/ghc-<GHCVER>/package.db","-package-db","<ROOT>/single.dist/work/./dist/packagedb/ghc-<GHCVER>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-XHaskell2010"],"modules":[],"src-files":["FuncMain.hs"],"hs-src-dirs":["test"],"src-dir":"<ROOT>/","cabal-file":"Complex.cabal"}]}
# cabal build
Build profile: -w ghc-<GHCVER> -O1
In order, the following will be built:
@@ -64,4 +64,4 @@ Warning: [unknown-directory] 'hs-source-dirs: doesnt-exist' specifies a director
Preprocessing test suite 'unit-test' for Complex-0.1.0.0...
Building test suite 'unit-test' for Complex-0.1.0.0...
# show-build-info Complex test:unit-test
-{"cabal-lib-version":"<CABALVER>","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"components":[{"type":"test","name":"test:unit-test","unit-id":"Complex-0.1.0.0-inplace-unit-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-odir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-hidir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-hiedir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/extra-compilation-artifacts/hie","-stubdir","<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-i","-itest","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-i<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-optP-include","-optP<ROOT>/single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-unit-test","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","<ROOT>/single.dist/home/.cabal/store/ghc-<GHCVER>/package.db","-package-db","<ROOT>/single.dist/work/./dist/packagedb/ghc-<GHCVER>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-XHaskell2010"],"modules":[],"src-files":["UnitMain.hs"],"hs-src-dirs":["test"],"src-dir":"<ROOT>/","cabal-file":"./Complex.cabal"}]}
+{"cabal-lib-version":"<CABALVER>","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"components":[{"type":"test","name":"test:unit-test","unit-id":"Complex-0.1.0.0-inplace-unit-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-odir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-hidir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-hiedir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/extra-compilation-artifacts/hie","-stubdir","single.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-i","-itest","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/global-autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/global-autogen","-Isingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build","-optP-include","-optPsingle.dist/work/./dist/build/<ARCH>/ghc-<GHCVER>/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-unit-test","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","<ROOT>/single.dist/home/.cabal/store/ghc-<GHCVER>/package.db","-package-db","<ROOT>/single.dist/work/./dist/packagedb/ghc-<GHCVER>","-package-id","<PACKAGEDEP>","-package-id","<PACKAGEDEP>","-XHaskell2010"],"modules":[],"src-files":["UnitMain.hs"],"hs-src-dirs":["test"],"src-dir":"<ROOT>/","cabal-file":"Complex.cabal"}]}
diff --git a/cabal-testsuite/PackageTests/TestStanza/setup.test.hs b/cabal-testsuite/PackageTests/TestStanza/setup.test.hs
index 1f33596d86..f3bc253f00 100644
--- a/cabal-testsuite/PackageTests/TestStanza/setup.test.hs
+++ b/cabal-testsuite/PackageTests/TestStanza/setup.test.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
import Test.Cabal.Prelude
import Distribution.Version
@@ -16,7 +17,11 @@ main = setupAndCabalTest $ do
let gotTestSuite = head $ testSuites (localPkgDescr lbi)
assertEqual "testName" (mkUnqualComponentName "dummy")
(testName gotTestSuite)
- assertEqual "testInterface" (TestSuiteExeV10 (mkVersion [1,0]) "dummy.hs")
+ assertEqual "testInterface" (TestSuiteExeV10 (mkVersion [1,0])
+#if MIN_VERSION_Cabal(3,11,0)
+ $ makeRelativePathEx
+#endif
+ "dummy.hs")
(testInterface gotTestSuite)
-- NB: Not testing targetBuildDepends (testBuildInfo gotTestSuite)
-- as dependency varies with cabal-install
diff --git a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-markup.test.hs b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-markup.test.hs
index 4db84dcec4..ad491f1be5 100644
--- a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-markup.test.hs
+++ b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-markup.test.hs
@@ -1,11 +1,31 @@
+{-# LANGUAGE CPP #-}
+
+-- The logic here is tricky.
+-- If this is compiled by cabal-install, then the MIN_VERSION_Cabal is set
+-- otherwise, we are compiling against Cabal library under test,
+-- which is new!
+#ifndef MIN_VERSION_Cabal
+#define MIN_VERSION_Cabal(x,y,z) 1
+#endif
+
import Test.Cabal.Prelude
import Distribution.Simple.Hpc
+#if MIN_VERSION_Cabal(3,11,0)
+import Distribution.Utils.Path
+ ( unsafeMakeSymbolicPath, getSymbolicPath )
+mkPath = unsafeMakeSymbolicPath
+getPath = getSymbolicPath
+#else
+mkPath = id
+getPath = id
+#endif
+
-- Ensures that even if a .tix file happens to be left around
-- markup isn't generated.
main = setupAndCabalTest $ do
dist_dir <- fmap testDistDir getTestEnv
- let tixFile = tixFilePath dist_dir Vanilla "test-Short"
+ let tixFile = getPath $ tixFilePath (mkPath dist_dir) Vanilla "test-Short"
withEnv [("HPCTIXFILE", Just tixFile)] $ do
setup_build
[ "--enable-tests"
@@ -13,4 +33,4 @@ main = setupAndCabalTest $ do
, "--ghc-option=-hpcdir"
, "--ghc-option=" ++ dist_dir ++ "/hpc/vanilla" ]
setup "test" ["test-Short", "--show-details=direct"]
- shouldNotExist $ htmlDir dist_dir Vanilla </> "hpc_index.html"
+ shouldNotExist $ getPath (htmlDir (mkPath dist_dir) Vanilla) </> "hpc_index.html"
diff --git a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-tix.test.hs b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-tix.test.hs
index 12db5895dd..7fa7fbe9b1 100644
--- a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-tix.test.hs
+++ b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-tix.test.hs
@@ -1,5 +1,24 @@
+{-# LANGUAGE CPP #-}
+
+-- The logic here is tricky.
+-- If this is compiled by cabal-install, then the MIN_VERSION_Cabal is set
+-- otherwise, we are compiling against Cabal library under test,
+-- which is new!
+#ifndef MIN_VERSION_Cabal
+#define MIN_VERSION_Cabal(x,y,z) 1
+#endif
+
import Test.Cabal.Prelude
import Distribution.Simple.Hpc
+#if MIN_VERSION_Cabal(3,11,0)
+import Distribution.Utils.Path
+ ( unsafeMakeSymbolicPath, getSymbolicPath )
+mkPath = unsafeMakeSymbolicPath
+getPath = getSymbolicPath
+#else
+mkPath = id
+getPath = id
+#endif
-- When -fhpc is manually provided, but --enable-coverage is not,
-- the desired behavior is that we pass on -fhpc to GHC, but do NOT
@@ -21,4 +40,4 @@ main = setupAndCabalTest $ do
setup "test" ["test-Short", "--show-details=direct"]
lbi <- getLocalBuildInfoM
let way = guessWay lbi
- shouldNotExist $ tixFilePath dist_dir way "test-Short"
+ shouldNotExist $ getPath $ tixFilePath (mkPath dist_dir) way "test-Short"
diff --git a/cabal-testsuite/Setup.hs b/cabal-testsuite/Setup.hs
index d83f9dc60e..ca4ab043b0 100644
--- a/cabal-testsuite/Setup.hs
+++ b/cabal-testsuite/Setup.hs
@@ -10,6 +10,7 @@ import Distribution.Simple.Utils
import Distribution.Types.LocalBuildInfo
import Distribution.Types.ModuleRenaming
import Distribution.Types.UnqualComponentName
+import Distribution.Utils.Path (getSymbolicPath)
import Distribution.Verbosity
import System.Directory
diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal
index cb5a3fe605..d09abed023 100644
--- a/cabal-testsuite/cabal-testsuite.cabal
+++ b/cabal-testsuite/cabal-testsuite.cabal
@@ -32,7 +32,11 @@ common shared
, Cabal-syntax ^>= 3.11.0.0
, Cabal-tests
- ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
+ ghc-options:
+ -Wall
+ -fwarn-tabs
+ -fwarn-incomplete-uni-patterns
+ -fno-warn-unticked-promoted-constructors
library
diff --git a/cabal-testsuite/main/cabal-tests.hs b/cabal-testsuite/main/cabal-tests.hs
index b6a76ccf48..50ec17c156 100644
--- a/cabal-testsuite/main/cabal-tests.hs
+++ b/cabal-testsuite/main/cabal-tests.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
import Test.Cabal.Workdir
import Test.Cabal.Script
@@ -12,6 +13,7 @@ import Test.Cabal.TestCode
import Distribution.Verbosity (normal, verbose, Verbosity)
import Distribution.Simple.Utils (getDirectoryContentsRecursive)
import Distribution.Simple.Program
+import Distribution.Utils.Path (getSymbolicPath)
import Options.Applicative
import Control.Concurrent.MVar
@@ -211,7 +213,7 @@ main = do
-- for Custom.
dist_dir <- case mainArgDistDir args of
Just dist_dir -> return dist_dir
- Nothing -> guessDistDir
+ Nothing -> getSymbolicPath <$> guessDistDir
when (verbosity >= verbose) $
hPutStrLn stderr $ "Using dist dir: " ++ dist_dir
-- Get ready to go!
diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs
index 3896ee18b0..90b69c7e7a 100644
--- a/cabal-testsuite/src/Test/Cabal/Monad.hs
+++ b/cabal-testsuite/src/Test/Cabal/Monad.hs
@@ -248,7 +248,10 @@ python3Program = simpleProgram "python3"
-- | Run a test in the test monad according to program's arguments.
runTestM :: String -> TestM a -> IO a
runTestM mode m =
- liftIO $ getTemporaryDirectory >>= \systemTmpDir ->
+ liftIO $ (canonicalizePath =<< getTemporaryDirectory) >>= \systemTmpDir ->
+ -- canonicalizePath: cabal-install is inconsistent w.r.t. looking through
+ -- symlinks. We canonicalize here to avoid such issues when the temporary
+ -- directory contains symlinks. See #9763.
execParser (info testArgParser Data.Monoid.mempty) >>= \args ->
withTempDirectoryEx verbosity (defaultTempFileOptions { optKeepTempFiles = argKeepTmpFiles (testCommonArgs args) })
systemTmpDir
@@ -450,7 +453,7 @@ getSourceFiles = do
env <- getTestEnv
configured_prog <- requireProgramM gitProgram
r <- liftIO $ run (testVerbosity env)
- (Just (testSourceDir env))
+ (Just $ testSourceDir env)
(testEnvironment env)
(programPath configured_prog)
["ls-files", "--cached", "--modified"]
diff --git a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs
index a0b7d3ac66..e6afd93fcb 100644
--- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs
+++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs
@@ -35,9 +35,10 @@ normalizeOutput nenv =
-- This is dumb but I don't feel like pulling in another dep for
-- string search-replace. Make sure we do this before backslash
-- normalization!
- . resub (posixRegexEscape (normalizerGblTmpDir nenv) ++ "[a-z0-9\\.-]+") "<GBLTMPDIR>" -- note, after TMPDIR
- . resub (posixRegexEscape (normalizerTmpDir nenv)) "<ROOT>/"
- . resub (posixRegexEscape (normalizerCanonicalTmpDir nenv)) "<ROOT>/" -- before normalizerTmpDir
+ . resub (posixRegexEscape (normalizerGblTmpDir nenv) ++ "[a-z0-9\\.-]+") "<GBLTMPDIR>"
+ . resub (posixRegexEscape "tmp/src-" ++ "[0-9]+") "<TMPDIR>"
+ . resub (posixRegexEscape (normalizerTmpDir nenv) ++ sameDir) "<ROOT>/"
+ . resub (posixRegexEscape (normalizerCanonicalTmpDir nenv) ++ sameDir) "<ROOT>/"
. appEndo (F.fold (map (Endo . packageIdRegex) (normalizerKnownPackages nenv)))
-- Look for 0.1/installed-0d6uzW7Ubh1Fb4TB5oeQ3G
-- These installed packages will vary depending on GHC version
@@ -66,6 +67,7 @@ normalizeOutput nenv =
-- hackage-security locks occur non-deterministically
. resub "(Released|Acquired|Waiting) .*hackage-security-lock\n" ""
where
+ sameDir = "(\\.((\\\\)+|\\/))*"
packageIdRegex pid =
resub (posixRegexEscape (display pid) ++ "(-[A-Za-z0-9.-]+)?")
(prettyShow (packageName pid) ++ "-<VERSION>")
diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs
index 4923b3e488..69e60078e7 100644
--- a/cabal-testsuite/src/Test/Cabal/Prelude.hs
+++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs
@@ -11,6 +11,7 @@ module Test.Cabal.Prelude (
module Test.Cabal.Monad,
module Test.Cabal.Run,
module System.FilePath,
+ module Distribution.Utils.Path,
module Control.Monad,
module Control.Monad.IO.Class,
module Distribution.Version,
@@ -41,6 +42,8 @@ import Distribution.Types.LocalBuildInfo
import Distribution.PackageDescription
import Test.Utils.TempTestDir (withTestDir)
import Distribution.Verbosity (normal)
+import Distribution.Utils.Path
+ ( makeSymbolicPath, relativeSymbolicPath )
import Distribution.Compat.Stack
@@ -81,7 +84,7 @@ runM :: FilePath -> [String] -> Maybe String -> TestM Result
runM path args input = do
env <- getTestEnv
r <- liftIO $ run (testVerbosity env)
- (Just (testCurrentDir env))
+ (Just $ testCurrentDir env)
(testEnvironment env)
path
args
@@ -99,7 +102,7 @@ runProgramM prog args input = do
getLocalBuildInfoM :: TestM LocalBuildInfo
getLocalBuildInfoM = do
env <- getTestEnv
- liftIO $ getPersistBuildConfig (testDistDir env)
+ liftIO $ getPersistBuildConfig Nothing (makeSymbolicPath $ testDistDir env)
------------------------------------------------------------------------
-- * Changing parameters
@@ -185,9 +188,9 @@ setup'' prefix cmd args = do
--
-- `cabal` and `Setup.hs` do have different interface.
--
-
- pdfile <- liftIO $ tryFindPackageDesc (testVerbosity env) (testCurrentDir env </> prefix)
- pdesc <- liftIO $ readGenericPackageDescription (testVerbosity env) pdfile
+ let pkgDir = makeSymbolicPath $ testCurrentDir env </> prefix
+ pdfile <- liftIO $ tryFindPackageDesc (testVerbosity env) (Just pkgDir)
+ pdesc <- liftIO $ readGenericPackageDescription (testVerbosity env) (Just pkgDir) $ relativeSymbolicPath pdfile
if testCabalInstallAsSetup env
then if buildType (packageDescription pdesc) == Simple
then runProgramM cabalProgram ("act-as-setup" : "--" : NE.toList full_args) Nothing
@@ -198,7 +201,7 @@ setup'' prefix cmd args = do
-- Run the Custom script!
else do
r <- liftIO $ runghc (testScriptEnv env)
- (Just (testCurrentDir env))
+ (Just $ testCurrentDir env)
(testEnvironment env)
(testCurrentDir env </> prefix </> "Setup.hs")
(NE.toList full_args)
@@ -832,7 +835,7 @@ hasProfiledLibraries = do
ghc_path <- programPathM ghcProgram
let prof_test_hs = testWorkDir env </> "Prof.hs"
liftIO $ writeFile prof_test_hs "module Prof where"
- r <- liftIO $ run (testVerbosity env) (Just (testCurrentDir env))
+ r <- liftIO $ run (testVerbosity env) (Just $ testCurrentDir env)
(testEnvironment env) ghc_path ["-prof", "-c", prof_test_hs]
Nothing
return (resultExitCode r == ExitSuccess)
diff --git a/cabal-testsuite/src/Test/Cabal/Run.hs b/cabal-testsuite/src/Test/Cabal/Run.hs
index 6c06dec91d..37b27e9edf 100644
--- a/cabal-testsuite/src/Test/Cabal/Run.hs
+++ b/cabal-testsuite/src/Test/Cabal/Run.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NondecreasingIndentation #-}
-- | A module for running commands in a chatty way.
module Test.Cabal.Run (
diff --git a/cabal-testsuite/src/Test/Cabal/Script.hs b/cabal-testsuite/src/Test/Cabal/Script.hs
index 308c390140..15e17ed2b9 100644
--- a/cabal-testsuite/src/Test/Cabal/Script.hs
+++ b/cabal-testsuite/src/Test/Cabal/Script.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
+
-- | Functionality for invoking Haskell scripts with the correct
-- package database setup.
module Test.Cabal.Script (
@@ -14,6 +18,7 @@ import Test.Cabal.ScriptEnv0
import Distribution.Backpack
import Distribution.Types.ModuleRenaming
import Distribution.Utils.NubList
+import Distribution.Utils.Path
import Distribution.Simple.Program.Db
import Distribution.Simple.Program.Builtin
import Distribution.Simple.Program.GHC
@@ -79,8 +84,9 @@ runnerCommand :: ScriptEnv -> Maybe FilePath -> [(String, Maybe String)]
-> FilePath -> [String] -> IO (FilePath, [String])
runnerCommand senv mb_cwd _env_overrides script_path args = do
(prog, _) <- requireProgram verbosity runghcProgram (runnerProgramDb senv)
- return (programPath prog,
- runghc_args ++ ["--"] ++ map ("--ghc-arg="++) ghc_args ++ [script_path] ++ args)
+ return $
+ (programPath prog,
+ runghc_args ++ ["--"] ++ map ("--ghc-arg="++) ghc_args ++ [script_path] ++ args)
where
verbosity = runnerVerbosity senv
runghc_args = []
@@ -89,7 +95,7 @@ runnerCommand senv mb_cwd _env_overrides script_path args = do
-- | Compute the GHC flags to invoke 'runghc' with under a 'ScriptEnv'.
runnerGhcArgs :: ScriptEnv -> Maybe FilePath -> [String]
runnerGhcArgs senv mb_cwd =
- renderGhcOptions (runnerCompiler senv) (runnerPlatform senv) ghc_options
+ renderGhcOptions (runnerCompiler senv) (runnerPlatform senv) ghc_options
where
ghc_options = M.mempty { ghcOptPackageDBs = runnerPackageDbStack senv
, ghcOptPackages = toNubListR (runnerPackages senv)
@@ -104,5 +110,5 @@ runnerGhcArgs senv mb_cwd =
, ghcOptSourcePath = toNubListR $
case mb_cwd of
Nothing -> []
- Just wd -> [wd]
+ Just {} -> [sameDirectory]
}
diff --git a/cabal-testsuite/src/Test/Cabal/Server.hs b/cabal-testsuite/src/Test/Cabal/Server.hs
index 9d302237a2..d6906a6d41 100644
--- a/cabal-testsuite/src/Test/Cabal/Server.hs
+++ b/cabal-testsuite/src/Test/Cabal/Server.hs
@@ -1,5 +1,7 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NondecreasingIndentation #-}
-- | A GHC run-server, which supports running multiple GHC scripts
-- without having to restart from scratch.
@@ -136,7 +138,7 @@ runOnServer :: Server -> Maybe FilePath -> [(String, Maybe String)]
-> FilePath -> [String] -> IO ServerResult
runOnServer s mb_cwd env_overrides script_path args = do
-- TODO: cwd not implemented
- when (isJust mb_cwd) $ error "runOnServer change directory not implemented"
+ when (isJust mb_cwd) $ error "runOnServer change directory not implemented"
-- TODO: env_overrides not implemented
unless (null env_overrides) $ error "runOnServer set environment not implemented"
@@ -181,12 +183,13 @@ runOnServer s mb_cwd env_overrides script_path args = do
-- Give the user some indication about how they could run the
-- command by hand.
(real_path, real_args) <- runnerCommand (serverScriptEnv s) mb_cwd env_overrides script_path args
- return ServerResult {
- serverResultTestCode = code,
- serverResultCommand = showCommandForUser real_path real_args,
- serverResultStdout = out,
- serverResultStderr = err
- }
+ return $
+ ServerResult {
+ serverResultTestCode = code,
+ serverResultCommand = showCommandForUser real_path real_args,
+ serverResultStdout = out,
+ serverResultStderr = err
+ }
-- | Helper function which we use in the GHCi session to communicate
-- the exit code of the process.
diff --git a/cabal-testsuite/src/Test/Cabal/Workdir.hs b/cabal-testsuite/src/Test/Cabal/Workdir.hs
index 063c321201..bbb545c649 100644
--- a/cabal-testsuite/src/Test/Cabal/Workdir.hs
+++ b/cabal-testsuite/src/Test/Cabal/Workdir.hs
@@ -1,30 +1,38 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+
-- | Functions for interrogating the current working directory
module Test.Cabal.Workdir where
import Distribution.Simple.Setup
import Distribution.Simple.Configure
+import Distribution.Utils.Path
+ ( FileOrDir(..)
+ , Pkg
+ , Dist
+ , SymbolicPath
+ , makeSymbolicPath
+ , getSymbolicPath
+ )
import System.Directory
import System.FilePath
-#if MIN_VERSION_base(4,6,0)
import System.Environment ( getExecutablePath )
-#endif
-- | Guess what the dist directory of a running executable is,
-- by using the conventional layout of built executables
-- in relation to the top of a dist directory. Will not work
-- if the executable has been installed somewhere else.
-guessDistDir :: IO FilePath
+guessDistDir :: IO (SymbolicPath Pkg (Dir Dist))
guessDistDir = do
-#if MIN_VERSION_base(4,6,0)
exe_path <- canonicalizePath =<< getExecutablePath
let dist0 = dropFileName exe_path </> ".." </> ".."
b <- doesFileExist (dist0 </> "setup-config")
-#else
- let dist0 = error "no path"
- b = False
-#endif
- if b then canonicalizePath dist0
- else findDistPrefOrDefault NoFlag >>= canonicalizePath
+ if b
+ then do
+ cwd <- getCurrentDirectory
+ dist1 <- canonicalizePath dist0
+ return $ makeSymbolicPath $ makeRelative (normalise cwd) dist1
+ else do
+ d <- getSymbolicPath <$> findDistPrefOrDefault NoFlag
+ makeSymbolicPath <$> canonicalizePath d
diff --git a/changelog.d/issue-9702 b/changelog.d/issue-9702
new file mode 100644
index 0000000000..7df998b8d8
--- /dev/null
+++ b/changelog.d/issue-9702
@@ -0,0 +1,39 @@
+synopsis: Working directory support for Cabal
+packages: Cabal-syntax Cabal cabal-install
+prs: #9718
+issues: #9702
+
+description: {
+
+The Cabal library is now able to handle a passed-in working directory, instead
+of always relying on the current working directory of the parent process.
+
+In order to achieve this, the `SymbolicPath` abstraction was fleshed out, and
+all fields of `PackageDescription` that, if relative, should be interpreted
+with respect to e.g. the package root, use `SymbolicPath` instead of `FilePath`.
+
+This means that many library functions in `Cabal` take an extra argument of type
+`Maybe (SymbolicPath CWD (Dir "Package))`, which is an optional (relative or
+absolute) path to the package root (if relative, relative to the current working
+directory). In addition, many functions that used to manipulate `FilePath`s now
+manipulate `SymbolicPath`s, require explicit conversion using e.g. `getSymbolicPath`.
+
+To illustrate with file searching, the `Cabal` library defines:
+
+```haskell
+findFileCwd
+ :: forall dir1 dir2 file
+ . Verbosity
+ -> Maybe (SymbolicPath CWD (Dir dir1))
+ -- ^ working directory
+ -> [SymbolicPath dir1 (Dir dir2)]
+ -- ^ search directories
+ -> RelativePath dir2 File
+ -- ^ filename
+ -> IO (SymbolicPath dir1 File)
+```
+
+See Note [Symbolic paths] in `Distribution.Utils.Path` for further information
+on the design of this API.
+}
+
--
GitLab