Merge branch 'master' into wip/romes/fixes

haskell · Apr 9, 2024 · a9abbf7 · a9abbf7
2 parents 355b48c + d7147fc
commit a9abbf7
Show file tree

Hide file tree

Showing 285 changed files with 20,416 additions and 7,742 deletions.
diff --git a/Cabal-described/Cabal-described.cabal b/Cabal-described/Cabal-described.cabal
@@ -19,7 +19,6 @@ library
     , rere              >=0.1 && <0.3
     , tasty
     , tasty-quickcheck
-    , transformers
 
   exposed-modules:
     Distribution.Described

diff --git 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
@@ -40,22 +40,25 @@ library
     parsec     >= 3.1.13.0 && < 3.2,
     pretty     >= 1.1.1    && < 1.2,
     text       (>= 1.2.3.0 && < 1.3) || (>= 2.0 && < 2.2),
-    time       >= 1.4.0.1  && < 1.13,
+    time       >= 1.4.0.1  && < 1.15,
     -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity
     -- 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
 
   if impl(ghc >= 8.0) && impl(ghc < 8.8)
     ghc-options: -Wnoncanonical-monadfail-instances
 
-  if impl(ghc >= 8.10)
-    ghc-options: -Wunused-packages
-
   build-tool-depends: alex:alex
 
   exposed-modules:

diff --git 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
@@ -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