[WIP] Use the directory package to create new-install symlinks

cabal-install/Distribution/Client/InstallSymlink.hs

@@ -17,36 +17,6 @@ module Distribution.Client.InstallSymlink (
     symlinkBinary,
   ) where
 
-#ifdef mingw32_HOST_OS
-
-import Distribution.Package (PackageIdentifier)
-import Distribution.Types.UnqualComponentName
-import Distribution.Client.InstallPlan (InstallPlan)
-import Distribution.Client.Types (BuildOutcomes)
-import Distribution.Client.Setup (InstallFlags)
-import Distribution.Simple.Setup (ConfigFlags)
-import Distribution.Simple.Compiler
-import Distribution.System
-
-data OverwritePolicy = NeverOverwrite | AlwaysOverwrite
-  deriving (Show, Eq)
-
-symlinkBinaries :: Platform -> Compiler
-                -> OverwritePolicy
-                -> ConfigFlags
-                -> InstallFlags
-                -> InstallPlan
-                -> BuildOutcomes
-                -> IO [(PackageIdentifier, UnqualComponentName, FilePath)]
-symlinkBinaries _ _ _ _ _ _ _ = return []
-
-symlinkBinary :: OverwritePolicy
-              -> FilePath -> FilePath -> UnqualComponentName -> String
-              -> IO Bool
-symlinkBinary _ _ _ _ _ = fail "Symlinking feature not available on Windows"
-
-#else
-
 import Distribution.Client.Types
          ( ConfiguredPackage(..), BuildOutcomes )
 import Distribution.Client.Setup
@@ -67,23 +37,23 @@ import Distribution.PackageDescription
          ( PackageDescription )
 import Distribution.PackageDescription.Configuration
          ( finalizePD )
+import Distribution.Simple.BuildPaths
+         ( exeExtension )
 import Distribution.Simple.Setup
          ( ConfigFlags(..), fromFlag, fromFlagOrDefault, flagToMaybe )
 import qualified Distribution.Simple.InstallDirs as InstallDirs
 import Distribution.Simple.Compiler
          ( Compiler, compilerInfo, CompilerInfo(..) )
 import Distribution.System
-         ( Platform )
+         ( Platform, buildPlatform )
 import Distribution.Text
          ( display )
 
-import System.Posix.Files
-         ( getSymbolicLinkStatus, isSymbolicLink, createSymbolicLink
-         , removeLink )
 import System.Directory
-         ( canonicalizePath )
+         ( createFileLink, pathIsSymbolicLink
+         , canonicalizePath, removeFile, pathIsSymbolicLink )
 import System.FilePath
-         ( (</>), splitPath, joinPath, isAbsolute )
+         ( (<.>), (</>), splitPath, joinPath, isAbsolute )
 
 import Prelude hiding (ioError)
 import System.IO.Error
@@ -216,7 +186,7 @@ symlinkBinary ::
                          --   propagate as exceptions.
 symlinkBinary overwritePolicy publicBindir privateBindir publicName privateName = do
   ok <- targetOkToOverwrite (publicBindir </> publicName')
-                            (privateBindir </> privateName)
+                            (privateBindir </> privateName')
   case ok of
     NotExists         ->           mkLink >> return True
     OkToOverwrite     -> rmLink >> mkLink >> return True
@@ -225,11 +195,12 @@ symlinkBinary overwritePolicy publicBindir privateBindir publicName privateName
         NeverOverwrite  ->                     return False
         AlwaysOverwrite -> rmLink >> mkLink >> return True
   where
-    publicName' = display publicName
+    publicName' = display publicName <.> exeExtension buildPlatform
+    privateName' = privateName <.> exeExtension buildPlatform
     relativeBindir = makeRelative publicBindir privateBindir
-    mkLink = createSymbolicLink (relativeBindir </> privateName)
-                                (publicBindir   </> publicName')
-    rmLink = removeLink (publicBindir </> publicName')
+    mkLink = createFileLink (relativeBindir </> privateName')
+                            (publicBindir   </> publicName')
+    rmLink = removeFile (publicBindir </> publicName')
 
 -- | Check a file path of a symlink that we would like to create to see if it
 -- is OK. For it to be OK to overwrite it must either not already exist yet or
@@ -241,8 +212,8 @@ targetOkToOverwrite :: FilePath -- ^ The file path of the symlink to the private
                                 -- Use 'canonicalizePath' to make this.
                     -> IO SymlinkStatus
 targetOkToOverwrite symlink target = handleNotExist $ do
-  status <- getSymbolicLinkStatus symlink
-  if not (isSymbolicLink status)
+  isLink <- pathIsSymbolicLink symlink
+  if not isLink
     then return NotOurFile
     else do target' <- canonicalizePath symlink
             -- This relies on canonicalizePath handling symlinks
@@ -276,5 +247,3 @@ makeRelative a b = assert (isAbsolute a && isAbsolute b) $
       commonLen = length $ takeWhile id $ zipWith (==) as bs
    in joinPath $ [ ".." | _  <- drop commonLen as ]
               ++ drop commonLen bs
-
-#endif

cabal-install/bootstrap.sh

@@ -268,6 +268,8 @@ DIGEST_VER="0.0.1.2"; DIGEST_REGEXP="0\.0\.(1\.[2-9]|[2-9]\.?)"
                        # >= 0.0.1.2 && < 0.1
 ZIP_ARCHIVE_VER="0.3.3"; ZIP_ARCHIVE_REGEXP="0\.3\.[3-9]"
                        # >= 0.3.3 && < 0.4
+DIRECTORY_VER="1.3.1.0"; DIRECTORY_REGEXP="1\.3\.[1-9]\.?"
+                       # >= 1.3.1.0 && < 1.4
 
 HACKAGE_URL="https://hackage.haskell.org/package"
 
@@ -474,10 +476,12 @@ info_pkg "digest"            ${DIGEST_VER}           ${DIGEST_REGEXP}
 info_pkg "zip-archive"       ${ZIP_ARCHIVE_VER}      ${ZIP_ARCHIVE_REGEXP}
 info_pkg "hackage-security"  ${HACKAGE_SECURITY_VER} \
     ${HACKAGE_SECURITY_VER_REGEXP}
+info_pkg "directory"     ${DIRECTORY_VER}      ${DIRECTORY_REGEXP}
 
-do_pkg   "deepseq"      ${DEEPSEQ_VER} ${DEEPSEQ_VER_REGEXP}
-do_pkg   "binary"       ${BINARY_VER}  ${BINARY_VER_REGEXP}
-do_pkg   "time"         ${TIME_VER}    ${TIME_VER_REGEXP}
+do_pkg   "directory"    ${DIRECTORY_VER} ${DIRECTORY_REGEXP}
+do_pkg   "deepseq"      ${DEEPSEQ_VER}   ${DEEPSEQ_VER_REGEXP}
+do_pkg   "binary"       ${BINARY_VER}    ${BINARY_VER_REGEXP}
+do_pkg   "time"         ${TIME_VER}      ${TIME_VER_REGEXP}
 
 # Cabal might depend on these
 do_pkg   "transformers" ${TRANS_VER}   ${TRANS_VER_REGEXP}

cabal-install/cabal-install.cabal

@@ -307,7 +307,7 @@ executable cabal
         containers >= 0.5      && < 0.7,
         cryptohash-sha256 >= 0.11 && < 0.12,
         deepseq    >= 1.3      && < 1.5,
-        directory  >= 1.2.2.0  && < 1.4,
+        directory  >= 1.3.1.0  && < 1.4,
         echo       >= 0.1.3    && < 0.2,
         edit-distance >= 0.2.2 && < 0.3,
         filepath   >= 1.3      && < 1.5,

cabal-install/cabal-install.cabal.pp

@@ -26,7 +26,7 @@
         containers >= 0.5      && < 0.7,
         cryptohash-sha256 >= 0.11 && < 0.12,
         deepseq    >= 1.3      && < 1.5,
-        directory  >= 1.2.2.0  && < 1.4,
+        directory  >= 1.3.1.0  && < 1.4,
         echo       >= 0.1.3    && < 0.2,
         edit-distance >= 0.2.2 && < 0.3,
         filepath   >= 1.3      && < 1.5,