Merge pull request #9718 from mpickering/wip/work-dir

Make Cabal agnostic about working directory

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])

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

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
 -------------------------------------------------------------------------------

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