watch.hs 1.3 KB
Newer Older
Henrik Tramberend's avatar
Henrik Tramberend committed
1 2 3 4
{-- Author: Henrik Tramberend <henrik@tramberend.de> --}
module Watch
  ( waitForTwitchPassive
  ) where
5 6

import Control.Concurrent.MVar
Henrik Tramberend's avatar
Henrik Tramberend committed
7 8
-- | A non-polling file watcher based on fsnotify
import Data.List
9
import System.FSNotify
Henrik Tramberend's avatar
Henrik Tramberend committed
10 11
import System.FilePath
import System.FilePath.Glob
12 13 14 15 16

-- | Wait for something to happen on one of the matching files 
-- in one of the supplied directories.
waitForTwitch :: [FilePath] -> [Pattern] -> IO FilePath
waitForTwitch directories patterns = do
Henrik Tramberend's avatar
Henrik Tramberend committed
17 18 19 20 21 22 23
  done <- newEmptyMVar
  mgr <- startManager
  stops <- watchIt mgr done
  filepath <- takeMVar done
  sequence_ stops
  stopManager mgr
  return filepath
24
        -- Match a filepath against the supplied patterns
Henrik Tramberend's avatar
Henrik Tramberend committed
25 26
  where
    isWatchedFile event = any ((flip match) (eventPath event)) patterns
27
        -- Stop the watch manager and notify the main thread
Henrik Tramberend's avatar
Henrik Tramberend committed
28 29
    stopWatching mgr done event = do
      putMVar done (eventPath event)
30
        -- Watch everything within the supplied dirs
Henrik Tramberend's avatar
Henrik Tramberend committed
31 32 33 34
    watchInDir mgr done dir =
      watchTree mgr dir isWatchedFile (stopWatching mgr done)
    watchIt mgr done = do
      mapM (watchInDir mgr done) directories
35

Henrik Tramberend's avatar
Henrik Tramberend committed
36 37
twitchPatterns =
  map compile ["**/*.md", "**/*.yaml", "**/*.png", "**/*.jpg", "**/*.mp4"]
38 39

waitForTwitchPassive files = do
Henrik Tramberend's avatar
Henrik Tramberend committed
40 41
  let dirs = nub (map takeDirectory files)
  waitForTwitch dirs twitchPatterns