Revert "Merge pull request #3 from jasagredo/js/fix-local-noindex-windows"

This reverts commit 417a1db, reversing
changes made to 0eabec2.

Author: 9999years

cabal-install/cabal-install.cabal

@@ -230,7 +230,6 @@ library
         echo       >= 0.1.3    && < 0.2,
         edit-distance >= 0.2.2 && < 0.3,
         exceptions >= 0.10.4   && < 0.11,
-        file-uri   >= 0.1      && < 0.2,
         filepath   >= 1.4.0.0  && < 1.6,
         HTTP       >= 4000.1.5 && < 4000.5,
         mtl        >= 2.0      && < 2.4,

cabal-install/src/Distribution/Client/Config.hs

@@ -110,7 +110,6 @@ import Distribution.Utils.NubList
   )
 
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BS8
 import qualified Data.Map as M
 import Distribution.Client.Errors
 import Distribution.Client.HttpUtils
@@ -208,10 +207,6 @@ import Distribution.Simple.Utils
   , warn
   )
 import Distribution.Solver.Types.ConstraintSource
-import Distribution.System
-  ( OS (Windows)
-  , buildOS
-  )
 import Distribution.Utils.Path (getSymbolicPath, unsafeMakeSymbolicPath)
 import Distribution.Verbosity
   ( normal
@@ -220,7 +215,6 @@ import Network.URI
   ( URI (..)
   , URIAuth (..)
   , parseURI
-  , uriToString
   )
 import System.Directory
   ( XdgDirectory (XdgCache, XdgConfig, XdgState)
@@ -240,11 +234,6 @@ import System.FilePath
 import System.IO.Error
   ( isDoesNotExistError
   )
-import System.URI.File
-  ( FileURI (..)
-  , ParseSyntax (..)
-  , parseFileURI
-  )
 import Text.PrettyPrint
   ( ($+$)
   )
@@ -1060,12 +1049,12 @@ readConfigFile initial file =
         else ioError ioe
 
 createDefaultConfigFile :: Verbosity -> [String] -> FilePath -> IO SavedConfig
-createDefaultConfigFile verbosity extraLines filepath = do
+createDefaultConfigFile verbosity extraLines filePath = do
   commentConf <- commentSavedConfig
   initialConf <- initialSavedConfig
   extraConf <- parseExtraLines verbosity extraLines
-  notice verbosity $ "Writing default configuration to " ++ filepath
-  writeConfigFile filepath commentConf (initialConf `mappend` extraConf)
+  notice verbosity $ "Writing default configuration to " ++ filePath
+  writeConfigFile filePath commentConf (initialConf `mappend` extraConf)
   return initialConf
 
 writeConfigFile :: FilePath -> SavedConfig -> SavedConfig -> IO ()
@@ -1703,18 +1692,8 @@ postProcessRepo lineno reponameStr repo0 = do
     -- TODO: check that there are no authority, query or fragment
     -- Note: the trailing colon is important
     "file+noindex:" -> do
-      -- defer to file-uri package which is more accurate when parsing Windows
-      -- paths
-      let uri' = BS8.pack $ "file:" ++ uriToString id ((remoteRepoURI repo0) { uriScheme = "" }) []
-      case parseFileURI (if buildOS == Windows then ExtendedWindows else ExtendedPosix) uri' of
-        Left{} -> fail $ "Invalid path in URI: " <> show (remoteRepoURI repo0)
-        Right uri'' ->
-            return
-          $ Left
-          $ LocalRepo
-              reponame
-              (BS8.unpack $ filePath uri'')
-              (uriFragment (remoteRepoURI repo0) == "#shared-cache")
+      let uri = remoteRepoURI repo0
+      return $ Left $ LocalRepo reponame (uriPath uri) (uriFragment uri == "#shared-cache")
     _ -> do
       let repo = repo0{remoteRepoName = reponame}
 

cabal-install/src/Distribution/Client/GlobalFlags.hs

@@ -69,7 +69,7 @@ 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 as FilePath
+import qualified System.FilePath.Posix as FilePath.Posix
 
 -- ------------------------------------------------------------
 
@@ -192,9 +192,9 @@ withRepoContext'
   ignoreExpiry
   extraPaths = \callback -> do
     for_ localNoIndexRepos $ \local ->
-      unless (FilePath.isAbsolute (localRepoPath local)) $
+      unless (FilePath.Posix.isAbsolute (localRepoPath local)) $
         warn verbosity $
-          "file+noindex " ++ unRepoName (localRepoName local) ++ " repository path (" ++ show (localRepoPath local) ++ ")  is not absolute; this is fragile, and not recommended"
+          "file+noindex " ++ unRepoName (localRepoName local) ++ " repository path is not absolute; this is fragile, and not recommended"
 
     transportRef <- newMVar Nothing
     let httpLib =

cabal-install/src/Distribution/Client/IndexUtils.hs

@@ -142,7 +142,7 @@ import Distribution.Compat.Directory (listDirectory)
 import Distribution.Compat.Time (getFileAge, getModTime)
 import Distribution.Utils.Generic (fstOf3)
 import Distribution.Utils.Structured (Structured (..), nominalStructure, structuredDecodeFileOrFail, structuredEncodeFile)
-import System.Directory (doesDirectoryExist, doesFileExist, makeAbsolute)
+import System.Directory (doesDirectoryExist, doesFileExist)
 import System.FilePath
   ( normalise
   , splitDirectories
@@ -900,9 +900,7 @@ withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo nam
             entries
         case tarballPackageDescription of
           Just ce -> return (Just ce)
-          Nothing -> do
-            tarFile' <- makeAbsolute tarFile
-            dieWithException verbosity $ CannotReadCabalFile expectFilename tarFile'
+          Nothing -> dieWithException verbosity $ CannotReadCabalFile expectFilename tarFile
 
   let (prefs, gpds) =
         partitionEithers $
@@ -977,8 +975,7 @@ withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo nam
                     -- Here we show the _failure_ to parse the `.cabal` file as
                     -- a warning. This will impact which versions/packages are
                     -- available in your index, so users should know!
-                    tarFile' <- makeAbsolute tarFile
-                    warn verbosity $ "In " <> tarFile' <> ": " <> displayException exception
+                    warn verbosity $ "In " <> tarFile <> ": " <> displayException exception
                     pure Nothing
                   Right genericPackageDescription ->
                     pure $ Just $ CacheGPD genericPackageDescription bytes

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

@@ -46,6 +46,24 @@ 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 \\.
   . (if buildOS == Windows then resub "([A-Z]):\\\\" "\\\\" else id)
   . appEndo (F.fold (map (Endo . packageIdRegex) (normalizerKnownPackages nenv)))

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

@@ -608,15 +608,11 @@ withRepoNoUpdate repo_dir m = do
     withReaderT (\env' -> env' { testHaveRepo = True }) m
     -- TODO: Arguably should undo everything when we're done...
   where
-    repoUri env ="file+noindex://"
-      ++ (if isWindows
-           -- Windows paths need a preceeding slash to be compliant with file
-           -- URI RFCs (8089 and 3986). In particular to be an instance of
-           -- @path-absolute@.
-           then ('/' :) . map (\x -> case x of
-                                       '\\' -> '/'
-                                       _ -> x)
-           else id) (testRepoDir env)
+    repoUri env ="file+noindex://" ++ (if isWindows
+                                        then map (\x -> case x of
+                                            '\\' -> '/'
+                                            _ -> x)
+                                        else id) (testRepoDir env)
 
 -- | Given a directory (relative to the 'testCurrentDir') containing
 -- a series of directories representing packages, generate an

doc/config.rst

@@ -198,9 +198,7 @@ repository.
 
 ``cabal`` will construct the index automatically from the
 ``package-name-version.tar.gz`` files in the directory, and will use optional
-corresponding ``package-name-version.cabal`` files as new revisions. Note that
-Windows should use three slashes too, as in
-``file+noindex:///C:/absolute/path/to/directory``.
+corresponding ``package-name-version.cabal`` files as new revisions.
 
 For example, if ``/absolute/path/to/directory`` looks like
 ::