    {-# LANGUAGE CPP #-}

    module General.FileLock(usingLockFile) where

    import Control.Exception.Extra
    import System.FilePath
    import General.Extra
    import General.Cleanup
    #ifdef mingw32_HOST_OS
    import Control.Monad
    import Data.Bits
    import Data.Word
    import Foreign.Ptr
    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 :: CWString -> 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

    usingLockFile :: Cleanup -> FilePath -> IO ()

    #ifdef mingw32_HOST_OS

    usingLockFile b file = do
        createDirectoryRecursive $ takeDirectory file
        let open = withCWString file $ \cfile ->
                c_CreateFileW cfile (c_GENERIC_READ .|. c_GENERIC_WRITE) c_FILE_SHARE_NONE nullPtr c_OPEN_ALWAYS c_FILE_ATTRIBUTE_NORMAL nullPtr
        h <- allocate b open (void . c_CloseHandle)
        when (h == c_INVALID_HANDLE_VALUE) $ 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

    usingLockFile :: Cleanup -> FilePath -> IO ()
    usingLockFile Cleanup
    cleanup FilePath
    file = do
        FilePath -> IO ()
    createDirectoryRecursive (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    takeDirectory FilePath
    file
        IO () -> IO (Either IOException ())
    forall a. IO a -> IO (Either IOException a)
    tryIO (IO () -> IO (Either IOException ()))
    -> IO () -> IO (Either IOException ())
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> IO ()
    writeFile FilePath
    file FilePath
    ""

        Fd
    fd <- Cleanup -> IO Fd -> (Fd -> IO ()) -> IO Fd
    forall a. Cleanup -> IO a -> (a -> IO ()) -> IO a
    allocate Cleanup
    cleanup (FilePath -> OpenMode -> IO Fd
    openSimpleFd FilePath
    file OpenMode
    ReadWrite) Fd -> IO ()
    closeFd
        let lock :: (LockRequest, SeekMode, FileOffset, FileOffset)
    lock = (LockRequest
    WriteLock, SeekMode
    AbsoluteSeek, FileOffset
    0, FileOffset
    0)
        Fd -> (LockRequest, SeekMode, FileOffset, FileOffset) -> IO ()
    setLock Fd
    fd (LockRequest, SeekMode, FileOffset, FileOffset)
    lock IO () -> (IOException -> IO ()) -> IO ()
    forall a. IO a -> (IOException -> IO a) -> IO a
    `catchIO` \IOException
    e -> do
            Maybe (ProcessID, (LockRequest, SeekMode, FileOffset, FileOffset))
    res <- Fd
    -> (LockRequest, SeekMode, FileOffset, FileOffset)
    -> IO
         (Maybe
            (ProcessID, (LockRequest, SeekMode, FileOffset, FileOffset)))
    getLock Fd
    fd (LockRequest, SeekMode, FileOffset, FileOffset)
    lock
            FilePath -> IO ()
    forall a. Partial => FilePath -> IO a
    errorIO (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Shake failed to acquire a file lock on " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    file FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "\n" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
                        (case Maybe (ProcessID, (LockRequest, SeekMode, FileOffset, FileOffset))
    res of
                            Maybe (ProcessID, (LockRequest, SeekMode, FileOffset, FileOffset))
    Nothing -> FilePath
    ""
                            Just (ProcessID
    pid, (LockRequest, SeekMode, FileOffset, FileOffset)
    _) -> FilePath
    "Shake process ID " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ProcessID -> FilePath
    forall a. Show a => a -> FilePath
    show ProcessID
    pid FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " is using this lock.\n") FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
                        IOException -> FilePath
    forall a. Show a => a -> FilePath
    show IOException
    e

    #ifndef MIN_VERSION_unix
    #define MIN_VERSION_unix(a,b,c) 0
    #endif
    #if MIN_VERSION_unix(2,8,0)
    openSimpleFd :: FilePath -> OpenMode -> IO Fd
    openSimpleFd FilePath
    file OpenMode
    mode = FilePath -> OpenMode -> OpenFileFlags -> IO Fd
    openFd FilePath
    file OpenMode
    mode OpenFileFlags
    defaultFileFlags
    #else
    openSimpleFd file mode = openFd file mode Nothing defaultFileFlags
    #endif

    #endif