{-# LANGUAGE DataKinds #-}
{-# LANGUAGE Safe      #-}
-- | Non-operating locks.
--
-- All functions throw 'FileLockingNotImplemented'.
module Lukko.NoOp (
    -- * Types
    FileLockingNotSupported(..),
    fileLockingSupported,
    FileLockingSupported,
    FileLockingMethod (..),
    fileLockingMethod,
    LockMode(..),
    -- * File descriptors
    FD,
    fdOpen,
    fdClose,
    fdLock,
    fdTryLock,
    fdUnlock,
    -- * Handles
    hLock,
    hTryLock,
    hUnlock,
    ) where

import Control.Exception (throwIO)
import System.IO         (Handle)

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

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

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

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

-- | No-op implementation.
hLock :: Handle -> LockMode -> IO ()
hLock :: Handle -> LockMode -> IO ()
hLock Handle
_ LockMode
_ = FileLockingNotSupported -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileLockingNotSupported
FileLockingNotSupported

-- | No-op implementation
hTryLock :: Handle -> LockMode -> IO Bool
hTryLock :: Handle -> LockMode -> IO Bool
hTryLock Handle
_ LockMode
_ = FileLockingNotSupported -> IO Bool
forall e a. Exception e => e -> IO a
throwIO FileLockingNotSupported
FileLockingNotSupported

-- | No-op implementation.
hUnlock :: Handle -> IO ()
hUnlock :: Handle -> IO ()
hUnlock Handle
_ = FileLockingNotSupported -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileLockingNotSupported
FileLockingNotSupported

-- | No-op implementation.
fdLock :: FD -> LockMode -> IO ()
fdLock :: FD -> LockMode -> IO ()
fdLock FD
_ LockMode
_ = FileLockingNotSupported -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileLockingNotSupported
FileLockingNotSupported

-- | No-op implementation
fdTryLock :: FD -> LockMode -> IO Bool
fdTryLock :: FD -> LockMode -> IO Bool
fdTryLock FD
_ LockMode
_ = FileLockingNotSupported -> IO Bool
forall e a. Exception e => e -> IO a
throwIO FileLockingNotSupported
FileLockingNotSupported

-- | No-op implementation.
fdUnlock :: FD -> IO ()
fdUnlock :: FD -> IO ()
fdUnlock FD
_ = FileLockingNotSupported -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileLockingNotSupported
FileLockingNotSupported