From d8ea165173a2b7ba514bb3eafac3d21fc1f4d086 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 21 Jun 2015 17:10:13 +0200 Subject: Switched build system structure & locks --- package.nix | 13 +++++++++++++ src/Trivmix.hs | 32 ++++++++++++++++++++------------ trivmix.cabal | 3 ++- trivmix.nix | 17 ++++++----------- 4 files changed, 41 insertions(+), 24 deletions(-) create mode 100644 package.nix 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; -- cgit v1.2.3