filelock 0.1.0.1 → 0.1.1.1

raw patch · 4 files changed

+104/−2 lines, 4 filesdep +asyncdep +filelockdep +processdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: async, filelock, process

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• System/FileLock.hs +7/−1
• System/FileLock/Internal/Flock.hsc +1/−0
• filelock.cabal +9/−1
• tests/test.hs +87/−0

@@ -27,6 +27,7 @@   , tryLockFile   , unlockFile   , withFileLock+  , withTryFileLock   ) where  import Control.Applicative@@ -35,6 +36,7 @@ import Data.IORef import Data.Traversable (traverse) import Data.Typeable+import Prelude  #ifdef USE_FLOCK import qualified System.FileLock.Internal.Flock as I@@ -77,6 +79,10 @@   wasAlive <- atomicModifyIORef ref $ \old -> (False, old)   when wasAlive $ I.unlock l --- | Perform some action with a lock held.+-- | Perform some action with a lock held. Blocks until the lock is available. withFileLock :: FilePath -> SharedExclusive -> (FileLock -> IO a) -> IO a withFileLock path mode = E.bracket (lockFile path mode) unlockFile++-- | Perform sme action with a lock held. Non-blocking.+withTryFileLock :: FilePath -> SharedExclusive -> (FileLock -> IO a) -> IO (Maybe a)+withTryFileLock path mode f = E.bracket (tryLockFile path mode) (traverse unlockFile) (traverse f)

@@ -14,6 +14,7 @@ import System.Posix.Files import System.Posix.IO (openFd, closeFd, defaultFileFlags, OpenMode(..)) import System.Posix.Types+import Prelude  type Lock = Fd 

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                filelock-version:             0.1.0.1+version:             0.1.1.1 synopsis:            Portable interface to file locking (flock / LockFileEx) description:         This package provides an interface to Windows and Unix                      file locking functionalities.@@ -33,3 +33,11 @@   else     cpp-options:      -DUSE_FLOCK     build-depends:    unix++test-suite test+  type:               exitcode-stdio-1.0+  hs-source-dirs:     tests+  main-is:            test.hs+  build-depends:      filelock, process, async, base+  ghc-options:        -threaded+  default-language:   Haskell2010

@@ -0,0 +1,87 @@+{-# LANGUAGE ViewPatterns #-}++import Control.Monad+import Control.Concurrent+import Control.Concurrent.Async+import System.Environment+import System.Exit+import System.Process+import System.IO++import System.FileLock++main :: IO ()+main = do+  hSetBuffering stdout LineBuffering+  args <- getArgs+  case args of+    ["shared", read -> duration]+      -> holdLock "shared" Shared duration+    ["exclusive", read -> duration]+      -> holdLock "exclusive" Exclusive duration+    ["try"]+      -> tryTakingLock+    ["tryshared", read -> duration]+      -> tryHoldLock "shared" Shared duration+    ["tryexclusive", read -> duration]+      -> tryHoldLock "exclusive" Exclusive duration+    _ -> do+      withFile "lock.log" WriteMode $ \h ->+        void $ mapConcurrently id+          [ callSelf h ["shared", "300"]+          , callSelf h ["shared", "200"]+          , msleep 10 >> callSelf h ["exclusive", "500"]+          , msleep 20 >> callSelf h ["try"]+          , msleep 50 >> callSelf h ["shared", "500"]+          , msleep 700 >> callSelf h ["shared", "10"]+          , msleep 1500 >> callSelf h ["try"]+          ]+      msleep 2000+      log <- readFile "lock.log"+      expected <- readFile "tests/lock.log.expected"+      when (log /= expected) $ do+        putStrLn "log mismatch!"+        exitFailure++callSelf :: Handle -> [String] -> IO ()+callSelf out args = do+  self <- getExecutablePath+  (_hin, _hout, _herr, ph) <- createProcess_ "callSelf"+    (proc self args) { std_out = UseHandle out }+  ExitSuccess <- waitForProcess ph+  return ()++msleep :: Int -> IO ()+msleep = threadDelay . (*1000)++holdLock :: String -> SharedExclusive -> Int -> IO ()+holdLock ty sex duration = do+  withFileLock lockfile sex $ \_ -> do+    putStrLn $ "took " ++ desc+    msleep duration+  putStrLn $ "released " ++ desc+  where+    desc = ty ++ " lock"++tryTakingLock :: IO ()+tryTakingLock = do+  ml <- tryLockFile lockfile Exclusive+  case ml of+    Nothing -> putStrLn "lock not available"+    Just l -> do+      putStrLn "lock was available"+      unlockFile l++tryHoldLock :: String -> SharedExclusive -> Int -> IO ()+tryHoldLock ty sex duration = do+  res <- withTryFileLock lockfile sex $ \_ -> do+    putStrLn $ "took " ++ desc+    msleep duration+  case res of+    Nothing -> putStrLn "lock not available"+    Just _  -> putStrLn $ "released " ++ desc+  where+    desc = ty ++ " lock"++lockfile :: String+lockfile = "lock"