Waiting until a file stops being modified - haskell

Question

I'm trying to use hinotify and STM to make a simple concept:
Block the thread of execution until the watched file stops being modified
Continue once modifications stop, or their interval is larger than some time threshold (debounces)
Currently, I'm trying to use a TSem to get this working correctly, but I keep running into either of these problems:
the thread doesn't block at all, and I end up removing the hinotify watcher before it even starts, throwing an exception
the thread blocks indefinitely, causing STM to throw an exception
the program prints 3 times (3 concurrent notifications), but only lasts for 1 second and not 10
The code I've written is below, and can be checked out on github to see for yourself.
module Main where
import System.INotify
import System.Environment (getArgs)
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM
import Control.Concurrent.STM.TSem
import Control.Concurrent.STM.TVar
import Control.Monad (forM_)
main :: IO ()
main = do
[file] <- getArgs
-- make changes every 1/10th of a second for 10 seconds
forkIO $ forM_ [0..100] $ \s -> do
appendFile file $ show s
threadDelay (second `div` 10)
debouncer <- atomically $ newTSem 0
notif <- initINotify
expectation <- newTVarIO (0 :: Int)
watcher <- addWatch notif [Modify] file $ \e -> do
e' <- atomically $ do
modifyTVar expectation (+1)
readTVar expectation
print e
threadDelay second
e'' <- readTVarIO expectation
if e' == e''
then atomically $ signalTSem debouncer
else pure ()
atomically $ waitTSem debouncer
removeWatch watcher
killINotify notif
second = 1000000
Do you see anything immediately wrong with what I'm trying to do?

Answer 1

Does it have to be STM? You can achieve you goal with ordinary MVars:
#!/usr/bin/env stack
{- stack
--resolver lts-7.9
--install-ghc runghc
--package hinotify
--package stm
-}
import System.INotify
import System.Environment (getArgs)
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.MVar (newMVar, newEmptyMVar, readMVar, swapMVar, putMVar, takeMVar, modifyMVar_)
import Control.Monad (forM_, forever)
main :: IO ()
main = do
[file] <- getArgs
mainBlocker <- newEmptyMVar
tickCounter <- newMVar 0
-- make changes every 1/10th of a second for 10 seconds
forkIO $ forM_ [0..100] $ \s -> do
appendFile file $ show s
threadDelay (second `div` 10)
-- set up file watches
notif <- initINotify
watcher <- addWatch notif [Modify] file $ \e -> do
swapMVar tickCounter 10
print "file has been modified; reset ticks to 10"
-- 'decreaser' thread
forkIO $ forever $ do
threadDelay second
ticks <- readMVar tickCounter
print $ "current ticks in decreaser thread: " ++ show ticks
if ticks <= 0
then putMVar mainBlocker ()
else modifyMVar_ tickCounter (\v -> return (v-1))
takeMVar mainBlocker
print "exiting..."
removeWatch watcher
killINotify notif
second = 1000000
The idea is a 'tick' counter that gets set to 10 whenever the file has been modified. A separate thread tries to count down to 0 and, when it succeeds, releases the block of the main thread.
If you use stack you can execute the code as a script like this:
stack theCode.hs fileToBeWatched