Commits

Stefan Saasen committed 833fbcd

Replace 'getLine' with a call to runIndefinitely and proper signal handlers

Comments (0)

Files changed (4)

                     json >= 0.7,
                     directory >= 1.1,
                     system-filepath >= 0.4.7,
-                    time >= 1.4
+                    time >= 1.4,
+                    unix
 
   ghc-options:
                     -Wall
 main = do
     config <- cmdArgsRun mode
     canonicalizedDir <- canonicalizePath $ dir config
-    spy config { dir = addTrailingPathSeparator canonicalizedDir }
-    putStrLn "No eyes on the target"
+    spy (config { dir = addTrailingPathSeparator canonicalizedDir }) $
+        putStrLn "No eyes on the target"

src/Spy/Daemon.hs

+{-# LANGUAGE DoAndIfThenElse #-}
+
+module Spy.Daemon (
+    runIndefinitely
+) where
+
+
+import           System.IO          (isEOF)
+import           System.Exit
+import           System.Posix.Signals
+import           Control.Concurrent
+import qualified Control.Exception as E
+
+-- | Run indefinitely until the users aborts (via CTRL-D, CTRL-C or by sending a TERM
+-- signal)
+-- The `start` funtion will be called once, the cleanup once when the user
+-- aborts with the result of the start function as the argument.
+runIndefinitely :: IO b -> (b -> IO a) -> IO ()
+runIndefinitely start cleanup = do
+    tid <- myThreadId
+    res <- start
+    let handler = CatchOnce $ terminate res tid
+    installHandler sigINT handler Nothing
+    installHandler sigTERM handler Nothing
+    loop res
+    where loop res = do
+            finished <- isEOF
+            if finished then do
+                cleanup res
+                return ()
+            else do
+                _ <- getLine
+                loop res
+          terminate res tid = do
+            cleanup res
+            E.throwTo tid ExitSuccess
+

src/Spy/Watcher.hs

 ,containsHiddenPathElement
 ) where
 
-import System.FSNotify
+import System.FSNotify (withManager, watchTree, Event(..))
 import System.Console.CmdArgs
 import System.Cmd
 import System.Exit
 import Data.Time.Clock(UTCTime)
 import Data.Maybe (fromMaybe, maybeToList, fromJust)
 import Text.JSON
+import Spy.Daemon
 
 -- | The output format when Spy prints out changes to STDOUT
 data Format = Json | Plain deriving (Show, Eq, Data, Typeable)
 plainFormat = Plain
 
 -- | Register for FS events using the given Spy config.
-spy :: Spy -> IO String
-spy config = withManager $ \wm ->
-  watchTree wm (decodeString $ dir config)
-              (not . skipEvent config . eventPath)
-              (handleEvent config) >>
-  getLine
+spy :: Spy -> IO b -> IO ()
+spy config after = withManager $ \wm ->
+    runIndefinitely
+      (watchTree wm (decodeString $ dir config)
+                  (not . skipEvent config . eventPath)
+                  (handleEvent config)) 
+      (const after)
 
 -- | Handle the FS event based on the current Spy run configuration
 handleEvent :: Spy -> Event -> IO ()