DualLock.hs

{-# LANGUAGE Safe #-}

-- | A dual lock can be taken in either exclusive or shared mode, and also supports
--   switching (atomically) from one mode to the other.
module Data.Columbia.Internal.DualLock where

import System.IO
import System.FileLock
import Control.Monad

data DualLockShared = DualLockShared!FilePath !FileLock !FileLock
data DualLock = DualLock!FilePath !FileLock !FileLock

dualLockShared :: FilePath -> IO DualLockShared
dualLockShared path = liftM2(DualLockShared path)
	(lockFile(path++".lock") Shared)
	(lockFile(path++".lock2") Shared)

dualLock :: FilePath -> IO DualLock
dualLock path = do
	l1 <- lockFile(path++".lock") Exclusive
	tryLockFile(path++".lock2") Exclusive>>=maybe
		(do
		unlockFile l1
		dualLock path)
		((return$!).DualLock path l1)

unlockShared :: DualLockShared -> IO()
unlockShared(DualLockShared _ l1 l2) = unlockFile l1>>unlockFile l2

unlock :: DualLock -> IO()
unlock(DualLock _ l1 l2) = unlockFile l1>>unlockFile l2

-- | N.B. That two simultaneous attempts to switch locks will deadlock. Please protect a critical
--   section that switches locks with some other lock, to ensure this doesn't happen. For instance,
--   the garbage collector protects its use of 'switchLocks' on a dual lock, with an exclusive
--   writer lock.
switchLocks :: DualLockShared->IO DualLock
switchLocks(DualLockShared path l1 l2) = do
	unlockFile l1
	l3 <- lockFile(path++".lock") Exclusive
	unlockFile l2
	tryLockFile(path++".lock2") Exclusive>>=maybe
		(do
		l2' <- lockFile(path++".lock2") Shared
		unlockFile l3
		l1' <- lockFile(path++".lock") Shared
		switchLocks$!DualLockShared path l1' l2')
		((return$!).DualLock path l3)

-- | Switching from an exclusive to a shared lock may be done at any time.
switchLocks2 :: DualLock->IO DualLockShared
switchLocks2(DualLock path l1 l2) = do
	unlockFile l2
	l4 <- lockFile(path++".lock2") Shared
	unlockFile l1
	l3 <- lockFile(path++".lock") Shared
	return$!DualLockShared path l3 l4