{-# LANGUAGE CPP #-}
{- |
   Module      :  System.Win32.HardLink
   Copyright   :  2013 shelarcy
   License     :  BSD-style

   Maintainer  :  shelarcy@gmail.com
   Stability   :  Provisional
   Portability :  Non-portable (Win32 API)

   Handling hard link using Win32 API. [NTFS only]

   Note: You should worry about file system type when use this module's function in your application:

     * NTFS only supprts this functionality.

     * ReFS doesn't support hard link currently.
-}
module System.Win32.HardLink
  ( createHardLink
  , createHardLink'
  ) where

import System.Win32.File   ( LPSECURITY_ATTRIBUTES, failIfFalseWithRetry_ )
import System.Win32.String ( LPCTSTR, withTString )
import System.Win32.Types  ( BOOL, nullPtr )

#include "windows_cconv.h"

-- | NOTE: createHardLink is /flipped arguments/ to provide compatibility for Unix.

-- 

-- If you want to create hard link by Windows way, use 'createHardLink'' instead.

createHardLink :: FilePath -- ^ Target file path

               -> FilePath -- ^ Hard link name

               -> IO ()
createHardLink :: FilePath -> FilePath -> IO ()
createHardLink = forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> IO ()
createHardLink'

createHardLink' :: FilePath -- ^ Hard link name

                -> FilePath -- ^ Target file path

                -> IO ()
createHardLink' :: FilePath -> FilePath -> IO ()
createHardLink' FilePath
link FilePath
target =
   forall a. FilePath -> (LPTSTR -> IO a) -> IO a
withTString FilePath
target forall a b. (a -> b) -> a -> b
$ \LPTSTR
c_target ->
   forall a. FilePath -> (LPTSTR -> IO a) -> IO a
withTString FilePath
link   forall a b. (a -> b) -> a -> b
$ \LPTSTR
c_link ->
        FilePath -> IO Bool -> IO ()
failIfFalseWithRetry_ ([FilePath] -> FilePath
unwords [FilePath
"CreateHardLinkW",forall a. Show a => a -> FilePath
show FilePath
link,forall a. Show a => a -> FilePath
show FilePath
target]) forall a b. (a -> b) -> a -> b
$
          LPTSTR -> LPTSTR -> LPSECURITY_ATTRIBUTES -> IO Bool
c_CreateHardLink LPTSTR
c_link LPTSTR
c_target forall a. Ptr a
nullPtr

foreign import WINDOWS_CCONV unsafe "windows.h CreateHardLinkW"
  c_CreateHardLink :: LPCTSTR -- ^ Hard link name

                   -> LPCTSTR -- ^ Target file path

                   -> LPSECURITY_ATTRIBUTES -- ^ This parameter is reserved. You should pass just /nullPtr/.

                   -> IO BOOL

{-
-- We plan to check file system type internally.

-- We are thinking about API design, currently...
data VolumeInformation = VolumeInformation
      { volumeName         :: String
      , volumeSerialNumber :: DWORD
      , maximumComponentLength :: DWORD
      , fileSystemFlags    :: DWORD
      , fileSystemName     :: String
      } deriving Show

getVolumeInformation :: Maybe String -> IO VolumeInformation
getVolumeInformation drive =
   maybeWith withTString drive $ \c_drive ->
   withTStringBufferLen 256    $ \(vnBuf, vnLen) ->
   alloca $ \serialNum ->
   alloca $ \maxLen ->
   alloca $ \fsFlags ->
   withTStringBufferLen 256 $ \(fsBuf, fsLen) -> do
       failIfFalse_ (unwords ["GetVolumeInformationW", drive]) $
         c_GetVolumeInformation c_drive vnBuf (fromIntegral vnLen)
                                serialNum maxLen fsFlags
                                fsBuf (fromIntegral fsLen)
       return VolumeInformation
         <*> peekTString vnBuf
         <*> peek serialNum
         <*> peek maxLen
         <*> peek fsFlags
         <*> peekTString fsBuf

-- Which is better?
getVolumeFileType :: String -> IO String
getVolumeFileType drive = fileSystemName <$> getVolumeInformation drive

getVolumeFileType :: String -> IO String
getVolumeFileType drive =
   withTString drive        $ \c_drive ->
   withTStringBufferLen 256 $ \(buf, len) -> do
       failIfFalse_ (unwords ["GetVolumeInformationW", drive]) $
         c_GetVolumeInformation c_drive nullPtr 0 nullPtr nullPtr nullPtr buf (fromIntegral len)
       peekTString buf

foreign import WINDOWS_CCONV unsafe "windows.h GetVolumeInformationW"
  c_GetVolumeInformation :: LPCTSTR -> LPTSTR -> DWORD -> LPDWORD -> LPDWORD -> LPDWORD -> LPTSTR -> DWORD -> IO BOOL
-}