1{-# LANGUAGE CPP               #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE RankNTypes        #-}
4module Main (main) where
5
6import Control.Concurrent (threadDelay)
7import Control.Exception  (bracket)
8import System.Environment (getArgs)
9import System.IO          (Handle, IOMode (ReadWriteMode), hClose, openFile)
10
11import qualified Data.ByteString as BS
12import qualified Data.ByteString.Char8 as BS8
13
14import Lukko
15
16#ifdef HAS_OFD_LOCKING
17import qualified Lukko.OFD as OFD
18#endif
19
20#ifdef HAS_FLOCK
21import qualified Lukko.FLock as FLock
22#endif
23
24main :: IO ()
25main = withArgs $ \withLock -> do
26    putStrLn "starting..."
27    withLock $ do
28        contents <- BS.readFile "test-actual"
29        threadDelay 10000 -- 10 ms
30        BS.writeFile "test-actual" $ BS.append contents $ BS8.pack "another line\n"
31
32withArgs
33    :: ((forall r. IO r -> IO r) -> IO ())
34    -> IO ()
35withArgs k = do
36    args <- getArgs
37    case args of
38        ["default"] -> k (genWithLock hLock hUnlock "test-lock")
39#ifdef HAS_OFD_LOCKING
40        ["ofd"]     -> k (genWithLock OFD.hLock OFD.hUnlock "test-lock")
41#endif
42#ifdef HAS_FLOCK
43        ["flock"]   -> k (genWithLock FLock.hLock FLock.hUnlock "test-lock")
44#endif
45        ["noop"]    -> k (genWithLock noOpLock noOpUnlock "test-lock")
46        _           -> putStrLn "Unknown paramters. Doing nothing."
47
48-------------------------------------------------------------------------------
49-- copy pasted
50-------------------------------------------------------------------------------
51
52noOpLock :: Handle -> LockMode -> IO ()
53noOpLock _ _ = return ()
54
55noOpUnlock :: Handle -> IO ()
56noOpUnlock _ = return ()
57
58genWithLock
59    :: (Handle -> LockMode -> IO ())
60    -> (Handle -> IO ())
61    -> FilePath
62    -> IO a
63    -> IO a
64genWithLock implLock implUnlock fp action =
65    bracket takeLock releaseLock (const action)
66  where
67    takeLock = do
68        h <- openFile fp ReadWriteMode
69        implLock h ExclusiveLock
70        return h
71
72    releaseLock :: Handle -> IO ()
73    releaseLock h = do
74        implUnlock h
75        hClose h
76