module System.Directory.Internal.Windows where
#if defined i386_HOST_ARCH
# define WINAPI stdcall
#elif defined x86_64_HOST_ARCH
# define WINAPI ccall
#else
# error unknown architecture
#endif
import Prelude ()
import System.Directory.Internal.Prelude
import System.FilePath (isRelative, normalise, splitDirectories)
import qualified System.Win32 as Win32
win32_cSIDL_LOCAL_APPDATA :: Win32.CSIDL
win32_cSIDL_LOCAL_APPDATA = Win32.cSIDL_LOCAL_APPDATA
win32_fILE_ATTRIBUTE_REPARSE_POINT :: Win32.FileAttributeOrFlag
win32_fILE_ATTRIBUTE_REPARSE_POINT = (1024)
win32_fILE_SHARE_DELETE :: Win32.ShareMode
win32_fILE_SHARE_DELETE = Win32.fILE_SHARE_DELETE
win32_getLongPathName, win32_getShortPathName :: FilePath -> IO FilePath
win32_getLongPathName = Win32.getLongPathName
win32_getShortPathName = Win32.getShortPathName
win32_getFinalPathNameByHandle :: Win32.HANDLE -> Win32.DWORD -> IO FilePath
win32_getFinalPathNameByHandle _h _flags =
modifyIOError (`ioeSetLocation` "GetFinalPathNameByHandle") $ do
throwIO (mkIOError UnsupportedOperation
"platform does not support GetFinalPathNameByHandle"
Nothing Nothing)
getFinalPathName :: FilePath -> IO FilePath
getFinalPathName =
(fromExtendedLengthPath <$>) . rawGetFinalPathName . toExtendedLengthPath
where
rawGetFinalPathName = win32_getLongPathName <=< win32_getShortPathName
toExtendedLengthPath :: FilePath -> FilePath
toExtendedLengthPath path
| isRelative path = path
| otherwise =
case normalise path of
'\\' : '\\' : '?' : '\\' : _ -> path
'\\' : '\\' : '.' : '\\' : _ -> path
'\\' : subpath@('\\' : _) -> "\\\\?\\UNC" <> subpath
normalisedPath -> "\\\\?\\" <> normalisedPath
fromExtendedLengthPath :: FilePath -> FilePath
fromExtendedLengthPath ePath =
case ePath of
'\\' : '\\' : '?' : '\\' : path ->
case path of
'U' : 'N' : 'C' : subpath@('\\' : _) -> "\\" <> subpath
drive : ':' : subpath
| isAlpha drive && isAscii drive && isPathRegular subpath -> path
_ -> ePath
_ -> ePath
where
isPathRegular path =
not ('/' `elem` path ||
"." `elem` splitDirectories path ||
".." `elem` splitDirectories path)
getPathNameWith :: (Ptr CWchar -> Win32.DWORD -> IO Win32.DWORD) -> IO FilePath
getPathNameWith cFunc = do
let getPathNameWithLen len = do
allocaArray (fromIntegral len) $ \ ptrPathOut -> do
len' <- Win32.failIfZero "" (cFunc ptrPathOut len)
if len' <= len
then Right <$> peekCWStringLen (ptrPathOut, fromIntegral len')
else pure (Left len')
r <- getPathNameWithLen ((260) * ((2)))
case r of
Right s -> pure s
Left len -> do
r' <- getPathNameWithLen len
case r' of
Right s -> pure s
Left _ -> ioError (mkIOError OtherError "" Nothing Nothing
`ioeSetErrorString` "path changed unexpectedly")
foreign import ccall unsafe "_wchmod"
c_wchmod :: CWString -> CMode -> IO CInt
s_IRUSR :: CMode
s_IRUSR = (256)
s_IWUSR :: CMode
s_IWUSR = (128)
s_IXUSR :: CMode
s_IXUSR = (64)
s_IFDIR :: CMode
s_IFDIR = (16384)