From 8cacda35f017448a35f6c40bc4b545f19108506f Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 9 Jan 2025 00:54:01 +0100 Subject: [PATCH] WIP fix local+noindex on Windows --- Cabal-syntax/src/Distribution/Utils/Path.hs | 19 +++++++++++++++++++ .../src/Distribution/Client/Config.hs | 12 ++++++++++-- .../src/Distribution/Client/GlobalFlags.hs | 7 +++---- .../src/Distribution/Client/IndexUtils.hs | 4 ++-- .../Client/ProjectConfig/Legacy.hs | 14 +++++++++++--- cabal-testsuite/src/Test/Cabal/Prelude.hs | 6 ++---- doc/config.rst | 4 ++++ 7 files changed, 51 insertions(+), 15 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Utils/Path.hs b/Cabal-syntax/src/Distribution/Utils/Path.hs index a0f18a1dfdd..a004efbff77 100644 --- a/Cabal-syntax/src/Distribution/Utils/Path.hs +++ b/Cabal-syntax/src/Distribution/Utils/Path.hs @@ -67,6 +67,9 @@ module Distribution.Utils.Path -- ** Module names , moduleNameSymbolicPath + + -- * Windows + , posixizePath ) where import Distribution.Compat.Prelude @@ -531,3 +534,19 @@ data Response -- -- See Note [Symbolic paths] in Distribution.Utils.Path. data PkgConf + +------------------------------------------------------------------------------- + +-- * Windows utils + +------------------------------------------------------------------------------- + +-- | Sometimes we need to represent a Windows path (that might have been +-- normalized) as a POSIX path, for example in URIs. +posixizePath :: FilePath -> FilePath +posixizePath = + map + (\x -> case x of + '\\' -> '/' + _ -> x + ) diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index d4214cc383b..365d49d85bb 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -227,7 +227,8 @@ import System.Directory , renameFile ) import System.FilePath - ( takeDirectory + ( normalise + , takeDirectory , (<.>) , () ) @@ -1693,7 +1694,14 @@ postProcessRepo lineno reponameStr repo0 = do -- Note: the trailing colon is important "file+noindex:" -> do let uri = remoteRepoURI repo0 - return $ Left $ LocalRepo reponame (uriPath uri) (uriFragment uri == "#shared-cache") + return $ + Left $ + LocalRepo + reponame + -- Normalization of Windows paths that use @//./@ does not fully + -- normalize the path (see filepath#247), but it is still usable. + (normalise (uriPath uri)) + (uriFragment uri == "#shared-cache") _ -> do let repo = repo0{remoteRepoName = reponame} diff --git a/cabal-install/src/Distribution/Client/GlobalFlags.hs b/cabal-install/src/Distribution/Client/GlobalFlags.hs index 6b41a79b5ef..2fd19e71b50 100644 --- a/cabal-install/src/Distribution/Client/GlobalFlags.hs +++ b/cabal-install/src/Distribution/Client/GlobalFlags.hs @@ -57,7 +57,8 @@ import Network.URI , uriScheme ) import System.FilePath - ( () + ( isAbsolute + , () ) import qualified Distribution.Client.Security.DNS as Sec.DNS @@ -69,8 +70,6 @@ import qualified Hackage.Security.Client.Repository.Remote as Sec.Remote import qualified Hackage.Security.Util.Path as Sec import qualified Hackage.Security.Util.Pretty as Sec -import qualified System.FilePath.Posix as FilePath.Posix - -- ------------------------------------------------------------ -- * Global flags @@ -192,7 +191,7 @@ withRepoContext' ignoreExpiry extraPaths = \callback -> do for_ localNoIndexRepos $ \local -> - unless (FilePath.Posix.isAbsolute (localRepoPath local)) $ + unless (isAbsolute (localRepoPath local)) $ warn verbosity $ "file+noindex " ++ unRepoName (localRepoName local) ++ " repository path is not absolute; this is fragile, and not recommended" diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 828c6ea52c3..c01108c2b6e 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -466,7 +466,7 @@ readRepoIndex verbosity repoCtxt repo idxState = RepoSecure{..} -> warn verbosity $ exceptionMessageCabalInstall $ MissingPackageList repoRemote RepoLocalNoIndex local _ -> warn verbosity $ - "Error during construction of local+noindex " + "Error during construction of file+noindex " ++ unRepoName (localRepoName local) ++ " repository index: " ++ show e @@ -526,7 +526,7 @@ whenCacheOutOfDate index action = do then action else if localNoIndex index - then return () -- TODO: don't update cache for local+noindex repositories + then return () -- TODO: don't update cache for file+noindex repositories else do indexTime <- getModTime $ indexFile index cacheTime <- getModTime $ cacheFile index diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 1b6357c335b..379825cc918 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -175,7 +175,7 @@ import Distribution.Simple.Command , option , reqArg' ) -import Distribution.System (Arch, OS) +import Distribution.System (Arch, OS (Windows), buildOS) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint ) @@ -189,7 +189,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import Network.URI (URI (..), parseURI) import System.Directory (createDirectoryIfMissing, makeAbsolute) -import System.FilePath (isAbsolute, isPathSeparator, makeValid, splitFileName, ()) +import System.FilePath (isAbsolute, isPathSeparator, joinDrive, makeValid, splitFileName, ()) import Text.PrettyPrint ( Doc , render @@ -2040,9 +2040,17 @@ remoteRepoSectionDescr = localToRemote :: LocalRepo -> RemoteRepo localToRemote (LocalRepo name path sharedCache) = (emptyRemoteRepo name) - { remoteRepoURI = URI "file+noindex:" Nothing path "" (if sharedCache then "#shared-cache" else "") + { remoteRepoURI = + URI + "file+noindex:" + Nothing + ((if isWindows then joinDrive "//./" . posixizePath else id) path) + "" + (if sharedCache then "#shared-cache" else "") } + isWindows = buildOS == Windows + ------------------------------- -- Local field utils -- diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index daa5472c9d0..ecceed02f90 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -48,7 +48,7 @@ import Distribution.PackageDescription import Test.Utils.TempTestDir (withTestDir) import Distribution.Verbosity (normal) import Distribution.Utils.Path - ( makeSymbolicPath, relativeSymbolicPath, interpretSymbolicPathCWD ) + ( makeSymbolicPath, posixizePath, relativeSymbolicPath, interpretSymbolicPathCWD ) import Distribution.Compat.Stack @@ -613,9 +613,7 @@ withRepoNoUpdate repo_dir m = do -- TODO: Arguably should undo everything when we're done... where repoUri env ="file+noindex://" ++ (if isWindows - then map (\x -> case x of - '\\' -> '/' - _ -> x) + then joinDrive "//./" . posixizePath else id) (testRepoDir env) -- | Given a directory (relative to the 'testCurrentDir') containing diff --git a/doc/config.rst b/doc/config.rst index 36a53f958b0..9f4ccc18318 100644 --- a/doc/config.rst +++ b/doc/config.rst @@ -200,6 +200,10 @@ repository. ``package-name-version.tar.gz`` files in the directory, and will use optional corresponding ``package-name-version.cabal`` files as new revisions. +.. note:: + On Windows systems, the path has to be prefixed by ``//./`` as in + ``url: file+noindex:////./C:/absolute/path/to/directory``. + For example, if ``/absolute/path/to/directory`` looks like ::