diff --git a/Cabal-described/src/Distribution/Described.hs b/Cabal-described/src/Distribution/Described.hs index 3bfd8c2e3a4..8c1c501cf95 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 73fb7c1bb17..46c4ce4fc22 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 f823d3d63e5..d39e77ebbeb 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 9a9ba2d7500..e811c361221 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 c60040f8e34..db6b7f7607b 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 b894e71b791..02b20864479 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 67efb90955d..da1f8aea88f 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 63cfba526ab..19453a671b9 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 bf70702f41c..a2140e074a7 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 73410519e90..3683522ac8d 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 19336af203d..0da75b06cc6 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 a5905af2ff8..b7f4fee3197 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 f8f84311cec..a3f1d0c33da 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 f2fdc7e57d6..201b10d859f 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 a1a2879a924..37e87155e48 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 9da89bdd7f3..765b0ac6143 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 7e9f5e5dbda..858ce659c45 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 79e8635889f..e3155eb8397 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 da422e37c5e..6a81475dc03 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 d754955f46d..3d03421210b 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 17e61add696..3191425d609 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 943e723c191..e677de20626 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 874b4964267..f6ffe291e59 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 9a1c7a53df0..e0eb4a1dde7 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 f74c75224ef..b3cb004eecb 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 91c43cb0755..21b200baa7b 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 9fb2f39cbe9..6c4cf929dc9 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 341645e243d..16464335f7d 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 b9ea1f18bc9..1315d689467 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 b4e7be7dc75..61f2177cbaa 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 f5447429927..e1b125e7a32 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 b549eb51f71..9084371a614 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 92b76bbb0eb..346af927d1b 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 bcb1f1f5bbb..fba99528b53 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 2b747fd1b8e..e5b106dc5cd 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 56f23f26d0e..46f24105f0f 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 f7ed51e79fa..0191d063f6e 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 be5e955442b..07c04ec6cb9 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 996d49e6625..2ff7de7917e 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 aa4f6492cd7..43c345dd170 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 208e17e41f0..e6606851627 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 5cf5a7c1db8..7435b0d59b4 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 b436742cd03..a221632efa4 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 af63d8cd9f0..e1ffb85dceb 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 aac1a2153e6..c9e675ceb76 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 6fc8dafb3e8..0bb5556b2f4 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 c813d8b5668..b1ba1b282f4 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 954c378122c..8906a91f63b 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 0b1c1ccd528..3c26ece45ad 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 2878577225b..de8a15f04c0 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 b2866d4a5e0..3bf06bc9c3b 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 1a02247a87a..0c0fc57a8b8 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 0f94cf3be9d..28d57c1e3b0 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 2af5d422e3b..a8c6b0c0c4a 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 e96ca1efb35..8187272c2c0 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 650054bcf00..2f2663733c6 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 30e0f9077c1..8dd849d75bd 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 29b85215c1a..2ca07bf2322 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 427f0eb21ca..9c50edd4864 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 b7b57e34bf1..944faa4c0c0 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 f714c7a0fe4..8f2edf09a36 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 f3c993b7b7b..b134e4584ad 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 edbbeed7483..03959b195c0 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 ", - 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 ", + 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 a6142498ae2..71653353f9f 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 5992a61d0d0..a89ce9b36e7 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 8fc21c80ece..952be052961 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 67966cb6f90..15fae62649e 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 eb3b6e055f9..e987dcaea87 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 805df700229..5d3683be079 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 9727690bf16..9af0500fae1 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 82334d550f0..1568abaac60 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 43f8bf0d2a4..f444a4c23fe 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 a610b5875a5..fdafa89b6e5 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 6f21d5d0da6..859b3f12c50 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 58e9f4046b0..657e37cbbc1 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 86b6e06bfa8..da4788adce0 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 bc6ac7ae6be..e4e40b5fb5f 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 48b3b60a12b..bb984bfb8ab 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 b4adc37d3e7..4c44bd380f2 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 @/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 06b387c04ae..cb5293b18b3 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 2da6486cba6..b403bb4c01a 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 6aaa0931ee6..ae8d1c05136 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 d6bffddf365..0a788af830c 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 b7a7f16da25..1257ee39998 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 2c5af36a04b..1ca8c97c6c6 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 d22c7f61849..e71c20d47bc 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 cc50e3bdb3c..51f7d650338 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/-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 07ad6ac31d8..fc204cda30a 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 f25c60c887d..9f454e0ea5f 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 0a6c408ee4b..9c9e55a03bf 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 e5161e343da..fb8bd21351a 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 43e329fa66b..a4b75cdb6d3 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 4e14bc04d5d..973230ee3c7 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 9ce97d7555b..17ee7a76bc5 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 33d497231af..a63b9195b67 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 d59c4703fc4..d3f43f65904 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 158051b0924..ea1c1368057 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 789845c6201..eb72a73fa53 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 6321eabdb29..b478aefe511 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 8659764d0c4..35681ee5908 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 440059db7cf..d0ee9d9f86b 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 4f69ce6fc05..160b81fd4de 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 02a5bdbc531..5315d3b1ac7 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 4514bc0fd94..f5a609f3b7e 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 b5d1cfe65e6..004b02cca1a 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 9fa70feb5a2..84d6b0ccfaa 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 eb3430fb503..710020d9f6d 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 0fb210e72e3..c508900814d 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 d7449b93964..5c2a33809ae 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 8a477d3fdd4..ee8271545f1 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 e9a1298559b..88afef0af91 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 4cfc5ba8801..78053111a4a 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 cd8f10aff3c..861cf16095c 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 5eac60aee00..36fc446b5a1 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 aa1fa5e61ab..09aad42bdc8 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 14cb65bae6e..6a1974f323e 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 0589838f617..0a1422b327f 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 c2af17b8f9e..14e76c7d769 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 466263ffedb..719592b656e 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 c3c8ad9a566..b230289446d 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 f332a958d08..bcb2c9dbc5e 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 443be76c5d5..1c62c2dedca 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 a0502693ec4..eb909612c6d 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 ee1fc0d587b..e3eb8d6ac7a 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 2fae5bffcd4..4321a9466cb 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 56dde313fbb..6caf8e51e52 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 12501c791b8..e4c2706eed6 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 4f84f3ed8e4..493c972ae8a 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 90250290fc1..443fc87ae58 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 3c033dd979b..3d364ae44b2 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 af7a896d841..fc9a3439ee1 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 f5a6ec2ce18..0fe7a597e4c 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 ce6bb95d0e7..af085ef3a7c 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 1da133ca4c4..8c30cc18abb 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) - -- ^ .cabal -findPackageDesc = findPackageDescCwd "." - --- | @since 3.4.0.0 -findPackageDescCwd - :: FilePath - -- ^ project root - -> FilePath - -- ^ relative directory - -> IO (Either CabalException FilePath) - -- ^ .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 .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 4423a77410d..9126d92f1eb 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 1c3aeef0161..a5706fff09a 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 95b7ce725f3..2e06aa991b5 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 07ec20bf93f..f8c1d456751 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 b39aa9d6755..05634141288 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 be4b26b0038..44f1c4e0f27 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 ef481300ef7..2ffda4dce6a 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 ff249ed0edb..c5bd678c2a3 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 fc81f323fdc..43be4ec0f23 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 85c7eb137e2..29718b5d441 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 b67bda4bcec..8ecc5487798 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 bde0948dcf9..bf21de2d352 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 be4f66363d4..fa64668f6fd 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 4572c868f33..128d5fb4251 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 1fefd3a7375..e53100122e9 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 7093ee7a0bf..ed40a1a85e6 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 e243eb82974..39468a8e545 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 b390dacb22e..ea839eef94c 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 a1142b06a27..07687bbeb98 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 74fcc3a78b2..7c1adffdc91 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 052c8d60edd..c388ba39871 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 1c2b4dabb27..2a2bc6754f0 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 b01681d9727..fc7ea49fe31 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 b1a8dc5b48a..01da7195d51 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 ab69bb55efb..ae78b50c004 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 2dc7d37e29c..5958deca553 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 d2ed5a8c873..ced1f74cf81 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 f986cce0e03..12605a669a0 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 e1f855cdafe..a31e4d2ce62 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 13e29a44d81..1701aa1f652 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 6ef0a673717..4c9dcba5f03 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 7a047774b2b..ff2a010ba1a 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 a0906686dd1..3c11674de80 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 5b651746dc1..065334d5c6e 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 23d8cbab932..151d13ca8ef 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 d949437f5d6..e76dbea443a 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 c3fa259b41e..2d963b0e07f 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 0e4fb108a19..d38f07037a6 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 6344249a8a6..304331e1f9e 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 178ffdcbc76..f344db1e389 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 33303ea3243..2950d9f7a30 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 a5ba2a08533..6942875e996 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 6784e3bfe18..108fedc9357 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 82e7492a02b..d4523d784c5 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 3033356493f..57e45ddb2ba 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 1793f6aa07d..20f644668e6 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 85f00dd9609..95ac8dbffff 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 ---static + { -- Cabal < 2.1 doesn't know about ---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 b3174c96751..f5432dad1c2 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 f8fdcdcc9f9..1166f333f3c 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 eb0d6230d1b..46d826cad1a 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 4e7d97d97cc..a8358ec2f18 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 d29413642de..856168103d1 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 ea8cb85cbbb..1a37c9c73b9 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 f5a10da789a..87378da7f10 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 55ea3747b9f..6579b2ddcc2 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 52a23a80ef2..a5ec944369e 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 9307aae8feb..991c5cafa0e 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 7325eb0684c..93ce9825a36 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 84d702c57d2..54e75918f46 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 eee6c0dd269..1dfd90ae86a 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 72012c9c9d0..a2e60a9c592 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 93ecfd3c969..5e1b4087abb 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 2b7d59d6297..b315119728b 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 a650ce81c42..3755a368fbd 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: /cabal.dist/work/./dist/build//ghc-/plain-0.1.0.0/test/plain-0.1.0.0-test.log -Test coverage report written to /cabal.dist/work/./dist/build//ghc-/plain-0.1.0.0/hpc/vanilla/html/test/hpc_index.html +Test suite logged to: cabal.dist/work/./dist/build//ghc-/plain-0.1.0.0/test/plain-0.1.0.0-test.log +Test coverage report written to cabal.dist/work/./dist/build//ghc-/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 /cabal.dist/work/./dist/build//ghc-/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//ghc-/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 d9535b60507..b6a06678990 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 4344076398a..7f1728c831b 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 96e69bbbd6e..1932d49ed48 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 ea86cfd0f9d..1011c8899ed 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 /./pkg-config : +Warning: cannot determine version of /pkg-config : "" -Warning: cannot determine version of /./pkg-config : +Warning: cannot determine version of /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 8b37b69536d..66dfaef906a 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: /./ghc is version /ghc-pkg is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc is version /ghc-pkg is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.out index 8b37b69536d..66dfaef906a 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: /./ghc is version /ghc-pkg is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc is version /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 914986cd6b3..1cdc106cf62 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: /./ghc-7.10 is version /ghc-pkg-ghc-7.10 is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc-7.10 is version /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 914986cd6b3..1cdc106cf62 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: /./ghc-7.10 is version /ghc-pkg-ghc-7.10 is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc-7.10 is version /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 a04700e7cea..21a9410dbd0 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: /./ghc-7.10 is version /ghc-pkg-7.10 is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc-7.10 is version /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 a04700e7cea..21a9410dbd0 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: /./ghc-7.10 is version /ghc-pkg-7.10 is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc-7.10 is version /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 6bc050fa067..98efa1ac3a3 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: /./ghc is version /bin/ghc-pkg is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc is version /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 6bc050fa067..98efa1ac3a3 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: /./ghc is version /bin/ghc-pkg is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc is version /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 2784e5e3001..63c878d60a4 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: /./ghc is version /bin/ghc-pkg-7.10 is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc is version /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 2784e5e3001..63c878d60a4 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: /./ghc is version /bin/ghc-pkg-7.10 is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc is version /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 ef0d6cb9925..37953f7728f 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: /./ghc is version /bin/ghc-pkg-ghc-7.10 is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc is version /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 ef0d6cb9925..37953f7728f 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: /./ghc is version /bin/ghc-pkg-ghc-7.10 is version 9999999 +Version mismatch between ghc and ghc-pkg: /ghc is version /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 b67d57515dd..3aeb5d42e04 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 = for sigs-0.1.0.0... -Documentation created: dist/doc/html/sigs/sigs.txt +Documentation created: /hoogle.dist/work/./dist//sigs-0.1.0.0/dist/doc/html/sigs/sigs.txt Installing library in 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 = for indef-0.1.0.0... -Documentation created: dist/doc/html/indef/indef.txt +Documentation created: /hoogle.dist/work/./dist//indef-0.1.0.0/dist/doc/html/indef/indef.txt Installing library in 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 52809bcc3af..f81b0b94852 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 = for sigs-0.1.0.0... -Documentation created: dist/doc/html/sigs/ +Documentation created: /quickjump.dist/work/./dist//sigs-0.1.0.0/dist/doc/html/sigs/ Installing library in 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 = for indef-0.1.0.0... -Documentation created: dist/doc/html/indef/ +Documentation created: /quickjump.dist/work/./dist//indef-0.1.0.0/dist/doc/html/indef/ Installing library in 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 bb6754c14a6..64f999e4368 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: /cabal.dist/work/./dist//lib-1/dist/doc/html/lib/ Installing library in 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 cde81e2c2ba..50ede874c75 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: /dist-newstyle//async-2.2.4/dist/doc/html/async/ Installing library in 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 dc674bc0987..e84be709823 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 9d5c8f91242..44f88c26656 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 9397fb7d076..07fc04a1119 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: /cabal.dist/work/./dist//A-0.1.0.0/dist/doc/html/A/ Installing library in 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 110b6052642..98ffd99b300 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":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"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//ghc-/Complex-0.1.0.0/x/Complex/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-hiedir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/extra-compilation-artifacts/hie","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-i","-iapp","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/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","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010","-threaded","-rtsopts","-with-rtsopts=-N -T","-Wredundant-constraints"],"modules":["Other","Paths_Complex"],"src-files":["Main.lhs"],"hs-src-dirs":["app"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} +{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"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//ghc-/Complex-0.1.0.0/x/Complex/build","-odir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-hidir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-hiedir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/extra-compilation-artifacts/hie","-stubdir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-i","-iapp","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-optP-include","-optPsingle.dist/work/./dist/build//ghc-/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","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010","-threaded","-rtsopts","-with-rtsopts=-N -T","-Wredundant-constraints"],"modules":["Other","Paths_Complex"],"src-files":["Main.lhs"],"hs-src-dirs":["app"],"src-dir":"/","cabal-file":"Complex.cabal"}]} # cabal build Up to date # show-build-info Complex lib -{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"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//ghc-/Complex-0.1.0.0/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-hiedir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/extra-compilation-artifacts/hie","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-i","-isrc","-idoesnt-exist","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/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","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-XHaskell2010","-Wall"],"modules":["A","B","C","D","Paths_Complex"],"src-files":[],"hs-src-dirs":["src","doesnt-exist"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} +{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"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//ghc-/Complex-0.1.0.0/build","-odir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-hidir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-hiedir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/extra-compilation-artifacts/hie","-stubdir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-i","-isrc","-idoesnt-exist","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/autogen","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/global-autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/global-autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-optP-include","-optPsingle.dist/work/./dist/build//ghc-/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","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-XHaskell2010","-Wall"],"modules":["A","B","C","D","Paths_Complex"],"src-files":[],"hs-src-dirs":["src","doesnt-exist"],"src-dir":"/","cabal-file":"Complex.cabal"}]} # cabal build Build profile: -w ghc- -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":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"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//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-hiedir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/extra-compilation-artifacts/hie","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-i","-ibenchmark","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/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","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010","-Wall","-rtsopts","-threaded","-with-rtsopts=-N"],"modules":["Paths_Complex"],"src-files":["Main.hs"],"hs-src-dirs":["benchmark"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} +{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"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//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-odir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-hidir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-hiedir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/extra-compilation-artifacts/hie","-stubdir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-i","-ibenchmark","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-optP-include","-optPsingle.dist/work/./dist/build//ghc-/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","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010","-Wall","-rtsopts","-threaded","-with-rtsopts=-N"],"modules":["Paths_Complex"],"src-files":["Main.hs"],"hs-src-dirs":["benchmark"],"src-dir":"/","cabal-file":"Complex.cabal"}]} # cabal build Build profile: -w ghc- -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":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"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//ghc-/Complex-0.1.0.0/t/func-test/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-hiedir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/extra-compilation-artifacts/hie","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-i","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/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","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["FuncMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} +{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"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//ghc-/Complex-0.1.0.0/t/func-test/build","-odir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-hidir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-hiedir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/extra-compilation-artifacts/hie","-stubdir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-i","-itest","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-optP-include","-optPsingle.dist/work/./dist/build//ghc-/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","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["FuncMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"Complex.cabal"}]} # cabal build Build profile: -w ghc- -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":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"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//ghc-/Complex-0.1.0.0/t/unit-test/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-hiedir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/extra-compilation-artifacts/hie","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-i","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/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","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["UnitMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} +{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"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//ghc-/Complex-0.1.0.0/t/unit-test/build","-odir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-hidir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-hiedir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/extra-compilation-artifacts/hie","-stubdir","single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-i","-itest","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-Isingle.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-optP-include","-optPsingle.dist/work/./dist/build//ghc-/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","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["UnitMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"Complex.cabal"}]} diff --git a/cabal-testsuite/PackageTests/TestStanza/setup.test.hs b/cabal-testsuite/PackageTests/TestStanza/setup.test.hs index 1f33596d86c..f3bc253f002 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 4db84dcec46..ad491f1be56 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 12db5895dd1..7fa7fbe9b19 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 d83f9dc60e8..ca4ab043b04 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 cb5a3fe605d..d09abed023e 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 b6a76ccf485..50ec17c156e 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 3896ee18b0b..90b69c7e7a6 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 a0b7d3ac669..e6afd93fcb0 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\\.-]+") "" -- note, after TMPDIR - . resub (posixRegexEscape (normalizerTmpDir nenv)) "/" - . resub (posixRegexEscape (normalizerCanonicalTmpDir nenv)) "/" -- before normalizerTmpDir + . resub (posixRegexEscape (normalizerGblTmpDir nenv) ++ "[a-z0-9\\.-]+") "" + . resub (posixRegexEscape "tmp/src-" ++ "[0-9]+") "" + . resub (posixRegexEscape (normalizerTmpDir nenv) ++ sameDir) "/" + . resub (posixRegexEscape (normalizerCanonicalTmpDir nenv) ++ sameDir) "/" . 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) ++ "-") diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 4923b3e4884..69e60078e78 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 6c06dec91d7..37b27e9edf3 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 308c390140b..15e17ed2b94 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 9d302237a22..d6906a6d416 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 063c321201d..bbb545c6494 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 00000000000..7df998b8d8d --- /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. +} +