Fix file+noindex URI usage on Windows

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

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}
 

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"
 

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

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

cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs

@@ -46,25 +46,7 @@ normalizeOutput nenv =
   . resub (posixRegexEscape "tmp/src-" ++ "[0-9]+") "<TMPDIR>"
   . resub (posixRegexEscape (normalizerTmpDir nenv) ++ sameDir) "<ROOT>/"
   . resub (posixRegexEscape (normalizerCanonicalTmpDir nenv) ++ sameDir) "<ROOT>/"
-  . (if buildOS == Windows
-        then
-          -- OK. Here's the deal. In `./Prelude.hs`, `withRepoNoUpdate` sets
-          -- `repoUri` to the tmpdir but with backslashes replaced with
-          -- slashes. This is because Windows treats backslashes and forward
-          -- slashes largely the same in paths, and backslashes aren't allowed
-          -- in a URL like `file+noindex://...`.
-          --
-          -- But that breaks the regexes above, which expect the paths to have
-          -- backslashes.
-          --
-          -- Honestly this whole `normalizeOutput` thing is super janky and
-          -- worth rewriting from the ground up. To you, poor soul in the
-          -- future, here is one more hack upon a great pile. Hey, at least all
-          -- the `PackageTests` function as a test suite for this thing...
-            resub (posixRegexEscape (backslashToSlash $ normalizerTmpDir nenv) ++ sameDir) "<ROOT>/"
-          . resub (posixRegexEscape (backslashToSlash $ normalizerCanonicalTmpDir nenv) ++ sameDir) "<ROOT>/"
-        else id)
-      -- Munge away C: prefix on filenames (Windows). We convert C:\\ to \\.
+    -- Munge away C:\ prefix on filenames (Windows). We convert C:\ to \.
   . (if buildOS == Windows then resub "([A-Z]):\\\\" "\\\\" else id)
   . appEndo (F.fold (map (Endo . packageIdRegex) (normalizerKnownPackages nenv)))
     -- Look for 0.1/installed-0d6uzW7Ubh1Fb4TB5oeQ3G
@@ -96,6 +78,14 @@ normalizeOutput nenv =
         else id)
   . normalizeBuildInfoJson
   . maybe id normalizePathCmdOutput (normalizerCabalInstallVersion nenv)
+    -- Munge away \\.\C:/ prefix on paths (Windows). We convert @\\.\C:/@ to
+    -- @\@. We need to do this before the step above as that one would convert
+    -- @\\.\@ to @\.\@.
+    --
+    -- These paths might come up in file+noindex URIs due to @filepath@
+    -- normalizing @//./C:/foo.txt@ paths to @\\.\C:/foo.txt@, see
+    -- (filepath#247).
+  . (if buildOS == Windows then resub "\\\\\\\\\\.\\\\([A-Z]):/" "\\\\" else id)
   -- hackage-security locks occur non-deterministically
   . resub "(Released|Acquired|Waiting) .*hackage-security-lock\n" ""
   . resub "installed: [0-9]+(\\.[0-9]+)*" "installed: <VERSION>"

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

changelog.d/pr-10728

@@ -0,0 +1,11 @@
+synopsis: Fix `file+noindex` URI usage on Windows
+packages: cabal-install
+prs: #10728
+issues: #10703
+significance:
+
+description: {
+
+- Windows users can now specify file+noindex paths using the format `file+noindex:////./C:/path/to/repo`.
+
+}

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