505f1a654b
AbsRel depends on unix, but Utility.Path.Windows will be used in some libraries that are part of the setup-depends, which cannot depend on unix. The only reason that AbsRel uses getWorkingDirectory on unix is that it returns RawFilePath. getCurrentDirectory returns FilePath and so needs a conversion to RawFilePath. Looks like a newer version of directory will fix that, by using OsPath, so eventually AbsPath should be able to switch to using getCurrentDirectory on unix, and then the small code duplication in this commit won't be needed. Sponsored-by: Dartmouth College's Datalad project
47 lines
1.5 KiB
Haskell
47 lines
1.5 KiB
Haskell
{- Windows paths
|
|
-
|
|
- Copyright 2022-2023 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
|
|
|
module Utility.Path.Windows (
|
|
convertToWindowsNativeNamespace
|
|
) where
|
|
|
|
import Utility.Path
|
|
import Utility.FileSystemEncoding
|
|
|
|
import System.FilePath.ByteString (RawFilePath, combine)
|
|
import qualified Data.ByteString as B
|
|
import qualified System.FilePath.Windows.ByteString as P
|
|
import System.Directory (getCurrentDirectory)
|
|
|
|
{- Convert a filepath to use Windows's native namespace.
|
|
- This avoids filesystem length limits.
|
|
-
|
|
- This is similar to the way base converts filenames on windows,
|
|
- but as that is implemented in C (create_device_name) and not
|
|
- exported, it cannot be used here. Several edge cases are not handled,
|
|
- including network shares and dos short paths.
|
|
-}
|
|
convertToWindowsNativeNamespace :: RawFilePath -> IO RawFilePath
|
|
convertToWindowsNativeNamespace f
|
|
| win32_dev_namespace `B.isPrefixOf` f = return f
|
|
| win32_file_namespace `B.isPrefixOf` f = return f
|
|
| nt_device_namespace `B.isPrefixOf` f = return f
|
|
| otherwise = do
|
|
-- Make absolute because any '.' and '..' in the path
|
|
-- will not be resolved once it's converted.
|
|
cwd <- toRawFilePath <$> getCurrentDirectory
|
|
let p = simplifyPath (combine cwd f)
|
|
-- Normalize slashes.
|
|
let p' = P.normalise p
|
|
return (win32_file_namespace <> p')
|
|
where
|
|
win32_dev_namespace = "\\\\.\\"
|
|
win32_file_namespace = "\\\\?\\"
|
|
nt_device_namespace = "\\Device\\"
|