Merge pull request #5266 from commercialhaskell/fix-replace-extension

Work around replaceExtension semantic change

Author: snoyberg

src/Path/Extended.hs

@@ -33,9 +33,8 @@ replaceExtension :: MonadThrow m
   => String
   -> Path b File
   -> m (Path b File)
-replaceExtension =
 #if MIN_VERSION_path(0,7,0)
-    Path.replaceExtension
+replaceExtension ext = Path.replaceExtension ('.' : ext)
 #else
-    flip (Path.-<.>)
+replaceExtension = flip (Path.-<.>)
 #endif

src/Stack/Docker.hs

@@ -41,12 +41,7 @@ import qualified Data.Text.Encoding as T
 import           Data.Time (UTCTime)
 import qualified Data.Version (showVersion, parseVersion)
 import           Distribution.Version (mkVersion, mkVersion')
-#if MIN_VERSION_path(0,7,0)
-import           Path hiding (replaceExtension)
-#else
 import           Path
-#endif
-import           Path.Extended (replaceExtension)
 import           Path.Extra (toFilePathNoTrailingSep)
 import           Path.IO hiding (canonicalizePath)
 import qualified Paths_stack as Meta
@@ -156,7 +151,17 @@ getCmdArgs docker imageInfo isRemoteDocker = do
         exePath <- ensureDockerStackExe dockerContainerPlatform
         cmdArgs args exePath
     cmdArgs args exePath = do
-        exeBase <- replaceExtension "" exePath
+        -- MSS 2020-04-21 previously used replaceExtension, but semantics changed in path 0.7
+        -- In any event, I'm not even sure _why_ we need to drop a file extension here
+        -- Originally introduced here: https://github.com/commercialhaskell/stack/commit/6218dadaf5fd7bf312bb1bd0db63b4784ba78cb2
+#if MIN_VERSION_path(0, 7, 0)
+        let exeBase =
+              case splitExtension exePath of
+                Left _ -> exePath
+                Right (x, _) -> x
+#else
+        exeBase <- exePath -<.> ""
+#endif
         let mountPath = hostBinDir FP.</> toFilePath (filename exeBase)
         return (mountPath, args, [], [Mount (toFilePath exePath) mountPath])