Added new toMSYS2Path function for use with rsync on Windows.
This commit is contained in:
parent
4caaa15f76
commit
6cd134ade1
2 changed files with 28 additions and 3 deletions
|
@ -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,
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue