{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ImplicitParams #-}
module Monitor.Queue where

import GHC.Conc

import Control.Concurrent
import qualified Control.Concurrent.Lifted as Lifted
import Control.Concurrent.STM.TVar

import System.Directory
import System.FilePath

import qualified Data.HashMap.Strict as HM
import Data.Maybe
import qualified Data.Text.IO as T
import Data.Time

import Monitor.DataModel
import Monitor.Loader
import Monitor.DB
import Monitor.Telegram

-- This is a hack. On connection error all thread must try to restart.
touchConfig :: (?mutex :: Mutexes) => Monitor ()
touchConfig :: Monitor ()
touchConfig = do
  FilePath
dir <- (Settings -> FilePath) -> Monitor FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> FilePath
databaseDirectory
  FilePath -> Monitor ()
forall (m :: * -> *).
(?mutex::Mutexes, MonadIO m) =>
FilePath -> m ()
logMessage (FilePath
"Monitor at " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
dir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"is restarted in order to reestablish db connection.")
  UTCTime
time <- IO UTCTime -> Monitor UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> IO () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ FilePath -> UTCTime -> IO ()
setModificationTime (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
configName) UTCTime
time

processQueryResult :: (?mutex :: Mutexes) => FilePath -> PureJob -> JobFeedback -> Monitor ()
processQueryResult :: FilePath -> PureJob -> JobFeedback -> Monitor ()
processQueryResult FilePath
_path PureJob
_ (ConnectionError FilePath
err) =
  (?mutex::Mutexes) => FilePath -> Monitor ()
FilePath -> Monitor ()
alertConnectionError FilePath
err Monitor () -> Monitor () -> Monitor ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Monitor ()
(?mutex::Mutexes) => Monitor ()
touchConfig
processQueryResult FilePath
path PureJob{FilePath
ByteString
Assertion
pureJobSQL :: PureJob -> ByteString
pureJobAssertion :: PureJob -> Assertion
pureJobDescription :: PureJob -> FilePath
pureJobSQL :: ByteString
pureJobAssertion :: Assertion
pureJobDescription :: FilePath
..} (QueryError FilePath
err) =
  (?mutex::Mutexes) =>
FilePath -> FilePath -> ByteString -> Monitor ()
FilePath -> FilePath -> ByteString -> Monitor ()
alertQueryError FilePath
path FilePath
err ByteString
pureJobSQL
processQueryResult FilePath
path PureJob
job (AssertionResult Bool
value) =
  if Bool
value
    then () -> Monitor ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else (?mutex::Mutexes) => FilePath -> PureJob -> Monitor ()
FilePath -> PureJob -> Monitor ()
alertFailedAssertion FilePath
path PureJob
job

purify :: Job -> Assertion -> FilePath -> PureJob
purify :: Job -> Assertion -> FilePath -> PureJob
purify Job{Maybe Int
Maybe FilePath
Maybe Assertion
ByteString
jobSQL :: Job -> ByteString
jobAssertion :: Job -> Maybe Assertion
jobFrequency :: Job -> Maybe Int
jobDescription :: Job -> Maybe FilePath
jobSQL :: ByteString
jobAssertion :: Maybe Assertion
jobFrequency :: Maybe Int
jobDescription :: Maybe FilePath
..} Assertion
assertion FilePath
path = PureJob :: FilePath -> Assertion -> ByteString -> PureJob
PureJob {
    pureJobDescription :: FilePath
pureJobDescription = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath
"Job at " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path) Maybe FilePath
jobDescription
  , pureJobAssertion :: Assertion
pureJobAssertion = Assertion -> Maybe Assertion -> Assertion
forall a. a -> Maybe a -> a
fromMaybe Assertion
assertion Maybe Assertion
jobAssertion
  , pureJobSQL :: ByteString
pureJobSQL = ByteString
jobSQL
  }

periodicEvent :: (?mutex :: Mutexes) => Job -> FilePath -> Monitor ()
periodicEvent :: Job -> FilePath -> Monitor ()
periodicEvent job :: Job
job@Job{Maybe Int
Maybe FilePath
Maybe Assertion
ByteString
jobSQL :: ByteString
jobAssertion :: Maybe Assertion
jobFrequency :: Maybe Int
jobDescription :: Maybe FilePath
jobSQL :: Job -> ByteString
jobAssertion :: Job -> Maybe Assertion
jobFrequency :: Job -> Maybe Int
jobDescription :: Job -> Maybe FilePath
..} FilePath
path = Monitor () -> Monitor ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Monitor () -> Monitor ()) -> Monitor () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ do
  Int
defFreq <- (Settings -> Int) -> Monitor Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> Int
defaultFrequency
  Assertion
defAssert <- (Settings -> Assertion) -> Monitor Assertion
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> Assertion
defaultAssertion
  let pureJob :: PureJob
pureJob = Job -> Assertion -> FilePath -> PureJob
purify Job
job Assertion
defAssert FilePath
path
      delay :: Int
delay = Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^((Int
6)::Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defFreq Maybe Int
jobFrequency)
  JobFeedback
queryResult <- PureJob -> Monitor JobFeedback
runSQL PureJob
pureJob
  (?mutex::Mutexes) =>
FilePath -> PureJob -> JobFeedback -> Monitor ()
FilePath -> PureJob -> JobFeedback -> Monitor ()
processQueryResult FilePath
path PureJob
pureJob JobFeedback
queryResult
  FilePath -> Monitor ()
forall (m :: * -> *).
(?mutex::Mutexes, MonadIO m) =>
FilePath -> m ()
logMessage (FilePath
"Job at " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is executed.")
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> IO () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
delay

forkWaitable :: (?mutex :: Mutexes) => Monitor () -> Monitor (ThreadId, MVar ())
forkWaitable :: Monitor () -> Monitor (ThreadId, MVar ())
forkWaitable Monitor ()
action = do
  MVar ()
handle <- IO (MVar ()) -> Monitor (MVar ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  ThreadId
thread <- Monitor ()
-> (Either SomeException () -> Monitor ()) -> Monitor ThreadId
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> (Either SomeException a -> m ()) -> m ThreadId
Lifted.forkFinally Monitor ()
action (\Either SomeException ()
_ -> IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> IO () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
handle ())
  (ThreadId, MVar ()) -> Monitor (ThreadId, MVar ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ThreadId
thread, MVar ()
handle)

startJob :: (?mutex :: Mutexes) => FilePath -> Monitor ()
startJob :: FilePath -> Monitor ()
startJob FilePath
path = do
  TVar (HashMap FilePath ThreadId)
queue <- (Settings -> TVar (HashMap FilePath ThreadId))
-> Monitor (TVar (HashMap FilePath ThreadId))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> TVar (HashMap FilePath ThreadId)
jobQueue
  Job
job <- IO Job -> Monitor Job
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Job -> Monitor Job) -> IO Job -> Monitor Job
forall a b. (a -> b) -> a -> b
$ Text -> Job
parseJob (Text -> Job) -> IO Text -> IO Job
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
T.readFile FilePath
path
  HashMap FilePath ThreadId
queueMap <- IO (HashMap FilePath ThreadId)
-> Monitor (HashMap FilePath ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap FilePath ThreadId)
 -> Monitor (HashMap FilePath ThreadId))
-> IO (HashMap FilePath ThreadId)
-> Monitor (HashMap FilePath ThreadId)
forall a b. (a -> b) -> a -> b
$ TVar (HashMap FilePath ThreadId) -> IO (HashMap FilePath ThreadId)
forall a. TVar a -> IO a
readTVarIO TVar (HashMap FilePath ThreadId)
queue
  case FilePath -> HashMap FilePath ThreadId -> Maybe ThreadId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup FilePath
path HashMap FilePath ThreadId
queueMap of
    Maybe ThreadId
Nothing -> () -> Monitor ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just ThreadId
accidental_thread -> do
      FilePath -> Monitor ()
forall (m :: * -> *).
(?mutex::Mutexes, MonadIO m) =>
FilePath -> m ()
logMessage (FilePath
"Job " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" was probably initiated by different monitor threads. Please report a bug.")
      IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> IO () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> IO ()
killThread ThreadId
accidental_thread
  (ThreadId
thread, MVar ()
waitHandle) <- (?mutex::Mutexes) => Monitor () -> Monitor (ThreadId, MVar ())
Monitor () -> Monitor (ThreadId, MVar ())
forkWaitable ((?mutex::Mutexes) => Job -> FilePath -> Monitor ()
Job -> FilePath -> Monitor ()
periodicEvent Job
job FilePath
path)
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> IO () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> FilePath -> IO ()
labelThread ThreadId
thread (FilePath
"jobThread: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path)
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> (STM () -> IO ()) -> STM () -> Monitor ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> Monitor ()) -> STM () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ TVar (HashMap FilePath ThreadId)
-> (HashMap FilePath ThreadId -> HashMap FilePath ThreadId)
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (HashMap FilePath ThreadId)
queue (FilePath
-> ThreadId
-> HashMap FilePath ThreadId
-> HashMap FilePath ThreadId
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert FilePath
path ThreadId
thread)
  FilePath -> Monitor ()
forall (m :: * -> *).
(?mutex::Mutexes, MonadIO m) =>
FilePath -> m ()
logMessage (FilePath
"Job " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is started.")
  Monitor () -> Monitor ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Monitor () -> Monitor ()) -> Monitor () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> IO () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
waitHandle

removeJob :: (?mutex :: Mutexes) => FilePath -> Monitor ()
removeJob :: FilePath -> Monitor ()
removeJob FilePath
path = do
  TVar (HashMap FilePath ThreadId)
queueTVar <- (Settings -> TVar (HashMap FilePath ThreadId))
-> Monitor (TVar (HashMap FilePath ThreadId))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> TVar (HashMap FilePath ThreadId)
jobQueue
  HashMap FilePath ThreadId
queue <- IO (HashMap FilePath ThreadId)
-> Monitor (HashMap FilePath ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap FilePath ThreadId)
 -> Monitor (HashMap FilePath ThreadId))
-> IO (HashMap FilePath ThreadId)
-> Monitor (HashMap FilePath ThreadId)
forall a b. (a -> b) -> a -> b
$ TVar (HashMap FilePath ThreadId) -> IO (HashMap FilePath ThreadId)
forall a. TVar a -> IO a
readTVarIO TVar (HashMap FilePath ThreadId)
queueTVar
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ())
-> (ThreadId -> IO ()) -> ThreadId -> Monitor ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> IO ()
killThread (ThreadId -> Monitor ()) -> ThreadId -> Monitor ()
forall a b. (a -> b) -> a -> b
$ HashMap FilePath ThreadId
queue HashMap FilePath ThreadId -> FilePath -> ThreadId
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! FilePath
path
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> (STM () -> IO ()) -> STM () -> Monitor ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> Monitor ()) -> STM () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ TVar (HashMap FilePath ThreadId)
-> (HashMap FilePath ThreadId -> HashMap FilePath ThreadId)
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (HashMap FilePath ThreadId)
queueTVar (FilePath -> HashMap FilePath ThreadId -> HashMap FilePath ThreadId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete FilePath
path)
  FilePath -> Monitor ()
forall (m :: * -> *).
(?mutex::Mutexes, MonadIO m) =>
FilePath -> m ()
logMessage (FilePath
"Job " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is removed")

restartJob :: (?mutex :: Mutexes) => FilePath -> Monitor ()
restartJob :: FilePath -> Monitor ()
restartJob FilePath
path = do
  TVar (HashMap FilePath ThreadId)
queueTVar <- (Settings -> TVar (HashMap FilePath ThreadId))
-> Monitor (TVar (HashMap FilePath ThreadId))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> TVar (HashMap FilePath ThreadId)
jobQueue
  HashMap FilePath ThreadId
queue <- IO (HashMap FilePath ThreadId)
-> Monitor (HashMap FilePath ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap FilePath ThreadId)
 -> Monitor (HashMap FilePath ThreadId))
-> IO (HashMap FilePath ThreadId)
-> Monitor (HashMap FilePath ThreadId)
forall a b. (a -> b) -> a -> b
$ TVar (HashMap FilePath ThreadId) -> IO (HashMap FilePath ThreadId)
forall a. TVar a -> IO a
readTVarIO TVar (HashMap FilePath ThreadId)
queueTVar
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ())
-> (ThreadId -> IO ()) -> ThreadId -> Monitor ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> IO ()
killThread (ThreadId -> Monitor ()) -> ThreadId -> Monitor ()
forall a b. (a -> b) -> a -> b
$ HashMap FilePath ThreadId
queue HashMap FilePath ThreadId -> FilePath -> ThreadId
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! FilePath
path
  Job
job <- IO Job -> Monitor Job
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Job -> Monitor Job) -> IO Job -> Monitor Job
forall a b. (a -> b) -> a -> b
$ Text -> Job
parseJob (Text -> Job) -> IO Text -> IO Job
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
T.readFile FilePath
path
  (ThreadId
thread, MVar ()
waitHandle) <- (?mutex::Mutexes) => Monitor () -> Monitor (ThreadId, MVar ())
Monitor () -> Monitor (ThreadId, MVar ())
forkWaitable ((?mutex::Mutexes) => Job -> FilePath -> Monitor ()
Job -> FilePath -> Monitor ()
periodicEvent Job
job FilePath
path)
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> IO () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> FilePath -> IO ()
labelThread ThreadId
thread (FilePath
"jobThread: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path)
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> (STM () -> IO ()) -> STM () -> Monitor ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> Monitor ()) -> STM () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ TVar (HashMap FilePath ThreadId)
-> (HashMap FilePath ThreadId -> HashMap FilePath ThreadId)
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (HashMap FilePath ThreadId)
queueTVar ((ThreadId -> ThreadId)
-> FilePath
-> HashMap FilePath ThreadId
-> HashMap FilePath ThreadId
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HM.adjust (\ThreadId
_ -> ThreadId
thread) FilePath
path)
  FilePath -> Monitor ()
forall (m :: * -> *).
(?mutex::Mutexes, MonadIO m) =>
FilePath -> m ()
logMessage (FilePath
"Job " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is restarted due to file modification.")
  Monitor () -> Monitor ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Monitor () -> Monitor ()) -> Monitor () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> IO () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
waitHandle

destroyQueue :: Monitor ()
destroyQueue :: Monitor ()
destroyQueue = do
  TVar (HashMap FilePath ThreadId)
queueTVar <- (Settings -> TVar (HashMap FilePath ThreadId))
-> Monitor (TVar (HashMap FilePath ThreadId))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> TVar (HashMap FilePath ThreadId)
jobQueue
  HashMap FilePath ThreadId
queue <- IO (HashMap FilePath ThreadId)
-> Monitor (HashMap FilePath ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap FilePath ThreadId)
 -> Monitor (HashMap FilePath ThreadId))
-> IO (HashMap FilePath ThreadId)
-> Monitor (HashMap FilePath ThreadId)
forall a b. (a -> b) -> a -> b
$ TVar (HashMap FilePath ThreadId) -> IO (HashMap FilePath ThreadId)
forall a. TVar a -> IO a
readTVarIO TVar (HashMap FilePath ThreadId)
queueTVar
  (ThreadId -> Monitor ()) -> [ThreadId] -> Monitor ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ())
-> (ThreadId -> IO ()) -> ThreadId -> Monitor ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> IO ()
killThread) ([ThreadId] -> Monitor ()) -> [ThreadId] -> Monitor ()
forall a b. (a -> b) -> a -> b
$ HashMap FilePath ThreadId -> [ThreadId]
forall k v. HashMap k v -> [v]
HM.elems HashMap FilePath ThreadId
queue
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> (STM () -> IO ()) -> STM () -> Monitor ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> Monitor ()) -> STM () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ TVar (HashMap FilePath ThreadId)
-> (HashMap FilePath ThreadId -> HashMap FilePath ThreadId)
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (HashMap FilePath ThreadId)
queueTVar (\HashMap FilePath ThreadId
_ -> HashMap FilePath ThreadId
forall k v. HashMap k v
HM.empty)

destroyMonitor :: (?mutex :: Mutexes) => MVar () -> Monitor ()
destroyMonitor :: MVar () -> Monitor ()
destroyMonitor MVar ()
monitorHolder = do
  IO () -> Monitor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Monitor ()) -> IO () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
monitorHolder ()
  Monitor ()
destroyQueue
  Monitor ()
(?mutex::Mutexes) => Monitor ()
alertThreadDeath