Commits

Bryan O'Sullivan committed d49ba42

Try to detect files that change within a 1-second window.

This is racy and unreliable, but usually works.

Comments (0)

Files changed (3)

Data/Configurator.hs

 
 import Control.Applicative ((<$>))
 import Control.Concurrent (ThreadId, forkIO, threadDelay)
-import Control.Exception (SomeException, catch, evaluate, throwIO, try)
-import Control.Monad (foldM, forM_, join, when)
+import Control.Exception (SomeException, catch, evaluate, handle, throwIO, try)
+import Control.Monad (foldM, forM, forM_, join, when)
 import Data.Configurator.Instances ()
 import Data.Configurator.Parser (interp, topLevel)
 import Data.Configurator.Types.Internal
 import Data.Text.Lazy.Builder (fromString, fromText, toLazyText)
 import Data.Text.Lazy.Builder.Int (decimal)
 import Prelude hiding (catch, lookup)
-import System.Directory (getModificationTime)
 import System.Environment (getEnv)
 import System.IO (hPutStrLn, stderr)
-import System.Time (ClockTime(..))
+import System.Posix.Types (EpochTime, FileOffset)
+import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)
 import qualified Data.Attoparsec.Text as T
 import qualified Data.Attoparsec.Text.Lazy as L
 import qualified Data.HashMap.Lazy as H
 autoReload _ []    = error "autoReload: no paths to load"
 autoReload auto@AutoConfig{..} paths = do
   cfg <- load' (Just auto) paths
-  let loop newest = do
+  let loop meta = do
         threadDelay (max interval 1 * 1000000)
-        newest' <- getNewest paths
-        if newest' == newest
-          then loop newest
-          else (reload cfg `catch` onError) >> loop newest'
-  tid <- forkIO $ loop =<< getNewest paths
+        meta' <- getMeta paths
+        if meta' == meta
+          then loop meta
+          else (reload cfg `catch` onError) >> loop meta'
+  tid <- forkIO $ loop =<< getMeta paths
   return (cfg, tid)
   
-getNewest :: [FilePath] -> IO ClockTime
-getNewest = flip foldM (TOD 0 0) $ \t -> fmap (max t) . getModificationTime
+-- | Save both a file's size and its last modification date, so we
+-- have a better chance of detecting a modification on a crappy
+-- filesystem with timestamp resolution of 1 second or worse.
+type Meta = (FileOffset, EpochTime)
+
+getMeta :: [FilePath] -> IO [Maybe Meta]
+getMeta paths = forM paths $ \path ->
+   handle (\(_::SomeException) -> return Nothing) . fmap Just $ do
+     st <- getFileStatus path
+     return (fileSize st, modificationTime st)
 
 -- | Look up a name in the given 'Config'.  If a binding exists, and
 -- the value can be 'convert'ed to the desired type, return the

configurator.cabal

     bytestring,
     directory,
     hashable,
-    old-time,
     text >= 0.11.1.0,
+    unix-compat,
     unordered-containers	
 
   if flag(developer)

tests/TestReload.hs

+{-# LANGUAGE OverloadedStrings #-}
+
+import Control.Exception
+import Control.Concurrent
+import Data.Configurator
+import Data.Configurator.Types
+import qualified Data.ByteString.Lazy.Char8 as L
+import System.Environment
+import System.Directory
+import Control.Monad
+import System.IO
+
+main = do
+  args <- getArgs
+  tmpDir <- getTemporaryDirectory
+  temps <- forM args $ \arg -> do
+           (p,h) <- openBinaryTempFile tmpDir "test.cfg"
+           L.hPut h =<< L.readFile arg
+           hClose h
+           return p
+  flip finally (mapM_ removeFile temps) $ do
+    done <- newEmptyMVar
+    let myConfig = autoConfig {
+                     onError = \e -> hPutStrLn stderr $ "uh oh: " ++ show e
+                   }
+    (c,_) <- autoReload myConfig temps
+    display c
+    subscribe c "dongly" $ \n v -> putMVar done ()
+    --threadDelay 1000000
+    forM_ temps $ \t -> L.appendFile t "\ndongly = 1\n"
+    takeMVar done