4 files changed, 41 insertions, 24 deletions

diff --git a/package.nix b/package.nix
new file mode 100644
index 0000000..e15704a
--- /dev/null
+++ b/package.nix
@@ -0,0 +1,13 @@
+{ fetchgit
+, stdenv
+, callPackage
+}:
+
+stdenv.lib.overrideDerivation (callPackage ./trivmix.nix {}) (attrs : {
+  src = fetchgit {
+    url = git://git.yggdrasil.li/trivmix;
+    # nix-shell -p nix-prefetch-scripts --command 'nix-prefetch-git git://git.yggdrasil.li/beuteltier' 2>&1 | grep -E '(git revision|hash) is ' | sed -r 's/git revision is /rev = "/' | sed -r 's/hash is /sha256 = "/' | sed -r 's/$/";/'
+    rev = "f7ea4713957f57fa395779d6db0b020d6eb36512";
+    sha256 = "e6dc0910cee98ee3161617ebcca763f3f3e120497182d43629447a487213f8a1";
+  };
+})
diff --git a/src/Trivmix.hs b/src/Trivmix.hs
index 0c1a1a4..79b3804 100644
--- a/src/Trivmix.hs
+++ b/src/Trivmix.hs
@@ -27,6 +27,7 @@ import Control.Exception
 import System.IO.Error
 import System.IO
 
+import System.FileLock
 import System.INotify
 
 import Data.Char
@@ -164,12 +165,13 @@ handleFiles :: INotify -> MVar Level -> [FilePath] -> IO ()
 handleFiles inotify level files = do
   initLevel <- readMVar level
   levelChanges <- (newChan :: IO (Chan Level))
+  stderrLock <- newMVar
   let 
     handleFile file = do
       levelChanges' <- dupChan levelChanges
       forkIO $ forever $ do -- Broadcast level changes and update all files
-        readChan levelChanges' >>= writeLevel file
-      addWatch inotify watchedAttrs file (const $ readLevel levelChanges level file)
+        readChan levelChanges' >>= writeLevel file stderrLock
+      addWatch inotify watchedAttrs file (const $ readLevel levelChanges level file stderrLock)
   mapM handleFile files
   forkIO $ forever $ do
     readChan levelChanges >>= swapMVar level
@@ -193,7 +195,7 @@ onStateFile file initial action = do
           hPutStrLn stderr $ "Removing ‘" ++ file ++ "’ (file)"
           removeFile file
       acquireDir = (flip mapM) (reverse createDirs) $ \directory -> do
-          hPutStrLn stderr $ "Creating ‘" ++ directory ++ "’ (dir"
+          hPutStrLn stderr $ "Creating ‘" ++ directory ++ "’ (dir)"
           createDirectory directory
           setFileMode directory defDirectoryMode
       releaseDir = (flip mapM) createDirs $ \directory -> do
@@ -214,19 +216,21 @@ takeWhileM pred (x:xs) = do
     False -> do
       return []
 
-readLevel :: Chan Level -> MVar Level -> FilePath -> IO ()
-readLevel levelChan current file = catch action handler
+readLevel :: Chan Level -> MVar Level -> FilePath -> MVar () -> IO ()
+readLevel levelChan current file stderrLock = catch action handler
   where
     action = do
-      level <- readFile file >>= readIO . stripSpace
+      level <- withFileLock file Shared $ readFile file >>= readIO . stripSpace
       oldLevel <- readMVar current
       when (oldLevel /= level) $ do
         writeChan levelChan level
-        hPutStrLn stderr $ "Detected new level: " ++ (show level)
+        withMVarLock stderrLock $ 
+          hPutStrLn stderr $ "Detected new level: " ++ (show level)
     handler e = if isUserError e
                 then do
-                  hPutStrLn stderr $ "Could not parse new level from ‘" ++ file ++ "’ - overwriting."
-                  readMVar current >>= writeLevel file
+                  withMVarLock stderrLock $ 
+                    hPutStrLn stderr $ "Could not parse new level from ‘" ++ file ++ "’ - overwriting."
+                  readMVar current >>= writeLevel file stderrLock
                 else throw e
     stripSpace = reverse . stripSpace' . reverse . stripSpace'
     stripSpace' [] = []
@@ -234,7 +238,11 @@ readLevel levelChan current file = catch action handler
                           then stripSpace' xs
                           else l
 
-writeLevel :: FilePath -> Level -> IO ()
-writeLevel file level = do
-  hPutStrLn stderr $ "Writing out level ‘" ++ (show level) ++ "’ to ‘" ++ file ++ "’"
+writeLevel :: FilePath -> MVar () -> Level -> IO ()
+writeLevel file stderrLock level = withFileLock file Exclusive $ do
+  withMVarLock stderrLock $ 
+    hPutStrLn stderr $ "Writing out level ‘" ++ (show level) ++ "’ to ‘" ++ file ++ "’"
   writeFile file (show level ++ "\n")
+
+withMVarLock :: MVar () -> IO a -> IO a
+withMVarLock lock = bracket_ (putMVar lock ()) (takeMVar lock)
diff --git a/trivmix.cabal b/trivmix.cabal
index b0d77a7..74001d7 100644
--- a/trivmix.cabal
+++ b/trivmix.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                trivmix
-version:             2.3.0
+version:             2.4.0
 -- synopsis:            
 -- description:         
 license:             PublicDomain
@@ -30,6 +30,7 @@ executable trivmix
                      , explicit-exception >=0.1 && <1
                      , process >=1.2 && <2
                      , case-insensitive >=1.2 && <2
+                     , filelock >=0.1 && <1
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -threaded
diff --git a/trivmix.nix b/trivmix.nix
index a5ccb9b..f4228d2 100644
--- a/trivmix.nix
+++ b/trivmix.nix
@@ -1,23 +1,18 @@
 # This file was auto-generated by cabal2nix. Please do NOT edit manually!
 
-{ cabal, filepath, hinotify, jack, optparseApplicative
-, transformers, explicitException, process, caseInsensitive
-, fetchgit
+{ cabal, caseInsensitive, explicitException, filelock, filepath
+, hinotify, jack, optparseApplicative, transformers
 }:
 
 cabal.mkDerivation (self: {
   pname = "trivmix";
-  version = "2.3.0";
-  src = fetchgit {
-    url = git://git.yggdrasil.li/trivmix;
-    rev = "d5189cba07f63c3d2f8c575a31c1734f7c9aeed6";
-    sha256 = "88b215dc2d24b875359835b5a75acdd1d6172ad4d4e3fad9ce4cdc3ffec51ba3";
-  };
+  version = "2.4.0";
+  src = ./.;
   isLibrary = false;
   isExecutable = true;
   buildDepends = [
-    filepath hinotify jack optparseApplicative transformers explicitException process
-    caseInsensitive
+    caseInsensitive explicitException filelock filepath hinotify jack
+    optparseApplicative transformers
   ];
   meta = {
     license = self.stdenv.lib.licenses.publicDomain;