From 8a8d1a99243af120b2e4187c2d90855f02f85f31 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 15 May 2018 22:26:08 +0200 Subject: Debugging --- package.yaml | 2 +- trivmix.nix | 2 +- trivmix/Trivmix.hs | 20 +++++++++++--------- 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/package.yaml b/package.yaml index 44621d5..8e5eb44 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: trivmix -version: 4.0.1 +version: 4.0.2 license: PublicDomain license-file: LICENSE author: Gregor Kleen diff --git a/trivmix.nix b/trivmix.nix index 8ddce63..8aa59cc 100644 --- a/trivmix.nix +++ b/trivmix.nix @@ -5,7 +5,7 @@ }: mkDerivation { pname = "trivmix"; - version = "4.0.1"; + version = "4.0.2"; src = ./.; isLibrary = true; isExecutable = true; diff --git a/trivmix/Trivmix.hs b/trivmix/Trivmix.hs index 7c18965..b9474f2 100644 --- a/trivmix/Trivmix.hs +++ b/trivmix/Trivmix.hs @@ -172,11 +172,12 @@ trivmix Options{..} = do level <- newMVar initialLevel balance <- newMVar initialBalance level' <- newMVar 0 + stderrLock <- newEmptyMVar let withFiles = foldl (.) id $ map (\f -> onStateFile f (show initialLevel ++ "\n")) levelFiles ++ map (\f -> onStateFile f (show initialBalance ++ "\n")) balanceFiles withFiles $ withINotify $ \inotify -> do handleFiles inotify level levelFiles - handleFiles inotify balance levelFiles + handleFiles inotify balance balanceFiles Jack.handleExceptions $ Jack.withClientDefault client $ \client' -> Jack.withPort client' input $ \input' -> @@ -196,18 +197,19 @@ trivmix Options{..} = do currentLevel <- (\(CFloat f) -> Lin . either error id . refine $ realToFrac f) <$> readMVar level' case compare currentLevel newLevel of EQ -> threadDelay . round $ interval * 1e6 - _ -> mapM_ (\x -> (swapMVar level' $! toRealFloat . unrefine . toLin $ linInt' x currentLevel newLevel) >> threadDelay delay) (takeWhile (<= 1) $ iterate (+ recip frames) 0) + _ -> do + mapM_ (\x -> (swapMVar level' $! toRealFloat . unrefine . toLin $ linInt' x currentLevel newLevel) >> threadDelay delay) (takeWhile (<= 1) $ iterate (+ recip frames) 0) + withMVarLock stderrLock . hPutStrLn stderr $ "Finished smooth transition from ‘" ++ show currentLevel ++ "’ to ‘" ++ show newLevel ++ "’." notifyReady forever $ threadDelay (round $ watchdogInterval * 1e6) >> notifyWatchdog mix :: MVar CFloat -> CFloat -> IO CFloat mix level input = (input *) <$> readMVar level -handleFiles :: (Read l, Show l, Eq l) => INotify -> MVar l -> [FilePath] -> IO () -handleFiles inotify level files = do +handleFiles :: (Read l, Show l, Eq l) => INotify -> MVar l -> MVar () -> [FilePath] -> IO () +handleFiles inotify level stderrLock files = do initLevel <- readMVar level levelChanges <- newChan - stderrLock <- newEmptyMVar let handleFile file = addWatch inotify watchedAttrs file (const $ readLevel levelChanges level file stderrLock) mapM_ handleFile files @@ -227,19 +229,19 @@ onStateFile file initial action = do setFileCreationMask nullFileMode let acquireFile = case exists of True -> return () - False -> do + False -> withMVarLock stderrLock $ do hPutStrLn stderr $ "Creating ‘" ++ file ++ "’ (file)" createFile file defFileMode >>= closeFd >> writeFile file initial releaseFile = case exists of True -> return () - False -> do + False -> withMVarLock stderrLock $ do hPutStrLn stderr $ "Removing ‘" ++ file ++ "’ (file)" removeFile file - acquireDir = (flip mapM) (reverse createDirs) $ \directory -> do + acquireDir = (flip mapM) (reverse createDirs) $ \directory -> withMVarLock stderrLock $ do hPutStrLn stderr $ "Creating ‘" ++ directory ++ "’ (dir)" createDirectory directory setFileMode directory defDirectoryMode - releaseDir = (flip mapM) createDirs $ \directory -> do + releaseDir = (flip mapM) createDirs $ \directory -> withMVarLock stderrLock $ do hPutStrLn stderr $ "Removing ‘" ++ directory ++ "’ (dir)" removeDirectory directory acquire = acquireDir >> acquireFile -- cgit v1.2.3