{-# 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) || defined(aarch64_HOST_ARCH)
# define WINAPI ccall
#else
# error unknown architecture
#endif




import Prelude ()
import System.Directory.Internal.Prelude
import System.Directory.Internal.Common
import System.Directory.Internal.Config (exeExtension)
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)

{-# LINE 25 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
import System.OsPath
  ( (</>)
  , isPathSeparator
  , isRelative
  , pack
  , pathSeparator
  , splitDirectories
  , splitSearchPath
  , takeExtension
  , toChar
  , unpack
  )
import System.OsPath.Types (WindowsPath, WindowsString)
import System.OsString.Internal.Types (OsString(OsString, getOsString))
import qualified Data.List as List
import qualified System.Win32.WindowsString.File as Win32
import qualified System.Win32.WindowsString.Info as Win32
import qualified System.Win32.WindowsString.Shell as Win32
import qualified System.Win32.WindowsString.Time as Win32
import qualified System.Win32.WindowsString.Types as Win32
import qualified System.Win32.WindowsString.Console as Win32

type RawHandle = OsPath

pathAt :: Maybe RawHandle -> OsPath -> OsPath
pathAt :: Maybe OsString -> OsString -> OsString
pathAt Maybe OsString
dir OsString
path = OsString -> Maybe OsString -> OsString
forall a. a -> Maybe a -> a
fromMaybe OsString
forall a. Monoid a => a
mempty Maybe OsString
dir OsString -> OsString -> OsString
</> OsString
path

openRaw :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO RawHandle
openRaw :: WhetherFollow -> Maybe OsString -> OsString -> IO OsString
openRaw WhetherFollow
_ Maybe OsString
dir OsString
path = OsString -> IO OsString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe OsString -> OsString -> OsString
pathAt Maybe OsString
dir OsString
path)

closeRaw :: RawHandle -> IO ()
closeRaw :: OsString -> IO ()
closeRaw OsString
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

lookupEnvOs :: OsString -> IO (Maybe OsString)
lookupEnvOs :: OsString -> IO (Maybe OsString)
lookupEnvOs (OsString PlatformString
name) = (PlatformString -> OsString
OsString (PlatformString -> OsString)
-> Maybe PlatformString -> Maybe OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe PlatformString -> Maybe OsString)
-> IO (Maybe PlatformString) -> IO (Maybe OsString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlatformString -> IO (Maybe PlatformString)
Win32.getEnv PlatformString
name

getEnvOs :: OsString -> IO OsString
getEnvOs :: OsString -> IO OsString
getEnvOs OsString
name = do
  env <- OsString -> IO (Maybe OsString)
lookupEnvOs OsString
name
  case env of
    Maybe OsString
Nothing ->
      IOException -> IO OsString
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOException -> IO OsString) -> IOException -> IO OsString
forall a b. (a -> b) -> a -> b
$
        IOErrorType
-> [Char] -> Maybe Handle -> Maybe [Char] -> IOException
mkIOError
          IOErrorType
doesNotExistErrorType
          ([Char]
"env var " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> OsString -> [Char]
forall a. Show a => a -> [Char]
show OsString
name [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" not found")
          Maybe Handle
forall a. Maybe a
Nothing
          Maybe [Char]
forall a. Maybe a
Nothing
    Just OsString
value -> OsString -> IO OsString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
value

-- | Get the contents of the @PATH@ environment variable.

getPath :: IO [OsPath]
getPath :: IO [OsString]
getPath = OsString -> [OsString]
splitSearchPath (OsString -> [OsString]) -> IO OsString -> IO [OsString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsString -> IO OsString
getEnvOs ([Char] -> OsString
os [Char]
"PATH")

createDirectoryInternal :: OsPath -> IO ()
createDirectoryInternal :: OsString -> IO ()
createDirectoryInternal OsString
path =
  (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
path) (IOException -> IOException) -> IO () -> IO ()
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
    path' <- OsString -> IO PlatformString
furnishPath OsString
path
    Win32.createDirectory path' Nothing

removePathAt :: FileType -> Maybe RawHandle -> OsPath -> IO ()
removePathAt :: FileType -> Maybe OsString -> OsString -> IO ()
removePathAt FileType
ty Maybe OsString
dir OsString
path = Bool -> OsString -> IO ()
removePathInternal Bool
isDir (Maybe OsString -> OsString -> OsString
pathAt Maybe OsString
dir OsString
path)
  where isDir :: Bool
isDir = FileType -> Bool
fileTypeIsDirectory FileType
ty

removePathInternal :: Bool -> OsPath -> IO ()
removePathInternal :: Bool -> OsString -> IO ()
removePathInternal Bool
isDir OsString
path =
  (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
path) (IOException -> IOException) -> IO () -> IO ()
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
    OsString -> IO PlatformString
furnishPath OsString
path
      IO PlatformString -> (PlatformString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= if Bool
isDir then PlatformString -> IO ()
Win32.removeDirectory else PlatformString -> IO ()
Win32.deleteFile

renamePathInternal :: OsPath -> OsPath -> IO ()
renamePathInternal :: OsString -> OsString -> IO ()
renamePathInternal OsString
opath OsString
npath =
  (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
opath) (IOException -> IOException) -> IO () -> IO ()
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
    opath' <- OsString -> IO PlatformString
furnishPath OsString
opath
    npath' <- furnishPath npath
    Win32.moveFileEx opath' (Just npath') Win32.mOVEFILE_REPLACE_EXISTING

-- On Windows, the removability of a file may be affected by the attributes of

-- the file itself.

filesAlwaysRemovable :: Bool
filesAlwaysRemovable :: Bool
filesAlwaysRemovable = Bool
False

copyFileWithMetadataInternal :: (Metadata -> OsPath -> IO ())
                             -> (Metadata -> OsPath -> IO ())
                             -> OsPath
                             -> OsPath
                             -> IO ()
copyFileWithMetadataInternal :: (Metadata -> OsString -> IO ())
-> (Metadata -> OsString -> IO ()) -> OsString -> OsString -> IO ()
copyFileWithMetadataInternal Metadata -> OsString -> IO ()
_ Metadata -> OsString -> IO ()
_ OsString
src OsString
dst =
  (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
src) (IOException -> IOException) -> IO () -> IO ()
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
    src' <- OsString -> IO PlatformString
furnishPath OsString
src
    dst' <- furnishPath dst
    Win32.copyFile src' dst' False

win32_cSIDL_COMMON_APPDATA :: Win32.CSIDL
win32_cSIDL_COMMON_APPDATA :: CInt
win32_cSIDL_COMMON_APPDATA = (CInt
35)
{-# LINE 119 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_eRROR_ENVVAR_NOT_FOUND :: Win32.ErrCode
win32_eRROR_ENVVAR_NOT_FOUND :: Word32
win32_eRROR_ENVVAR_NOT_FOUND = (Word32
203)
{-# LINE 122 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_eRROR_INVALID_FUNCTION :: Win32.ErrCode
win32_eRROR_INVALID_FUNCTION :: Word32
win32_eRROR_INVALID_FUNCTION = (Word32
1)
{-# LINE 125 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_eRROR_INVALID_PARAMETER :: Win32.ErrCode
win32_eRROR_INVALID_PARAMETER :: Word32
win32_eRROR_INVALID_PARAMETER = (Word32
87)
{-# LINE 128 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_eRROR_PRIVILEGE_NOT_HELD :: Win32.ErrCode
win32_eRROR_PRIVILEGE_NOT_HELD :: Word32
win32_eRROR_PRIVILEGE_NOT_HELD = (Word32
1314)
{-# LINE 131 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_sYMBOLIC_LINK_FLAG_DIRECTORY :: Win32.DWORD
win32_sYMBOLIC_LINK_FLAG_DIRECTORY :: Word32
win32_sYMBOLIC_LINK_FLAG_DIRECTORY = Word32
0x1

win32_sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE :: Win32.DWORD
win32_sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE :: Word32
win32_sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE = Word32
0x2

maxShareMode :: Win32.ShareMode
maxShareMode :: Word32
maxShareMode =
  Word32
Win32.fILE_SHARE_DELETE Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  Word32
Win32.fILE_SHARE_READ   Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  Word32
Win32.fILE_SHARE_WRITE

win32_getFinalPathNameByHandle :: Win32.HANDLE -> Win32.DWORD -> IO WindowsPath

{-# LINE 146 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
win32_getFinalPathNameByHandle h flags = do
  result <- peekTStringWith (260) $ \ ptr len -> do
{-# LINE 148 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
    c_GetFinalPathNameByHandle h ptr len flags
  case result of
    Left errCode -> Win32.failWith "GetFinalPathNameByHandle" errCode
    Right path -> pure path

foreign import WINAPI unsafe "windows.h GetFinalPathNameByHandleW"
  c_GetFinalPathNameByHandle
    :: Win32.HANDLE
    -> Ptr CWchar
    -> Win32.DWORD
    -> Win32.DWORD
    -> IO Win32.DWORD


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

getFinalPathName :: OsPath -> IO OsPath
getFinalPathName :: OsString -> IO OsString
getFinalPathName =
  (PlatformString -> OsString
fromExtendedLengthPath (PlatformString -> OsString) -> IO PlatformString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PlatformString -> IO OsString)
-> (OsString -> IO PlatformString) -> OsString -> IO OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  PlatformString -> IO PlatformString
rawGetFinalPathName (PlatformString -> IO PlatformString)
-> (OsString -> PlatformString) -> OsString -> IO PlatformString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  OsString -> PlatformString
toExtendedLengthPath
  where

{-# LINE 177 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
    rawGetFinalPathName path = do
      let open = Win32.createFile path 0 maxShareMode Nothing
                 Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing
      bracket open Win32.closeHandle $ \ h -> do
        win32_getFinalPathNameByHandle h 0

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

win32_fILE_FLAG_OPEN_REPARSE_POINT :: Win32.FileAttributeOrFlag
win32_fILE_FLAG_OPEN_REPARSE_POINT :: Word32
win32_fILE_FLAG_OPEN_REPARSE_POINT = Word32
0x00200000

win32_fSCTL_GET_REPARSE_POINT :: Win32.DWORD
win32_fSCTL_GET_REPARSE_POINT :: Word32
win32_fSCTL_GET_REPARSE_POINT = Word32
0x900a8

win32_iO_REPARSE_TAG_MOUNT_POINT, win32_iO_REPARSE_TAG_SYMLINK :: CULong
win32_iO_REPARSE_TAG_MOUNT_POINT :: CULong
win32_iO_REPARSE_TAG_MOUNT_POINT = (CULong
2684354563)
{-# LINE 194 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
win32_iO_REPARSE_TAG_SYMLINK = (2684354572)
{-# LINE 195 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE :: Win32.DWORD
win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE :: Word32
win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE =
  (Word32
16384)
{-# LINE 199 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_sYMLINK_FLAG_RELATIVE :: CULong
win32_sYMLINK_FLAG_RELATIVE :: CULong
win32_sYMLINK_FLAG_RELATIVE = CULong
0x00000001

data Win32_REPARSE_DATA_BUFFER
  = Win32_MOUNT_POINT_REPARSE_DATA_BUFFER WindowsString WindowsString
    -- ^ substituteName printName

  | Win32_SYMLINK_REPARSE_DATA_BUFFER WindowsString WindowsString Bool
    -- ^ substituteName printName isRelative

  | Win32_GENERIC_REPARSE_DATA_BUFFER

win32_alloca_REPARSE_DATA_BUFFER
  :: ((Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO a) -> IO a
win32_alloca_REPARSE_DATA_BUFFER :: forall a. ((Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO a) -> IO a
win32_alloca_REPARSE_DATA_BUFFER (Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO a
action =
  Int -> Int -> (Ptr Win32_REPARSE_DATA_BUFFER -> IO a) -> IO a
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned Int
size Int
align ((Ptr Win32_REPARSE_DATA_BUFFER -> IO a) -> IO a)
-> (Ptr Win32_REPARSE_DATA_BUFFER -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr Win32_REPARSE_DATA_BUFFER
ptr ->
    (Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO a
action (Ptr Win32_REPARSE_DATA_BUFFER
ptr, Int
size)
  where size :: Int
size = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE
        align :: Int
align = Int
4
{-# LINE 217 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}

win32_peek_REPARSE_DATA_BUFFER
  :: Ptr Win32_REPARSE_DATA_BUFFER -> IO Win32_REPARSE_DATA_BUFFER
win32_peek_REPARSE_DATA_BUFFER :: Ptr Win32_REPARSE_DATA_BUFFER -> IO Win32_REPARSE_DATA_BUFFER
win32_peek_REPARSE_DATA_BUFFER Ptr Win32_REPARSE_DATA_BUFFER
p = do
  tag <- (\Ptr Win32_REPARSE_DATA_BUFFER
hsc_ptr -> Ptr Win32_REPARSE_DATA_BUFFER -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Win32_REPARSE_DATA_BUFFER
hsc_ptr Int
0) Ptr Win32_REPARSE_DATA_BUFFER
p
{-# LINE 222 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
  case () of
    _ | tag == win32_iO_REPARSE_TAG_MOUNT_POINT -> do
          let buf = (\hsc_ptr -> hsc_ptr `plusPtr` 16) p
{-# LINE 226 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          sni <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 228 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          sns <- (\hsc_ptr -> peekByteOff hsc_ptr 10) p
{-# LINE 230 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          sn <- peekName buf sni sns
          pni <- (\hsc_ptr -> peekByteOff hsc_ptr 12) p
{-# LINE 233 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          pns <- (\hsc_ptr -> peekByteOff hsc_ptr 14) p
{-# LINE 235 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          pn <- peekName buf pni pns
          pure (Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn pn)
      | tag == win32_iO_REPARSE_TAG_SYMLINK -> do
          let buf = (\hsc_ptr -> hsc_ptr `plusPtr` 20) p
{-# LINE 240 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          sni <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 242 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          sns <- (\hsc_ptr -> peekByteOff hsc_ptr 10) p
{-# LINE 244 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          sn <- peekName buf sni sns
          pni <- (\hsc_ptr -> peekByteOff hsc_ptr 12) p
{-# LINE 247 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          pns <- (\hsc_ptr -> peekByteOff hsc_ptr 14) p
{-# LINE 249 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          pn <- peekName buf pni pns
          flags <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
{-# LINE 252 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
          pure (Win32_SYMLINK_REPARSE_DATA_BUFFER sn pn
                (flags .&. win32_sYMLINK_FLAG_RELATIVE /= 0))
      | otherwise -> pure Win32_GENERIC_REPARSE_DATA_BUFFER
  where
    peekName :: Ptr CWchar -> CUShort -> CUShort -> IO WindowsString
    peekName :: LPTSTR -> CUShort -> CUShort -> IO PlatformString
peekName LPTSTR
buf CUShort
offset CUShort
size =
      (LPTSTR, Int) -> IO PlatformString
Win32.peekTStringLen ( LPTSTR
buf LPTSTR -> Int -> LPTSTR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` CUShort -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUShort
offset
                           , CUShort -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUShort
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` TCHAR -> Int
forall a. Storable a => a -> Int
sizeOf (TCHAR
0 :: CWchar) )

deviceIoControl
  :: Win32.HANDLE
  -> Win32.DWORD
  -> (Ptr a, Int)
  -> (Ptr b, Int)
  -> Maybe Void
  -> IO (Either Win32.ErrCode Int)
deviceIoControl :: forall a b.
HANDLE
-> Word32
-> (Ptr a, Int)
-> (Ptr b, Int)
-> Maybe Void
-> IO (Either Word32 Int)
deviceIoControl HANDLE
h Word32
code (Ptr a
inPtr, Int
inSize) (Ptr b
outPtr, Int
outSize) Maybe Void
_ = do
  Word32
-> (Ptr Word32 -> IO (Either Word32 Int)) -> IO (Either Word32 Int)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Word32
0 ((Ptr Word32 -> IO (Either Word32 Int)) -> IO (Either Word32 Int))
-> (Ptr Word32 -> IO (Either Word32 Int)) -> IO (Either Word32 Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr Word32
lenPtr -> do
    ok <- HANDLE
-> Word32
-> Ptr a
-> Word32
-> Ptr b
-> Word32
-> Ptr Word32
-> Ptr Void
-> IO Bool
forall a b.
HANDLE
-> Word32
-> Ptr a
-> Word32
-> Ptr b
-> Word32
-> Ptr Word32
-> Ptr Void
-> IO Bool
c_DeviceIoControl HANDLE
h Word32
code Ptr a
inPtr (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inSize) Ptr b
outPtr
                            (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outSize) Ptr Word32
lenPtr Ptr Void
forall {b}. Ptr b
nullPtr
    if ok
      then Right . fromIntegral <$> peek lenPtr
      else Left <$> Win32.getLastError

foreign import WINAPI unsafe "windows.h DeviceIoControl"
  c_DeviceIoControl
    :: Win32.HANDLE
    -> Win32.DWORD
    -> Ptr a
    -> Win32.DWORD
    -> Ptr b
    -> Win32.DWORD
    -> Ptr Win32.DWORD
    -> Ptr Void
    -> IO Win32.BOOL

readSymbolicLink :: OsPath -> IO OsPath
readSymbolicLink :: OsString -> IO OsString
readSymbolicLink OsString
path =
  (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
path) (IOException -> IOException) -> IO OsString -> IO OsString
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
    path' <- OsString -> IO PlatformString
furnishPath OsString
path
    let open = PlatformString
-> Word32
-> Word32
-> Maybe LPSECURITY_ATTRIBUTES
-> Word32
-> Word32
-> Maybe HANDLE
-> IO HANDLE
Win32.createFile PlatformString
path' Word32
0 Word32
maxShareMode Maybe LPSECURITY_ATTRIBUTES
forall a. Maybe a
Nothing Word32
Win32.oPEN_EXISTING
                                (Word32
Win32.fILE_FLAG_BACKUP_SEMANTICS Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                                Word32
win32_fILE_FLAG_OPEN_REPARSE_POINT) Maybe HANDLE
forall a. Maybe a
Nothing
    bracket open Win32.closeHandle $ \ HANDLE
h -> do
      ((Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO OsString)
-> IO OsString
forall a. ((Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO a) -> IO a
win32_alloca_REPARSE_DATA_BUFFER (((Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO OsString)
 -> IO OsString)
-> ((Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO OsString)
-> IO OsString
forall a b. (a -> b) -> a -> b
$ \ ptrAndSize :: (Ptr Win32_REPARSE_DATA_BUFFER, Int)
ptrAndSize@(Ptr Win32_REPARSE_DATA_BUFFER
ptr, Int
_) -> do
        result <- HANDLE
-> Word32
-> (Ptr (ZonkAny 0), Int)
-> (Ptr Win32_REPARSE_DATA_BUFFER, Int)
-> Maybe Void
-> IO (Either Word32 Int)
forall a b.
HANDLE
-> Word32
-> (Ptr a, Int)
-> (Ptr b, Int)
-> Maybe Void
-> IO (Either Word32 Int)
deviceIoControl HANDLE
h Word32
win32_fSCTL_GET_REPARSE_POINT
                                  (Ptr (ZonkAny 0)
forall {b}. Ptr b
nullPtr, Int
0) (Ptr Win32_REPARSE_DATA_BUFFER, Int)
ptrAndSize Maybe Void
forall a. Maybe a
Nothing
        case result of
          Left Word32
e | Word32
e Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
win32_eRROR_INVALID_FUNCTION -> do
                     let msg :: [Char]
msg = [Char]
"Incorrect function. The file system " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                               [Char]
"might not support symbolic links."
                     IOException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOErrorType
-> [Char] -> Maybe Handle -> Maybe [Char] -> IOException
mkIOError IOErrorType
illegalOperationErrorType
                                        [Char]
"DeviceIoControl" Maybe Handle
forall a. Maybe a
Nothing Maybe [Char]
forall a. Maybe a
Nothing
                              IOException -> [Char] -> IOException
`ioeSetErrorString` [Char]
msg)
                 | Bool
otherwise -> [Char] -> Word32 -> IO ()
forall a. [Char] -> Word32 -> IO a
Win32.failWith [Char]
"DeviceIoControl" Word32
e
          Right Int
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        rData <- win32_peek_REPARSE_DATA_BUFFER ptr
        strip . OsString <$> case rData of
          Win32_MOUNT_POINT_REPARSE_DATA_BUFFER PlatformString
sn PlatformString
_ -> PlatformString -> IO PlatformString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlatformString
sn
          Win32_SYMLINK_REPARSE_DATA_BUFFER PlatformString
sn PlatformString
_ Bool
_ -> PlatformString -> IO PlatformString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlatformString
sn
          Win32_REPARSE_DATA_BUFFER
_ -> IOException -> IO PlatformString
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOErrorType
-> [Char] -> Maybe Handle -> Maybe [Char] -> IOException
mkIOError IOErrorType
InappropriateType
                                  [Char]
"readSymbolicLink" Maybe Handle
forall a. Maybe a
Nothing Maybe [Char]
forall a. Maybe a
Nothing)
  where
    strip :: OsString -> OsString
strip OsString
sn =
      OsString -> Maybe OsString -> OsString
forall a. a -> Maybe a -> a
fromMaybe OsString
sn
        ([OsChar] -> OsString
pack ([OsChar] -> OsString) -> Maybe [OsChar] -> Maybe OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OsChar] -> [OsChar] -> Maybe [OsChar]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix (OsString -> [OsChar]
unpack ([Char] -> OsString
os [Char]
"\\??\\")) (OsString -> [OsChar]
unpack OsString
sn))

-- | On Windows, equivalent to 'simplifyWindows'.

simplify :: OsPath -> OsPath
simplify :: OsString -> OsString
simplify = OsString -> OsString
simplifyWindows

-- | Normalise the path separators and prepend the @"\\\\?\\"@ prefix if

-- necessary or possible.  This is used for symbolic links targets because

-- they can't handle forward slashes.

normaliseSeparators :: OsPath -> WindowsPath
normaliseSeparators :: OsString -> PlatformString
normaliseSeparators OsString
path
  | OsString -> Bool
isRelative OsString
path = OsString -> PlatformString
getOsString ([OsChar] -> OsString
pack (OsChar -> OsChar
normaliseSep (OsChar -> OsChar) -> [OsChar] -> [OsChar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsString -> [OsChar]
unpack OsString
path))
  | Bool
otherwise = OsString -> PlatformString
toExtendedLengthPath OsString
path
  where normaliseSep :: OsChar -> OsChar
normaliseSep OsChar
c = if OsChar -> Bool
isPathSeparator OsChar
c then OsChar
pathSeparator else OsChar
c

-- | 'simplify' the path and prepend the @"\\\\?\\"@ if possible.  This

-- function can sometimes be used to bypass the @MAX_PATH@ length restriction

-- in Windows API calls.

toExtendedLengthPath :: OsPath -> WindowsPath
toExtendedLengthPath :: OsString -> PlatformString
toExtendedLengthPath OsString
path =
  OsString -> PlatformString
getOsString (OsString -> PlatformString) -> OsString -> PlatformString
forall a b. (a -> b) -> a -> b
$
  if OsString -> Bool
isRelative OsString
path
  then OsString
simplifiedPath
  else
    case OsChar -> Char
toChar (OsChar -> Char) -> [OsChar] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OsChar]
simplifiedPath' of
      Char
'\\' : Char
'?'  : Char
'?' : Char
'\\' : [Char]
_ -> OsString
simplifiedPath
      Char
'\\' : Char
'\\' : Char
'?' : Char
'\\' : [Char]
_ -> OsString
simplifiedPath
      Char
'\\' : Char
'\\' : Char
'.' : Char
'\\' : [Char]
_ -> OsString
simplifiedPath
      Char
'\\' : Char
'\\' : [Char]
_ ->
        [Char] -> OsString
os [Char]
"\\\\?\\UNC" OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> [OsChar] -> OsString
pack (Int -> [OsChar] -> [OsChar]
forall a. Int -> [a] -> [a]
drop Int
1 [OsChar]
simplifiedPath')
      [Char]
_ -> [Char] -> OsString
os [Char]
"\\\\?\\" OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> OsString
simplifiedPath
  where simplifiedPath :: OsString
simplifiedPath = OsString -> OsString
simplify OsString
path
        simplifiedPath' :: [OsChar]
simplifiedPath' = OsString -> [OsChar]
unpack OsString
simplifiedPath

-- | Make a path absolute and convert to an extended length path, if possible.

--

-- Empty paths are left unchanged.

--

-- This function never fails.  If it doesn't understand the path, it just

-- returns the path unchanged.

furnishPath :: OsPath -> IO WindowsPath
furnishPath :: OsString -> IO PlatformString
furnishPath OsString
path =
  (OsString -> PlatformString
toExtendedLengthPath (OsString -> PlatformString) -> IO OsString -> IO PlatformString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsString -> IO OsString
rawPrependCurrentDirectory OsString
path)
    IO PlatformString
-> (IOException -> IO PlatformString) -> IO PlatformString
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIOError` \ IOException
_ ->
      PlatformString -> IO PlatformString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OsString -> PlatformString
getOsString OsString
path)

-- | Strip the @"\\\\?\\"@ prefix if possible.

-- The prefix is kept if the meaning of the path would otherwise change.

fromExtendedLengthPath :: WindowsPath -> OsPath
fromExtendedLengthPath :: PlatformString -> OsString
fromExtendedLengthPath PlatformString
ePath' =
  case OsString -> [OsChar]
unpack OsString
ePath of
    OsChar
c1 : OsChar
c2 : OsChar
c3 : OsChar
c4 : [OsChar]
path
      | (OsChar -> Char
toChar (OsChar -> Char) -> [OsChar] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OsChar
c1, OsChar
c2, OsChar
c3, OsChar
c4]) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"\\\\?\\" ->
      case [OsChar]
path of
        OsChar
c5 : OsChar
c6 : OsChar
c7 : subpath :: [OsChar]
subpath@(OsChar
c8 : [OsChar]
_)
          | (OsChar -> Char
toChar (OsChar -> Char) -> [OsChar] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OsChar
c5, OsChar
c6, OsChar
c7, OsChar
c8]) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"UNC\\" ->
            [OsChar] -> OsString
pack (OsChar
c8 OsChar -> [OsChar] -> [OsChar]
forall a. a -> [a] -> [a]
: [OsChar]
subpath)
        OsChar
drive : OsChar
col : [OsChar]
subpath
          -- if the path is not "regular", then the prefix is necessary

          -- to ensure the path is interpreted literally

          | OsChar -> Char
toChar OsChar
col Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':', OsChar -> Bool
isDriveChar OsChar
drive, [OsChar] -> Bool
isPathRegular [OsChar]
subpath ->
            [OsChar] -> OsString
pack [OsChar]
path
        [OsChar]
_ -> OsString
ePath
    [OsChar]
_ -> OsString
ePath
  where
    ePath :: OsString
ePath = PlatformString -> OsString
OsString PlatformString
ePath'
    isDriveChar :: OsChar -> Bool
isDriveChar OsChar
drive = Char -> Bool
isAlpha (OsChar -> Char
toChar OsChar
drive) Bool -> Bool -> Bool
&& Char -> Bool
isAscii (OsChar -> Char
toChar OsChar
drive)
    isPathRegular :: [OsChar] -> Bool
isPathRegular [OsChar]
path =
      Bool -> Bool
not (Char
'/' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (OsChar -> Char
toChar (OsChar -> Char) -> [OsChar] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OsChar]
path) Bool -> Bool -> Bool
||
           [Char] -> OsString
os [Char]
"." OsString -> [OsString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` OsString -> [OsString]
splitDirectories ([OsChar] -> OsString
pack [OsChar]
path) Bool -> Bool -> Bool
||
           [Char] -> OsString
os [Char]
".." OsString -> [OsString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` OsString -> [OsString]
splitDirectories ([OsChar] -> OsString
pack [OsChar]
path))

saturatingDouble :: Win32.DWORD -> Win32.DWORD
saturatingDouble :: Word32 -> Word32
saturatingDouble Word32
s | Word32
s Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
forall a. Bounded a => a
maxBound Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
2 = Word32
forall a. Bounded a => a
maxBound
                   | Bool
otherwise            = Word32
s Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
2

-- Handles Windows APIs that write strings through a user-provided buffer and

-- can propose a new length when it isn't big enough. This is similar to

-- Win32.try, but also returns the precise error code.

peekTStringWith :: Win32.DWORD
                -> (Win32.LPTSTR -> Win32.DWORD -> IO Win32.DWORD)
                -- ^ Must accept a buffer and its size in TCHARs. If the

                --   buffer is large enough for the function, it must write a

                --   string to it, which need not be null-terminated, and

                --   return the length of the string, not including the null

                --   terminator if present. If the buffer is too small, it

                --   must return a proposed buffer size in TCHARs, although it

                --   need not guarantee success with the proposed size if,

                --   say, the underlying data changes in the interim. If it

                --   fails for any other reason, it must return zero and

                --   communicate the error code through GetLastError.

                -> IO (Either Win32.ErrCode WindowsPath)
peekTStringWith :: Word32
-> (LPTSTR -> Word32 -> IO Word32)
-> IO (Either Word32 PlatformString)
peekTStringWith Word32
bufferSize LPTSTR -> Word32 -> IO Word32
cFunc = do
  outcome <- do
    Int
-> (LPTSTR -> IO (Either Word32 (Either Word32 PlatformString)))
-> IO (Either Word32 (Either Word32 PlatformString))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bufferSize) ((LPTSTR -> IO (Either Word32 (Either Word32 PlatformString)))
 -> IO (Either Word32 (Either Word32 PlatformString)))
-> (LPTSTR -> IO (Either Word32 (Either Word32 PlatformString)))
-> IO (Either Word32 (Either Word32 PlatformString))
forall a b. (a -> b) -> a -> b
$ \ LPTSTR
ptr -> do
      size <- LPTSTR -> Word32 -> IO Word32
cFunc LPTSTR
ptr Word32
bufferSize
      case size of
        Word32
0 -> Either Word32 PlatformString
-> Either Word32 (Either Word32 PlatformString)
forall a b. b -> Either a b
Right (Either Word32 PlatformString
 -> Either Word32 (Either Word32 PlatformString))
-> (Word32 -> Either Word32 PlatformString)
-> Word32
-> Either Word32 (Either Word32 PlatformString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Either Word32 PlatformString
forall a b. a -> Either a b
Left (Word32 -> Either Word32 (Either Word32 PlatformString))
-> IO Word32 -> IO (Either Word32 (Either Word32 PlatformString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word32
Win32.getLastError
        Word32
_ | Word32
size Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
bufferSize ->
              Either Word32 PlatformString
-> Either Word32 (Either Word32 PlatformString)
forall a b. b -> Either a b
Right (Either Word32 PlatformString
 -> Either Word32 (Either Word32 PlatformString))
-> (PlatformString -> Either Word32 PlatformString)
-> PlatformString
-> Either Word32 (Either Word32 PlatformString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlatformString -> Either Word32 PlatformString
forall a b. b -> Either a b
Right (PlatformString -> Either Word32 (Either Word32 PlatformString))
-> IO PlatformString
-> IO (Either Word32 (Either Word32 PlatformString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LPTSTR, Int) -> IO PlatformString
Win32.peekTStringLen (LPTSTR
ptr, Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size)
          | Bool
otherwise ->
              -- At least double the size to ensure fast termination.

              Either Word32 (Either Word32 PlatformString)
-> IO (Either Word32 (Either Word32 PlatformString))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Either Word32 (Either Word32 PlatformString)
forall a b. a -> Either a b
Left (Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
max Word32
size (Word32 -> Word32
saturatingDouble Word32
bufferSize)))
  case outcome of
    Left Word32
proposedSize -> Word32
-> (LPTSTR -> Word32 -> IO Word32)
-> IO (Either Word32 PlatformString)
peekTStringWith Word32
proposedSize LPTSTR -> Word32 -> IO Word32
cFunc
    Right Either Word32 PlatformString
result      -> Either Word32 PlatformString -> IO (Either Word32 PlatformString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Word32 PlatformString
result

realPath :: OsPath -> IO OsPath
realPath :: OsString -> IO OsString
realPath = OsString -> IO OsString
getFinalPathName

canonicalizePathSimplify :: OsPath -> IO OsPath
canonicalizePathSimplify :: OsString -> IO OsString
canonicalizePathSimplify OsString
path =
  OsString -> IO OsString
getFullPathName OsString
path
    IO OsString -> (IOException -> IO OsString) -> IO OsString
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIOError` \ IOException
_ ->
      OsString -> IO OsString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
path

searchPathEnvForExes :: OsString -> IO (Maybe OsPath)
searchPathEnvForExes :: OsString -> IO (Maybe OsString)
searchPathEnvForExes (OsString PlatformString
binary) = IO (Maybe OsString)
search IO (Maybe OsString)
-> (IOException -> IO (Maybe OsString)) -> IO (Maybe OsString)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOException
e ->
  if IOException -> IOErrorType
ioeGetErrorType IOException
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
InvalidArgument
  then Maybe OsString -> IO (Maybe OsString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OsString
forall a. Maybe a
Nothing
  else IOException -> IO (Maybe OsString)
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO IOException
e
 where
  search :: IO (Maybe OsString)
search = (PlatformString -> OsString
OsString (PlatformString -> OsString)
-> Maybe PlatformString -> Maybe OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe PlatformString -> Maybe OsString)
-> IO (Maybe PlatformString) -> IO (Maybe OsString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PlatformString
-> PlatformString
-> Maybe PlatformString
-> IO (Maybe PlatformString)
Win32.searchPath Maybe PlatformString
forall a. Maybe a
Nothing PlatformString
binary (PlatformString -> Maybe PlatformString
forall a. a -> Maybe a
Just (OsString -> PlatformString
getOsString OsString
exeExtension))

findExecutablesLazyInternal :: ([OsPath] -> OsString -> ListT IO OsPath)
                            -> OsString
                            -> ListT IO OsPath
findExecutablesLazyInternal :: ([OsString] -> OsString -> ListT IO OsString)
-> OsString -> ListT IO OsString
findExecutablesLazyInternal [OsString] -> OsString -> ListT IO OsString
_ = IO (Maybe OsString) -> ListT IO OsString
forall (m :: * -> *) a. Applicative m => m (Maybe a) -> ListT m a
maybeToListT (IO (Maybe OsString) -> ListT IO OsString)
-> (OsString -> IO (Maybe OsString))
-> OsString
-> ListT IO OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> IO (Maybe OsString)
searchPathEnvForExes

exeExtensionInternal :: OsString
exeExtensionInternal :: OsString
exeExtensionInternal = OsString
exeExtension

readDirToEnd :: RawHandle -> IO [OsPath]
readDirToEnd :: OsString -> IO [OsString]
readDirToEnd = OsString -> IO [OsString]
getDirectoryContentsInternal

getDirectoryContentsInternal :: OsPath -> IO [OsPath]
getDirectoryContentsInternal :: OsString -> IO [OsString]
getDirectoryContentsInternal OsString
path = do
  query <- OsString -> IO PlatformString
furnishPath (OsString
path OsString -> OsString -> OsString
</> [Char] -> OsString
os [Char]
"*")
  bracket
    (Win32.findFirstFile query)
    (\ (HANDLE
h, FindData
_) -> HANDLE -> IO ()
Win32.findClose HANDLE
h)
    (\ (HANDLE
h, FindData
fdat) -> HANDLE -> FindData -> [OsString] -> IO [OsString]
loop HANDLE
h FindData
fdat [])
  where
    -- we needn't worry about empty directories: a directory always

    -- has at least "." and ".." entries

    loop :: Win32.HANDLE -> Win32.FindData -> [OsPath] -> IO [OsPath]
    loop :: HANDLE -> FindData -> [OsString] -> IO [OsString]
loop HANDLE
h FindData
fdat [OsString]
acc = do
      filename <- FindData -> IO PlatformString
Win32.getFindDataFileName FindData
fdat
      more <- Win32.findNextFile h fdat
      if more
        then loop h fdat (OsString filename : acc)
        else pure (OsString filename : acc)
             -- no need to reverse, ordering is undefined


getCurrentDirectoryInternal :: IO OsPath
getCurrentDirectoryInternal :: IO OsString
getCurrentDirectoryInternal = PlatformString -> OsString
OsString (PlatformString -> OsString) -> IO PlatformString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO PlatformString
Win32.getCurrentDirectory

getFullPathName :: OsPath -> IO OsPath
getFullPathName :: OsString -> IO OsString
getFullPathName OsString
path =
  PlatformString -> OsString
fromExtendedLengthPath (PlatformString -> OsString) -> IO PlatformString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlatformString -> IO PlatformString
Win32.getFullPathName (OsString -> PlatformString
toExtendedLengthPath OsString
path)

-- | Similar to 'prependCurrentDirectory' but fails for empty paths.

rawPrependCurrentDirectory :: OsPath -> IO OsPath
rawPrependCurrentDirectory :: OsString -> IO OsString
rawPrependCurrentDirectory OsString
path
  | OsString -> Bool
isRelative OsString
path =
    ((IOException -> [Char] -> IOException
`ioeAddLocation` [Char]
"prependCurrentDirectory") (IOException -> IOException)
-> (IOException -> IOException) -> IOException -> IOException
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
path)) (IOException -> IOException) -> IO OsString -> IO OsString
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
      OsString -> IO OsString
getFullPathName OsString
path
  | Bool
otherwise = OsString -> IO OsString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
path

-- | Convert a path into an absolute path.  If the given path is relative, the

-- current directory is prepended and the path may or may not be simplified.

-- If the path is already absolute, the path is returned unchanged.  The

-- function preserves the presence or absence of the trailing path separator.

--

-- If the path is already absolute, the operation never fails.  Otherwise, the

-- operation may throw exceptions.

--

-- Empty paths are treated as the current directory.

prependCurrentDirectory :: OsPath -> IO OsPath
prependCurrentDirectory :: OsString -> IO OsString
prependCurrentDirectory = OsString -> IO OsString
rawPrependCurrentDirectory (OsString -> IO OsString)
-> (OsString -> OsString) -> OsString -> IO OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> OsString
emptyToCurDir

-- SetCurrentDirectory does not support long paths even with the \\?\ prefix

-- https://ghc.haskell.org/trac/ghc/ticket/13373#comment:6

setCurrentDirectoryInternal :: OsPath -> IO ()
setCurrentDirectoryInternal :: OsString -> IO ()
setCurrentDirectoryInternal = PlatformString -> IO ()
Win32.setCurrentDirectory (PlatformString -> IO ())
-> (OsString -> PlatformString) -> OsString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> PlatformString
getOsString

createSymbolicLinkUnpriv :: WindowsPath -> WindowsPath -> Bool -> IO ()
createSymbolicLinkUnpriv :: PlatformString -> PlatformString -> Bool -> IO ()
createSymbolicLinkUnpriv PlatformString
link PlatformString
_target Bool
_isDir =

{-# LINE 507 "libraries\\directory\\System\\Directory\\Internal\\Windows.hsc" #-}
  Win32.withTString link $ \ pLink ->
  Win32.withTString _target $ \ pTarget -> do
    let flags = if _isDir then win32_sYMBOLIC_LINK_FLAG_DIRECTORY else 0
    call pLink pTarget flags win32_sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE
  where
    call :: LPTSTR -> LPTSTR -> Word32 -> Word32 -> IO ()
call LPTSTR
pLink LPTSTR
pTarget Word32
flags Word32
unpriv = do
      status <- LPTSTR -> LPTSTR -> Word32 -> IO Word8
c_CreateSymbolicLink LPTSTR
pLink LPTSTR
pTarget (Word32
flags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
unpriv)
      when (status == 0) $ do
        e <- Win32.getLastError
        case () of
          ()
_ | Word32
e Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
win32_eRROR_INVALID_FUNCTION -> do
                let msg :: [Char]
msg = [Char]
"Incorrect function. The underlying file system " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                          [Char]
"might not support symbolic links."
                IOException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOErrorType
-> [Char] -> Maybe Handle -> Maybe [Char] -> IOException
mkIOError IOErrorType
illegalOperationErrorType
                                   [Char]
"CreateSymbolicLink" Maybe Handle
forall a. Maybe a
Nothing Maybe [Char]
forall a. Maybe a
Nothing
                         IOException -> OsString -> IOException
`ioeSetOsPath` PlatformString -> OsString
OsString PlatformString
link
                         IOException -> [Char] -> IOException
`ioeSetErrorString` [Char]
msg)
            | Word32
e Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
win32_eRROR_PRIVILEGE_NOT_HELD -> do
                let msg :: [Char]
msg = [Char]
"A required privilege is not held by the client. " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                          [Char]
"Creating symbolic links usually requires " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                          [Char]
"administrative rights."
                IOException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOErrorType
-> [Char] -> Maybe Handle -> Maybe [Char] -> IOException
mkIOError IOErrorType
permissionErrorType [Char]
"CreateSymbolicLink"
                                   Maybe Handle
forall a. Maybe a
Nothing Maybe [Char]
forall a. Maybe a
Nothing
                         IOException -> OsString -> IOException
`ioeSetOsPath` PlatformString -> OsString
OsString PlatformString
link
                         IOException -> [Char] -> IOException
`ioeSetErrorString` [Char]
msg)
            | Word32
e Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
win32_eRROR_INVALID_PARAMETER Bool -> Bool -> Bool
&&
              Word32
unpriv Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 ->
                -- for compatibility with older versions of Windows,

                -- try it again without the flag

                LPTSTR -> LPTSTR -> Word32 -> Word32 -> IO ()
call LPTSTR
pLink LPTSTR
pTarget Word32
flags Word32
0
            | Bool
otherwise -> [Char] -> Word32 -> IO ()
forall a. [Char] -> Word32 -> IO a
Win32.failWith [Char]
"CreateSymbolicLink" Word32
e

foreign import WINAPI unsafe "windows.h CreateSymbolicLinkW"
  c_CreateSymbolicLink
    :: Ptr CWchar -> Ptr CWchar -> Win32.DWORD -> IO Win32.BYTE


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

linkToDirectoryIsDirectory :: Bool
linkToDirectoryIsDirectory :: Bool
linkToDirectoryIsDirectory = Bool
True

createSymbolicLink :: Bool -> OsPath -> OsPath -> IO ()
createSymbolicLink :: Bool -> OsString -> OsString -> IO ()
createSymbolicLink Bool
isDir OsString
target OsString
link =
  (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
link) (IOException -> IOException) -> IO () -> IO ()
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
    -- normaliseSeparators ensures the target gets normalised properly

    link' <- OsString -> IO PlatformString
furnishPath OsString
link
    createSymbolicLinkUnpriv
      link'
      (normaliseSeparators target)
      isDir

type Metadata = Win32.BY_HANDLE_FILE_INFORMATION

getMetadataAt :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO Metadata
getMetadataAt :: WhetherFollow -> Maybe OsString -> OsString -> IO Metadata
getMetadataAt WhetherFollow
NoFollow    Maybe OsString
dir OsString
path = OsString -> IO Metadata
getSymbolicLinkMetadata (Maybe OsString -> OsString -> OsString
pathAt Maybe OsString
dir OsString
path)
getMetadataAt WhetherFollow
FollowLinks Maybe OsString
dir OsString
path = OsString -> IO Metadata
getFileMetadata         (Maybe OsString -> OsString -> OsString
pathAt Maybe OsString
dir OsString
path)

getSymbolicLinkMetadata :: OsPath -> IO Metadata
getSymbolicLinkMetadata :: OsString -> IO Metadata
getSymbolicLinkMetadata OsString
path =
  (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
path) (IOException -> IOException) -> IO Metadata -> IO Metadata
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
    path' <- OsString -> IO PlatformString
furnishPath OsString
path
    let open = PlatformString
-> Word32
-> Word32
-> Maybe LPSECURITY_ATTRIBUTES
-> Word32
-> Word32
-> Maybe HANDLE
-> IO HANDLE
Win32.createFile PlatformString
path' Word32
0 Word32
maxShareMode Maybe LPSECURITY_ATTRIBUTES
forall a. Maybe a
Nothing Word32
Win32.oPEN_EXISTING
                                (Word32
Win32.fILE_FLAG_BACKUP_SEMANTICS Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                                 Word32
win32_fILE_FLAG_OPEN_REPARSE_POINT) Maybe HANDLE
forall a. Maybe a
Nothing
    bracket open Win32.closeHandle $ \ HANDLE
h -> do
      HANDLE -> IO Metadata
Win32.getFileInformationByHandle HANDLE
h

getFileMetadata :: OsPath -> IO Metadata
getFileMetadata :: OsString -> IO Metadata
getFileMetadata OsString
path =
  (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
path) (IOException -> IOException) -> IO Metadata -> IO Metadata
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
    path' <- OsString -> IO PlatformString
furnishPath OsString
path
    let open = PlatformString
-> Word32
-> Word32
-> Maybe LPSECURITY_ATTRIBUTES
-> Word32
-> Word32
-> Maybe HANDLE
-> IO HANDLE
Win32.createFile PlatformString
path' Word32
0 Word32
maxShareMode Maybe LPSECURITY_ATTRIBUTES
forall a. Maybe a
Nothing Word32
Win32.oPEN_EXISTING
                                Word32
Win32.fILE_FLAG_BACKUP_SEMANTICS Maybe HANDLE
forall a. Maybe a
Nothing
    bracket open Win32.closeHandle $ \ HANDLE
h -> do
      HANDLE -> IO Metadata
Win32.getFileInformationByHandle HANDLE
h

fileTypeFromMetadata :: Metadata -> FileType
fileTypeFromMetadata :: Metadata -> FileType
fileTypeFromMetadata Metadata
info
  | Bool
isLink    = if Bool
isDir then FileType
DirectoryLink else FileType
SymbolicLink
  | Bool
isDir     = FileType
Directory
  | Bool
otherwise = FileType
File
  where
    isLink :: Bool
isLink = Word32
attrs Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
Win32.fILE_ATTRIBUTE_REPARSE_POINT Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
    isDir :: Bool
isDir  = Word32
attrs Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
Win32.fILE_ATTRIBUTE_DIRECTORY Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
    attrs :: Word32
attrs  = Metadata -> Word32
Win32.bhfiFileAttributes Metadata
info

fileSizeFromMetadata :: Metadata -> Integer
fileSizeFromMetadata :: Metadata -> Integer
fileSizeFromMetadata = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> (Metadata -> Word64) -> Metadata -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Word64
Win32.bhfiSize

accessTimeFromMetadata :: Metadata -> UTCTime
accessTimeFromMetadata :: Metadata -> UTCTime
accessTimeFromMetadata =
  NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (Metadata -> NominalDiffTime) -> Metadata -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FILETIME -> NominalDiffTime
windowsToPosixTime (FILETIME -> NominalDiffTime)
-> (Metadata -> FILETIME) -> Metadata -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> FILETIME
Win32.bhfiLastAccessTime

modificationTimeFromMetadata :: Metadata -> UTCTime
modificationTimeFromMetadata :: Metadata -> UTCTime
modificationTimeFromMetadata =
  NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (Metadata -> NominalDiffTime) -> Metadata -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FILETIME -> NominalDiffTime
windowsToPosixTime (FILETIME -> NominalDiffTime)
-> (Metadata -> FILETIME) -> Metadata -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> FILETIME
Win32.bhfiLastWriteTime

-- | Difference between the Windows and POSIX epochs in units of 100ns.

windowsPosixEpochDifference :: Num a => a
windowsPosixEpochDifference :: forall a. Num a => a
windowsPosixEpochDifference = a
116444736000000000

-- | Convert from Windows time to POSIX time.

windowsToPosixTime :: Win32.FILETIME -> POSIXTime
windowsToPosixTime :: FILETIME -> NominalDiffTime
windowsToPosixTime (Win32.FILETIME Word64
t) =
  (Word64 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
forall a. Num a => a
windowsPosixEpochDifference) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
10000000

-- | Convert from POSIX time to Windows time.  This is lossy as Windows time

--   has a resolution of only 100ns.

posixToWindowsTime :: POSIXTime -> Win32.FILETIME
posixToWindowsTime :: NominalDiffTime -> FILETIME
posixToWindowsTime NominalDiffTime
t = Word64 -> FILETIME
Win32.FILETIME (Word64 -> FILETIME) -> Word64 -> FILETIME
forall a b. (a -> b) -> a -> b
$
  NominalDiffTime -> Word64
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
10000000 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
forall a. Num a => a
windowsPosixEpochDifference)

setTimes :: OsPath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()
setTimes :: OsString -> (Maybe NominalDiffTime, Maybe NominalDiffTime) -> IO ()
setTimes OsString
path' (Maybe NominalDiffTime
atime', Maybe NominalDiffTime
mtime') =
  IO HANDLE -> (HANDLE -> IO ()) -> (HANDLE -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (OsString -> Word32 -> IO HANDLE
openFileHandle OsString
path' Word32
Win32.gENERIC_WRITE)
          HANDLE -> IO ()
Win32.closeHandle ((HANDLE -> IO ()) -> IO ()) -> (HANDLE -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ HANDLE
handle ->
  HANDLE
-> Maybe FILETIME -> Maybe FILETIME -> Maybe FILETIME -> IO ()
Win32.setFileTime HANDLE
handle Maybe FILETIME
forall a. Maybe a
Nothing (NominalDiffTime -> FILETIME
posixToWindowsTime (NominalDiffTime -> FILETIME)
-> Maybe NominalDiffTime -> Maybe FILETIME
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NominalDiffTime
atime') (NominalDiffTime -> FILETIME
posixToWindowsTime (NominalDiffTime -> FILETIME)
-> Maybe NominalDiffTime -> Maybe FILETIME
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NominalDiffTime
mtime')

-- | Open the handle of an existing file or directory.

openFileHandle :: OsString -> Win32.AccessMode -> IO Win32.HANDLE
openFileHandle :: OsString -> Word32 -> IO HANDLE
openFileHandle OsString
path Word32
mode =
  (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
path) (IOException -> IOException) -> IO HANDLE -> IO HANDLE
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
    path' <- OsString -> IO PlatformString
furnishPath OsString
path
    Win32.createFile path' mode maxShareMode Nothing
                     Win32.oPEN_EXISTING flags Nothing
  where flags :: Word32
flags =  Word32
Win32.fILE_ATTRIBUTE_NORMAL
             Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
Win32.fILE_FLAG_BACKUP_SEMANTICS -- required for directories


type Mode = Win32.FileAttributeOrFlag

modeFromMetadata :: Metadata -> Mode
modeFromMetadata :: Metadata -> Word32
modeFromMetadata = Metadata -> Word32
Win32.bhfiFileAttributes

hasWriteMode :: Mode -> Bool
hasWriteMode :: Word32 -> Bool
hasWriteMode Word32
m = Word32
m Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
Win32.fILE_ATTRIBUTE_READONLY Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0

setWriteMode :: Bool -> Mode -> Mode
setWriteMode :: Bool -> Word32 -> Word32
setWriteMode Bool
False Word32
m = Word32
m Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
Win32.fILE_ATTRIBUTE_READONLY
setWriteMode Bool
True  Word32
m = Word32
m Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
Win32.fILE_ATTRIBUTE_READONLY

setForceRemoveMode :: Mode -> Mode
setForceRemoveMode :: Word32 -> Word32
setForceRemoveMode Word32
m = Word32
m Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
Win32.fILE_ATTRIBUTE_READONLY

setModeAt :: WhetherFollow -> Maybe RawHandle -> OsPath -> Mode -> IO ()
setModeAt :: WhetherFollow -> Maybe OsString -> OsString -> Word32 -> IO ()
setModeAt WhetherFollow
_ Maybe OsString
dir OsString
path = OsString -> Word32 -> IO ()
setFileMode (Maybe OsString -> OsString -> OsString
pathAt Maybe OsString
dir OsString
path)

setFileMode :: OsPath -> Mode -> IO ()
setFileMode :: OsString -> Word32 -> IO ()
setFileMode OsString
path Word32
mode =
  (IOException -> OsString -> IOException
`ioeSetOsPath` OsString
path) (IOException -> IOException) -> IO () -> IO ()
forall a. (IOException -> IOException) -> IO a -> IO a
`modifyIOError` do
    path' <- OsString -> IO PlatformString
furnishPath OsString
path
    Win32.setFileAttributes path' mode

-- | A restricted form of 'setFileMode' that only sets the permission bits.

-- For Windows, this means only the "read-only" attribute is affected.

setFilePermissions :: OsPath -> Mode -> IO ()
setFilePermissions :: OsString -> Word32 -> IO ()
setFilePermissions OsString
path Word32
m = do
  m' <- Metadata -> Word32
modeFromMetadata (Metadata -> Word32) -> IO Metadata -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsString -> IO Metadata
getFileMetadata OsString
path
  setFileMode path ((m' .&. complement Win32.fILE_ATTRIBUTE_READONLY) .|.
                    (m  .&. Win32.fILE_ATTRIBUTE_READONLY))

getAccessPermissions :: OsPath -> IO Permissions
getAccessPermissions :: OsString -> IO Permissions
getAccessPermissions OsString
path = do
  m <- OsString -> IO Metadata
getFileMetadata OsString
path
  let isDir = FileType -> Bool
fileTypeIsDirectory (Metadata -> FileType
fileTypeFromMetadata Metadata
m)
  let w = Word32 -> Bool
hasWriteMode (Metadata -> Word32
modeFromMetadata Metadata
m)
  let x = (Char -> Char
toLower (Char -> Char) -> (OsChar -> Char) -> OsChar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsChar -> Char
toChar (OsChar -> Char) -> [OsChar] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsString -> [OsChar]
unpack (OsString -> OsString
takeExtension OsString
path))
          [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
".bat", [Char]
".cmd", [Char]
".com", [Char]
".exe"]
  pure Permissions
       { readable   = True
       , writable   = w
       , executable = x && not isDir
       , searchable = isDir
       }

setAccessPermissions :: OsPath -> Permissions -> IO ()
setAccessPermissions :: OsString -> Permissions -> IO ()
setAccessPermissions OsString
path Permissions{writable :: Permissions -> Bool
writable = Bool
w} = do
  OsString -> Word32 -> IO ()
setFilePermissions OsString
path (Bool -> Word32 -> Word32
setWriteMode Bool
w Word32
0)

getFolderPath :: Win32.CSIDL -> IO OsPath
getFolderPath :: CInt -> IO OsString
getFolderPath CInt
what = PlatformString -> OsString
OsString (PlatformString -> OsString) -> IO PlatformString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HANDLE -> CInt -> HANDLE -> Word32 -> IO PlatformString
Win32.sHGetFolderPath HANDLE
forall {b}. Ptr b
nullPtr CInt
what HANDLE
forall {b}. Ptr b
nullPtr Word32
0

getHomeDirectoryInternal :: IO OsPath
getHomeDirectoryInternal :: IO OsString
getHomeDirectoryInternal =
  CInt -> IO OsString
getFolderPath CInt
Win32.cSIDL_PROFILE IO OsString -> (IOException -> IO OsString) -> IO OsString
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIOError` \ IOException
_ ->
    CInt -> IO OsString
getFolderPath CInt
Win32.cSIDL_WINDOWS

getXdgDirectoryFallback :: IO OsPath -> XdgDirectory -> IO OsPath
getXdgDirectoryFallback :: IO OsString -> XdgDirectory -> IO OsString
getXdgDirectoryFallback IO OsString
_ XdgDirectory
xdgDir = do
  case XdgDirectory
xdgDir of
    XdgDirectory
XdgData   -> CInt -> IO OsString
getFolderPath CInt
Win32.cSIDL_APPDATA
    XdgDirectory
XdgConfig -> CInt -> IO OsString
getFolderPath CInt
Win32.cSIDL_APPDATA
    XdgDirectory
XdgCache  -> CInt -> IO OsString
getFolderPath CInt
Win32.cSIDL_LOCAL_APPDATA
    XdgDirectory
XdgState  -> CInt -> IO OsString
getFolderPath CInt
Win32.cSIDL_LOCAL_APPDATA

getXdgDirectoryListFallback :: XdgDirectoryList -> IO [OsPath]
getXdgDirectoryListFallback :: XdgDirectoryList -> IO [OsString]
getXdgDirectoryListFallback XdgDirectoryList
_ =
  OsString -> [OsString]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OsString -> [OsString]) -> IO OsString -> IO [OsString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO OsString
getFolderPath CInt
win32_cSIDL_COMMON_APPDATA

getAppUserDataDirectoryInternal :: OsPath -> IO OsPath
getAppUserDataDirectoryInternal :: OsString -> IO OsString
getAppUserDataDirectoryInternal OsString
appName =
  (\ OsString
appData -> OsString
appData OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> ([Char] -> OsString
os [Char]
"\\" OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> OsString
appName))
  (OsString -> OsString) -> IO OsString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO OsString -> XdgDirectory -> IO OsString
getXdgDirectoryFallback IO OsString
getHomeDirectoryInternal XdgDirectory
XdgData

getUserDocumentsDirectoryInternal :: IO OsPath
getUserDocumentsDirectoryInternal :: IO OsString
getUserDocumentsDirectoryInternal = CInt -> IO OsString
getFolderPath CInt
Win32.cSIDL_PERSONAL

getTemporaryDirectoryInternal :: IO OsPath
getTemporaryDirectoryInternal :: IO OsString
getTemporaryDirectoryInternal = PlatformString -> OsString
OsString (PlatformString -> OsString) -> IO PlatformString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO PlatformString
Win32.getTemporaryDirectory


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