    {-# LANGUAGE CPP #-}

    module General.FileLock(withLockFile) where

    import Control.Exception.Extra
    import System.FilePath
    import General.Extra
    #ifdef mingw32_HOST_OS
    import Data.Bits
    import Data.Word
    import Foreign.Ptr
    import Foreign.C.Types
    import Foreign.C.String
    #else
    import System.IO
    import System.Posix.IO
    #endif

    #ifdef mingw32_HOST_OS

    #ifdef x86_64_HOST_ARCH
    #define CALLCONV ccall
    #else
    #define CALLCONV stdcall
    #endif

    foreign import CALLCONV unsafe "Windows.h CreateFileW" c_CreateFileW :: Ptr CWchar -> Word32 -> Word32 -> Ptr () -> Word32 -> Word32 -> Ptr () -> IO (Ptr ())
    foreign import CALLCONV unsafe "Windows.h CloseHandle" c_CloseHandle :: Ptr () -> IO Bool
    foreign import CALLCONV unsafe "Windows.h GetLastError" c_GetLastError :: IO Word32

    c_GENERIC_WRITE = 0x40000000 :: Word32
    c_GENERIC_READ  = 0x80000000 :: Word32
    c_FILE_SHARE_NONE = 0 :: Word32
    c_OPEN_ALWAYS = 4 :: Word32
    c_FILE_ATTRIBUTE_NORMAL = 0x80 :: Word32
    c_INVALID_HANDLE_VALUE = intPtrToPtr (-1)
    c_ERROR_SHARING_VIOLATION = 32
    #endif

    withLockFile :: FilePath -> IO a -> IO a

    #ifdef mingw32_HOST_OS

    withLockFile file act = withCWString file $ \cfile -> do
        createDirectoryRecursive $ takeDirectory file
        let open = c_CreateFileW cfile (c_GENERIC_READ .|. c_GENERIC_WRITE) c_FILE_SHARE_NONE nullPtr c_OPEN_ALWAYS c_FILE_ATTRIBUTE_NORMAL nullPtr
        bracket open c_CloseHandle $ \h ->
            if h == c_INVALID_HANDLE_VALUE then do
                err <- c_GetLastError
                errorIO $ "Shake failed to acquire a file lock on " ++ file ++ "\n" ++
                          (if err == c_ERROR_SHARING_VIOLATION
                              then "ERROR_SHARING_VIOLATION - Shake is probably already running."
                              else "Code " ++ show err ++ ", unknown reason for failure.")
            else
                act

    #else

    withLockFile file act = do
        createDirectoryRecursive $ takeDirectory file
        tryIO $ writeFile file ""

        bracket (openFd file ReadWrite Nothing defaultFileFlags) closeFd $ \fd -> do
            let lock = (WriteLock, AbsoluteSeek, 0, 0)
            res <- tryIO $ setLock fd lock
            case res of
                Right () -> act
                Left e -> do
                    res <- getLock fd lock
                    errorIO $ "Shake failed to acquire a file lock on " ++ file ++ "\n" ++
                              (case res of
                                   Nothing -> ""
                                   Just (pid, _) -> "Shake process ID " ++ show pid ++ " is using this lock.\n") ++
                              show e

    #endif