{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}

-- | This module provides a portable interface to file locks as a mechanism for
-- inter-process synchronization.
--
-- Each file lock is associated with a file. When taking a lock, the assiciated
-- file is created if it's not present, then the file is locked in an
-- OS-dependent way. While the lock is being held, no other process or
-- thread can take it, unless the specified 'SharedExclusive' values
-- allow it.
--
-- All locks held by a process are released when the process exits. They can
-- also be explicitly released using 'unlockFile'.
--
-- It is not recommended to open or otherwise use lock files for other
-- purposes, because it tends to expose differences between operating systems.
-- For example, on Windows 'System.IO.openFile' for a lock file will fail when
-- the lock is held, but on Unix it won't.
--
-- Note on the implementation: currently the module uses flock(2) on non-Windows
-- platforms, and LockFileEx on Windows.
--
-- On non-Windows platforms, @InterruptibleFFI@ is used in the implementation to
-- ensures that blocking lock calls can be correctly interrupted by async
-- exceptions (e.g. functions like `timeout`).  This has been tested on Linux.
module System.FileLock
  ( FileLock
  , SharedExclusive(..)
  , lockFile
  , tryLockFile
  , unlockFile
  , withFileLock
  , withTryFileLock
  ) where

import Control.Applicative
import qualified Control.Exception as E
import Control.Monad
import Data.IORef
import Data.Traversable (traverse)
import Data.Typeable
import Prelude

#ifdef USE_FLOCK
import qualified System.FileLock.Internal.Flock as I
#elif USE_LOCKFILEEX
import qualified System.FileLock.Internal.LockFileEx as I
#else
#error No backend is available
#endif

-- | A token that represents ownership of a lock.
data FileLock = Lock
  {-# UNPACk #-} !I.Lock
  {-# UNPACk #-} !(IORef Bool) -- alive?
  deriving (Typeable)

instance Eq FileLock where
  Lock Lock
_ IORef Bool
x == :: FileLock -> FileLock -> Bool
== Lock Lock
_ IORef Bool
y = IORef Bool
x IORef Bool -> IORef Bool -> Bool
forall a. Eq a => a -> a -> Bool
== IORef Bool
y

newLock :: I.Lock -> IO FileLock
newLock :: Lock -> IO FileLock
newLock Lock
x = Lock -> IORef Bool -> FileLock
Lock Lock
x (IORef Bool -> FileLock) -> IO (IORef Bool) -> IO FileLock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True

-- | A type of lock to be taken.
data SharedExclusive
  = Shared -- ^ Other process can hold a shared lock at the same time.
  | Exclusive -- ^ No other process can hold a lock, shared or exclusive.
  deriving (Int -> SharedExclusive -> ShowS
[SharedExclusive] -> ShowS
SharedExclusive -> String
(Int -> SharedExclusive -> ShowS)
-> (SharedExclusive -> String)
-> ([SharedExclusive] -> ShowS)
-> Show SharedExclusive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SharedExclusive] -> ShowS
$cshowList :: [SharedExclusive] -> ShowS
show :: SharedExclusive -> String
$cshow :: SharedExclusive -> String
showsPrec :: Int -> SharedExclusive -> ShowS
$cshowsPrec :: Int -> SharedExclusive -> ShowS
Show, SharedExclusive -> SharedExclusive -> Bool
(SharedExclusive -> SharedExclusive -> Bool)
-> (SharedExclusive -> SharedExclusive -> Bool)
-> Eq SharedExclusive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SharedExclusive -> SharedExclusive -> Bool
$c/= :: SharedExclusive -> SharedExclusive -> Bool
== :: SharedExclusive -> SharedExclusive -> Bool
$c== :: SharedExclusive -> SharedExclusive -> Bool
Eq, Typeable)

-- | Take a lock. This function blocks until the lock is available.
lockFile :: FilePath -> SharedExclusive -> IO FileLock
lockFile :: String -> SharedExclusive -> IO FileLock
lockFile String
path SharedExclusive
mode = Lock -> IO FileLock
newLock (Lock -> IO FileLock) -> IO Lock -> IO FileLock
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Bool -> IO Lock
I.lock String
path (SharedExclusive
mode SharedExclusive -> SharedExclusive -> Bool
forall a. Eq a => a -> a -> Bool
== SharedExclusive
Exclusive)

-- | Try to take a lock. This function does not block. If the lock is not
-- immediately available, it returns Nothing.
tryLockFile :: FilePath -> SharedExclusive -> IO (Maybe FileLock)
tryLockFile :: String -> SharedExclusive -> IO (Maybe FileLock)
tryLockFile String
path SharedExclusive
mode = (Lock -> IO FileLock) -> Maybe Lock -> IO (Maybe FileLock)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Lock -> IO FileLock
newLock (Maybe Lock -> IO (Maybe FileLock))
-> IO (Maybe Lock) -> IO (Maybe FileLock)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Bool -> IO (Maybe Lock)
I.tryLock String
path (SharedExclusive
mode SharedExclusive -> SharedExclusive -> Bool
forall a. Eq a => a -> a -> Bool
== SharedExclusive
Exclusive)

-- | Release the lock.
unlockFile :: FileLock -> IO ()
unlockFile :: FileLock -> IO ()
unlockFile (Lock Lock
l IORef Bool
ref) = do
  Bool
wasAlive <- IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Bool
ref ((Bool -> (Bool, Bool)) -> IO Bool)
-> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Bool
old -> (Bool
False, Bool
old)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
wasAlive (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Lock -> IO ()
I.unlock Lock
l

-- | Perform some action with a lock held. Blocks until the lock is available.
withFileLock :: FilePath -> SharedExclusive -> (FileLock -> IO a) -> IO a
withFileLock :: String -> SharedExclusive -> (FileLock -> IO a) -> IO a
withFileLock String
path SharedExclusive
mode = IO FileLock -> (FileLock -> IO ()) -> (FileLock -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (String -> SharedExclusive -> IO FileLock
lockFile String
path SharedExclusive
mode) FileLock -> IO ()
unlockFile

-- | Perform sme action with a lock held. Non-blocking.
withTryFileLock :: FilePath -> SharedExclusive -> (FileLock -> IO a) -> IO (Maybe a)
withTryFileLock :: String -> SharedExclusive -> (FileLock -> IO a) -> IO (Maybe a)
withTryFileLock String
path SharedExclusive
mode FileLock -> IO a
f = IO (Maybe FileLock)
-> (Maybe FileLock -> IO (Maybe ()))
-> (Maybe FileLock -> IO (Maybe a))
-> IO (Maybe a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (String -> SharedExclusive -> IO (Maybe FileLock)
tryLockFile String
path SharedExclusive
mode) ((FileLock -> IO ()) -> Maybe FileLock -> IO (Maybe ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FileLock -> IO ()
unlockFile) ((FileLock -> IO a) -> Maybe FileLock -> IO (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FileLock -> IO a
f)