{-# LINE 1 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
{-# LANGUAGE CPP #-}
module System.Directory.Internal.Windows where


{-# LINE 5 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
#if defined i386_HOST_ARCH
# define WINAPI stdcall
#elif defined x86_64_HOST_ARCH
# define WINAPI ccall
#else
# error unknown architecture
#endif



{-# LINE 15 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}


{-# LINE 17 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
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

{-# LINE 24 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
win32_cSIDL_LOCAL_APPDATA = Win32.cSIDL_LOCAL_APPDATA

{-# LINE 28 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_fILE_ATTRIBUTE_REPARSE_POINT :: Win32.FileAttributeOrFlag
win32_fILE_ATTRIBUTE_REPARSE_POINT = (1024)
{-# LINE 31 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_fILE_SHARE_DELETE :: Win32.ShareMode

{-# LINE 34 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
win32_fILE_SHARE_DELETE = Win32.fILE_SHARE_DELETE -- added in 2.3.0.2

{-# LINE 38 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_getLongPathName, win32_getShortPathName :: FilePath -> IO FilePath

{-# LINE 41 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
win32_getLongPathName = Win32.getLongPathName
win32_getShortPathName = Win32.getShortPathName

{-# LINE 70 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_getFinalPathNameByHandle :: Win32.HANDLE -> Win32.DWORD -> IO FilePath
win32_getFinalPathNameByHandle _h _flags =
  modifyIOError (`ioeSetLocation` "GetFinalPathNameByHandle") $ do

{-# LINE 87 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
    throwIO (mkIOError UnsupportedOperation
             "platform does not support GetFinalPathNameByHandle"
             Nothing Nothing)

{-# LINE 91 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

getFinalPathName :: FilePath -> IO FilePath
getFinalPathName =
  (fromExtendedLengthPath <$>) . rawGetFinalPathName . toExtendedLengthPath
  where

{-# LINE 107 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
    rawGetFinalPathName = win32_getLongPathName <=< win32_getShortPathName

{-# LINE 109 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

-- | Add the @"\\\\?\\"@ prefix if necessary or possible.
-- The path remains unchanged if the prefix is not added.
toExtendedLengthPath :: FilePath -> FilePath
toExtendedLengthPath path
  | isRelative path = path
  | otherwise =
      case normalise path of
        -- note: as of filepath-1.4.1.0 normalise doesn't honor \\?\
        -- https://github.com/haskell/filepath/issues/56
        -- this means we cannot trust the result of normalise on
        -- paths that start with \\?\
        '\\' : '\\' : '?' : '\\' : _ -> path
        '\\' : '\\' : '.' : '\\' : _ -> path
        '\\' : subpath@('\\' : _) -> "\\\\?\\UNC" <> subpath
        normalisedPath -> "\\\\?\\" <> normalisedPath

-- | Strip the @"\\\\?\\"@ prefix if possible.
-- The prefix is kept if the meaning of the path would otherwise change.
fromExtendedLengthPath :: FilePath -> FilePath
fromExtendedLengthPath ePath =
  case ePath of
    '\\' : '\\' : '?' : '\\' : path ->
      case path of
        'U' : 'N' : 'C' : subpath@('\\' : _) -> "\\" <> subpath
        drive : ':' : subpath
          -- if the path is not "regular", then the prefix is necessary
          -- to ensure the path is interpreted literally
          | 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)))
{-# LINE 155 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
  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)
{-# LINE 169 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

s_IWUSR :: CMode
s_IWUSR = (128)
{-# LINE 172 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

s_IXUSR :: CMode
s_IXUSR = (64)
{-# LINE 175 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

s_IFDIR :: CMode
s_IFDIR = (16384)
{-# LINE 178 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}


{-# LINE 180 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}