    {-# LINE 1 "src-flock/Lukko/FLock.hsc" #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE InterruptibleFFI #-}
    {-# LANGUAGE Trustworthy #-}
    -- | File locking via BSD-style @flock(2)@.
    module Lukko.FLock (
        -- * Types
        FileLockingNotSupported(..),
        fileLockingSupported,
        FileLockingSupported,
        FileLockingMethod (..),
        fileLockingMethod,
        LockMode(..),
        -- * File descriptors
        FD,
        fdOpen,
        fdClose,
        fdLock,
        fdTryLock,
        fdUnlock,
        -- * Handles
        hLock,
        hTryLock,
        hUnlock,
        ) where

    import Control.Monad (void)
    import System.IO (Handle)

    import Data.Bits
    import Data.Function
    import Foreign.C.Error
    import Foreign.C.Types
    import GHC.Base
    import GHC.IO.Exception

    import Lukko.Internal.FD
    import Lukko.Internal.Types

    -------------------------------------------------------------------------------
    -- Support constants
    -------------------------------------------------------------------------------

    -- | A constants specifying whether file locking is supported.
    fileLockingSupported :: Bool
    fileLockingSupported :: Bool
    fileLockingSupported = Bool
    True

    -- | A type level 'fileLockingSupported'.
    type FileLockingSupported = True

    -- | A constant specifying this method
    fileLockingMethod :: FileLockingMethod
    fileLockingMethod :: FileLockingMethod
    fileLockingMethod = FileLockingMethod
    MethodFLock

    -------------------------------------------------------------------------------
    -- FD
    -------------------------------------------------------------------------------

    -- | Lock using BSD-style locks.
    fdLock :: FD -> LockMode -> IO ()
    fdLock :: FD -> LockMode -> IO ()
    fdLock FD
    fd LockMode
    mode = IO Bool -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl Maybe Handle
    forall a. Maybe a
    Nothing FD
    fd String
    "fdLock" LockMode
    mode Bool
    True)

    -- | Try to lock using BSD-style locks.
    fdTryLock :: FD -> LockMode -> IO Bool
    fdTryLock :: FD -> LockMode -> IO Bool
    fdTryLock FD
    fd LockMode
    mode = Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl Maybe Handle
    forall a. Maybe a
    Nothing FD
    fd String
    "fdTryLock" LockMode
    mode Bool
    False

    -- | Unlock using BSD-style locks.
    fdUnlock :: FD -> IO ()
    fdUnlock :: FD -> IO ()
    fdUnlock = FD -> IO ()
    unlockImpl

    -------------------------------------------------------------------------------
    -- Handle
    -------------------------------------------------------------------------------

    -- | Lock using BSD-style locks.
    hLock :: Handle -> LockMode -> IO ()
    hLock :: Handle -> LockMode -> IO ()
    hLock Handle
    h LockMode
    mode = do
        FD
    fd <- Handle -> IO FD
    handleToFd Handle
    h
        IO Bool -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    h) FD
    fd String
    "hLock" LockMode
    mode Bool
    True)

    -- | Try to lock using BSD-style locks.
    hTryLock :: Handle -> LockMode -> IO Bool
    hTryLock :: Handle -> LockMode -> IO Bool
    hTryLock Handle
    h LockMode
    mode = do
        FD
    fd <- Handle -> IO FD
    handleToFd Handle
    h
        Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    h) FD
    fd String
    "hTryLock" LockMode
    mode Bool
    False

    -- | Unlock using BSD-style locks.
    hUnlock :: Handle -> IO ()
    hUnlock :: Handle -> IO ()
    hUnlock Handle
    h = do
        FD
    fd <- Handle -> IO FD
    handleToFd Handle
    h
        FD -> IO ()
    unlockImpl FD
    fd

    -------------------------------------------------------------------------------
    -- Compat stuff
    -------------------------------------------------------------------------------

    -------------------------------------------------------------------------------
    -- implementation
    -------------------------------------------------------------------------------

    lockImpl :: Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl :: Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl Maybe Handle
    mh (FD CInt
    fd)  String
    ctx LockMode
    mode Bool
    block = do
      let flags :: CInt
    flags = CInt
    cmode CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. (if Bool
    block then CInt
    0 else CInt
    4)
    {-# LINE 106 "src-flock/Lukko/FLock.hsc" #-}
      fix $ \retry -> c_flock fd flags >>= \res -> case res of
        0 -> return True
        _ -> getErrno >>= \errno -> case () of
          _ | not block
            , errno == eAGAIN || errno == eACCES -> return False
            | errno == eINTR -> retry
            | otherwise -> ioException $ errnoToIOError ctx errno mh Nothing
      where
        cmode :: CInt
    cmode = case LockMode
    mode of
          LockMode
    SharedLock    -> CInt
    1
    {-# LINE 116 "src-flock/Lukko/FLock.hsc" #-}
          ExclusiveLock -> 2
    {-# LINE 117 "src-flock/Lukko/FLock.hsc" #-}

    unlockImpl :: FD -> IO ()
    unlockImpl :: FD -> IO ()
    unlockImpl (FD CInt
    fd) = do
      String -> IO CInt -> IO ()
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
    throwErrnoIfMinus1_ String
    "flock" (IO CInt -> IO ()) -> IO CInt -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CInt -> CInt -> IO CInt
    c_flock CInt
    fd CInt
    8
    {-# LINE 121 "src-flock/Lukko/FLock.hsc" #-}

    foreign import ccall interruptible "flock"
      c_flock :: CInt -> CInt -> IO CInt