{-# LINE 1 "libraries\\Win32\\System\\Win32\\WindowsString\\File.hsc" #-}
-----------------------------------------------------------------------------

-- |

-- Module      :  System.Win32.File

-- Copyright   :  (c) Alastair Reid, 1997-2003

-- License     :  BSD-style (see the file libraries/base/LICENSE)

--

-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>

-- Stability   :  provisional

-- Portability :  portable

--

-- A collection of FFI declarations for interfacing with Win32.

--

-----------------------------------------------------------------------------


module System.Win32.WindowsString.File
    ( deleteFile
    , copyFile
    , moveFile
    , moveFileEx
    , setCurrentDirectory
    , createDirectory
    , createDirectoryEx
    , removeDirectory
    , getBinaryType
    , createFile
    , setFileAttributes
    , getFileAttributes
    , getFileAttributesExStandard
    , findFirstChangeNotification
    , getFindDataFileName
    , findFirstFile
    , defineDosDevice
    , getDiskFreeSpace
    , setVolumeLabel
    , getFileExInfoStandard
    , getFileExMaxInfoLevel
    , module System.Win32.File
    ) where

import System.Win32.File.Internal
import System.Win32.File hiding (
    deleteFile
  , copyFile
  , moveFile
  , moveFileEx
  , setCurrentDirectory
  , createDirectory
  , createDirectoryEx
  , removeDirectory
  , getBinaryType
  , createFile
  , setFileAttributes
  , getFileAttributes
  , getFileAttributesExStandard
  , findFirstChangeNotification
  , getFindDataFileName
  , findFirstFile
  , defineDosDevice
  , getDiskFreeSpace
  , setVolumeLabel
  , getFileExInfoStandard
  , getFileExMaxInfoLevel
  )
import System.Win32.WindowsString.Types
import System.OsString.Windows
import Unsafe.Coerce (unsafeCoerce)

import Foreign hiding (void)

#include "windows_cconv.h"




deleteFile :: WindowsString -> IO ()
deleteFile name =
  withFilePath name $ \ c_name ->
    failIfFalseWithRetry_ (unwords ["DeleteFile",show name]) $
      c_DeleteFile c_name

copyFile :: WindowsString -> WindowsString -> Bool -> IO ()
copyFile src dest over =
  withFilePath src $ \ c_src ->
  withFilePath dest $ \ c_dest ->
  failIfFalseWithRetry_ (unwords ["CopyFile",show src,show dest]) $
    c_CopyFile c_src c_dest over

moveFile :: WindowsString -> WindowsString -> IO ()
moveFile src dest =
  withFilePath src $ \ c_src ->
  withFilePath dest $ \ c_dest ->
  failIfFalseWithRetry_ (unwords ["MoveFile",show src,show dest]) $
    c_MoveFile c_src c_dest

moveFileEx :: WindowsString -> Maybe WindowsString -> MoveFileFlag -> IO ()
moveFileEx src dest flags =
  withFilePath src $ \ c_src ->
  maybeWith withFilePath dest $ \ c_dest ->
  failIfFalseWithRetry_ (unwords ["MoveFileEx",show src,show dest]) $
    c_MoveFileEx c_src c_dest flags

setCurrentDirectory :: WindowsString -> IO ()
setCurrentDirectory name =
  withFilePath name $ \ c_name ->
  failIfFalse_ (unwords ["SetCurrentDirectory",show name]) $
    c_SetCurrentDirectory c_name

createDirectory :: WindowsString -> Maybe LPSECURITY_ATTRIBUTES -> IO ()
createDirectory name mb_attr =
  withFilePath name $ \ c_name ->
  failIfFalseWithRetry_ (unwords ["CreateDirectory",show name]) $
    c_CreateDirectory c_name (maybePtr mb_attr)

createDirectoryEx :: WindowsString -> WindowsString -> Maybe LPSECURITY_ATTRIBUTES -> IO ()
createDirectoryEx template name mb_attr =
  withFilePath template $ \ c_template ->
  withFilePath name $ \ c_name ->
  failIfFalseWithRetry_ (unwords ["CreateDirectoryEx",show template,show name]) $
    c_CreateDirectoryEx c_template c_name (maybePtr mb_attr)

removeDirectory :: WindowsString -> IO ()
removeDirectory name =
  withFilePath name $ \ c_name ->
  failIfFalseWithRetry_ (unwords ["RemoveDirectory",show name]) $
    c_RemoveDirectory c_name

getBinaryType :: WindowsString -> IO BinaryType
getBinaryType name =
  withFilePath name $ \ c_name ->
  alloca $ \ p_btype -> do
  failIfFalse_ (unwords ["GetBinaryType",show name]) $
    c_GetBinaryType c_name p_btype
  peek p_btype

----------------------------------------------------------------

-- HANDLE operations

----------------------------------------------------------------


createFile :: WindowsString -> AccessMode -> ShareMode -> Maybe LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> Maybe HANDLE -> IO HANDLE
createFile name access share mb_attr mode flag mb_h =
  withFilePath name $ \ c_name ->
  failIfWithRetry (==iNVALID_HANDLE_VALUE) (unwords ["CreateFile",show name]) $
    c_CreateFile c_name access share (maybePtr mb_attr) mode flag (maybePtr mb_h)

setFileAttributes :: WindowsString -> FileAttributeOrFlag -> IO ()
setFileAttributes name attr =
  withFilePath name $ \ c_name ->
  failIfFalseWithRetry_ (unwords ["SetFileAttributes",show name])
    $ c_SetFileAttributes c_name attr

getFileAttributes :: WindowsString -> IO FileAttributeOrFlag
getFileAttributes name =
  withFilePath name $ \ c_name ->
  failIfWithRetry (== 0xFFFFFFFF) (unwords ["GetFileAttributes",show name]) $
    c_GetFileAttributes c_name

getFileAttributesExStandard :: WindowsString -> IO WIN32_FILE_ATTRIBUTE_DATA
getFileAttributesExStandard name =  alloca $ \res -> do
  withFilePath name $ \ c_name ->
    failIfFalseWithRetry_ "getFileAttributesExStandard" $
      c_GetFileAttributesEx c_name (unsafeCoerce getFileExInfoStandard) res
  peek res


----------------------------------------------------------------

-- File Notifications

--

-- Use these to initialise, "increment" and close a HANDLE you can wait

-- on.

----------------------------------------------------------------


findFirstChangeNotification :: WindowsString -> Bool -> FileNotificationFlag -> IO HANDLE
findFirstChangeNotification path watch flag =
  withFilePath path $ \ c_path ->
  failIfNull (unwords ["FindFirstChangeNotification",show path]) $
    c_FindFirstChangeNotification c_path watch flag


----------------------------------------------------------------

-- Directories

----------------------------------------------------------------



getFindDataFileName :: FindData -> IO WindowsString
getFindDataFileName fd = case unsafeCoerce fd of
  (FindData fp) ->
    withForeignPtr fp $ \p ->
      peekTString (((\hsc_ptr -> hsc_ptr `plusPtr` 44)) p)
{-# LINE 189 "libraries\\Win32\\System\\Win32\\WindowsString\\File.hsc" #-}

findFirstFile :: WindowsString -> IO (HANDLE, FindData)
findFirstFile str = do
  fp_finddata <- mallocForeignPtrBytes (592)
{-# LINE 193 "libraries\\Win32\\System\\Win32\\WindowsString\\File.hsc" #-}
  withForeignPtr fp_finddata $ \p_finddata -> do
    handle <- withFilePath str $ \tstr -> do
                failIf (== iNVALID_HANDLE_VALUE) "findFirstFile" $
                  c_FindFirstFile tstr p_finddata
    return (handle, unsafeCoerce (FindData fp_finddata))


----------------------------------------------------------------

-- DOS Device flags

----------------------------------------------------------------


defineDosDevice :: DefineDosDeviceFlags -> WindowsString -> Maybe WindowsString -> IO ()
defineDosDevice flags name path =
  maybeWith withFilePath path $ \ c_path ->
  withFilePath name $ \ c_name ->
  failIfFalse_ "DefineDosDevice" $ c_DefineDosDevice flags c_name c_path

----------------------------------------------------------------



-- %fun GetDriveType :: Maybe String -> IO DriveType


getDiskFreeSpace :: Maybe WindowsString -> IO (DWORD,DWORD,DWORD,DWORD)
getDiskFreeSpace path =
  maybeWith withFilePath path $ \ c_path ->
  alloca $ \ p_sectors ->
  alloca $ \ p_bytes ->
  alloca $ \ p_nfree ->
  alloca $ \ p_nclusters -> do
  failIfFalse_ "GetDiskFreeSpace" $
    c_GetDiskFreeSpace c_path p_sectors p_bytes p_nfree p_nclusters
  sectors <- peek p_sectors
  bytes <- peek p_bytes
  nfree <- peek p_nfree
  nclusters <- peek p_nclusters
  return (sectors, bytes, nfree, nclusters)

setVolumeLabel :: Maybe WindowsString -> Maybe WindowsString -> IO ()
setVolumeLabel path name =
  maybeWith withFilePath path $ \ c_path ->
  maybeWith withFilePath name $ \ c_name ->
  failIfFalse_ "SetVolumeLabel" $ c_SetVolumeLabel c_path c_name

----------------------------------------------------------------

-- End

----------------------------------------------------------------