Added new toMSYS2Path function for use with rsync on Windows.

This commit is contained in:
Pieter Kitslaar 2016-01-11 11:18:58 +01:00
parent 4caaa15f76
commit 6cd134ade1
2 changed files with 28 additions and 3 deletions

View file

@ -271,6 +271,31 @@ toCygPath p
| otherwise = s | otherwise = s
#endif #endif
{- Converts a DOS style path to a msys2 style path. Only on Windows.
- Any trailing '\' is preserved as a trailing '/'
-
- Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i
-
- The virtual filesystem contains:
- /c, /d, ... mount points for Windows drives
-}
toMSYS2Path :: FilePath -> FilePath
#ifndef mingw32_HOST_OS
toMSYS2Path = id
#else
toMSYS2Path p
| null drive = recombine parts
| otherwise = recombine $ "/" : driveletter drive : parts
where
(drive, p') = splitDrive p
parts = splitDirectories p'
driveletter = map toLower . takeWhile (/= ':')
recombine = fixtrailing . Posix.joinPath
fixtrailing s
| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s
| otherwise = s
#endif
{- Maximum size to use for a file in a specified directory. {- Maximum size to use for a file in a specified directory.
- -
- Many systems have a 255 byte limit to the name of a file, - Many systems have a 255 byte limit to the name of a file,

View file

@ -54,16 +54,16 @@ rsyncUseDestinationPermissions = Param "--chmod=ugo=rwX"
rsync :: [CommandParam] -> IO Bool rsync :: [CommandParam] -> IO Bool
rsync = boolSystem "rsync" . rsyncParamsFixup rsync = boolSystem "rsync" . rsyncParamsFixup
{- On Windows, rsync is from Cygwin, and expects to get Cygwin formatted {- On Windows, rsync is from msys2, and expects to get msys2 formatted
- paths to files. (It thinks that C:foo refers to a host named "C"). - paths to files. (It thinks that C:foo refers to a host named "C").
- Fix up the Params appropriately. -} - Fix up the Params appropriately. -}
rsyncParamsFixup :: [CommandParam] -> [CommandParam] rsyncParamsFixup :: [CommandParam] -> [CommandParam]
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
rsyncParamsFixup = map fixup rsyncParamsFixup = map fixup
where where
fixup (File f) = File (toCygPath f) fixup (File f) = File (toMSYS2Path f)
fixup (Param s) fixup (Param s)
| rsyncUrlIsPath s = Param (toCygPath s) | rsyncUrlIsPath s = Param (toMSYS2Path s)
fixup p = p fixup p = p
#else #else
rsyncParamsFixup = id rsyncParamsFixup = id