Watch.hs

{-|
Module      : Devel.Watch
Description : Watch for changes in the current working direcory.
Copyright   : (c)
License     : GPL-3
Maintainer  : njagi@urbanslug.com
Stability   : experimental
Portability : POSIX

Actually checks only for modified files.
Added or removed files don't trigger new builds.
-}
{-# LANGUAGE OverloadedStrings, CPP #-}
module Devel.Watch where

-- import IdeSession

import Control.Monad.STM
import Control.Concurrent.STM.TVar

import System.FSNotify
import Control.Monad      (forever)
import Control.Concurrent (threadDelay)

-- import Devel.Types
-- import Devel.Paths (getFilesToWatch)

# if __GLASGOW_HASKELL__ < 710
import Data.Text (unpack)
import Filesystem.Path.CurrentOS (toText)
-- import qualified Filesystem.Path as FSP
#endif

import System.Directory (getCurrentDirectory)
import System.FilePath (pathSeparator)

import Devel.Paths

watch :: TVar Bool -> [FilePath] -> IO ()
watch isDirty includeTargets = do
  -- Get files to watch.
  files <- getFilesToWatch includeTargets
  -- Making paths to watch a list of absolute paths.
  dir <- getCurrentDirectory
  let pathsToWatch = map (\fp -> dir ++ (pathSeparator: fp)) files

  -- Actual file watching.
  manager <- startManagerConf defaultConfig
  _ <- watchTree manager "." (const True)
         -- Last argument to watchTree.
# if __GLASGOW_HASKELL__ >= 710
         (\event -> do
            let getPath :: Event -> FilePath
                getPath (Added fp _)    = fp
                getPath (Modified fp _) = fp
                getPath (Removed fp _)  = fp
                
                isModified = getPath event `elem` pathsToWatch
                
            atomically $ writeTVar isDirty isModified)
            
#else
         (\event -> do 
            pathMod' <- case toText $ eventPath event of
                            Right text -> return $ unpack text -- Gives an abs path
                            Left text -> fail $ unpack text
                            
            let isModified = pathMod' `elem` pathsToWatch
            
            atomically $ writeTVar isDirty isModified)
#endif

  _ <- forever $ threadDelay maxBound
  stopManager manager

checkForChange :: TVar Bool -> IO ()
checkForChange isDirty =
  atomically $ do readTVar isDirty >>= check
                  writeTVar isDirty False