{-# 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 supports this functionality.

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

import System.Win32.HardLink.Internal
import System.Win32.File   ( failIfFalseWithRetry_ )
import System.Win32.String ( withTString )
import System.Win32.Types  ( 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 :: [Char] -> [Char] -> IO ()
createHardLink = ([Char] -> [Char] -> IO ()) -> [Char] -> [Char] -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [Char] -> IO ()
createHardLink'

createHardLink' :: FilePath -- ^ Hard link name

                -> FilePath -- ^ Target file path

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


{-
-- 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
-}