LGTM A minor idea, if you like it (no need to resend the patch, if you use it): It could be useful to make a named function for
liftM (either (const nullFStat) id) ((try $ getFStat fpath) :: IO (Either IOError FStat)) it seems it'd be handy at other places as well. On Mon, Dec 9, 2013 at 5:01 PM, Klaus Aehlig <[email protected]> wrote: > Add a method to return the new value of a function if it changes within > the given timeout. If not, return the old value. Make use of the fact, > that the function only changes, if the specified file changes on disk. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > src/Ganeti/Utils.hs | 46 ++++++++++++++++++++++++++++++++++++++++++++++ > 1 file changed, 46 insertions(+) > > diff --git a/src/Ganeti/Utils.hs b/src/Ganeti/Utils.hs > index 3ebd103..47b2cea 100644 > --- a/src/Ganeti/Utils.hs > +++ b/src/Ganeti/Utils.hs > @@ -69,16 +69,20 @@ module Ganeti.Utils > , nullFStat > , getFStat > , needsReload > + , watchFile > ) where > > +import Control.Concurrent > import Control.Exception (try) > import Data.Char (toUpper, isAlphaNum, isDigit, isSpace) > import Data.Function (on) > +import Data.IORef > import Data.List > import qualified Data.Map as M > import Control.Monad (foldM, liftM) > import System.Directory (renameFile) > import System.FilePath.Posix (takeDirectory, takeBaseName) > +import System.INotify > import System.Posix.Types > > import Debug.Trace > @@ -575,3 +579,45 @@ needsReload oldstat path = do > return $ if newstat /= oldstat > then Just newstat > else Nothing > + > +-- | Until the given point in time (useconds since the epoch), wait > +-- for the output of a given method to change and return the new value; > +-- make use of the promise that the output only changes if the reference > +-- has a value different than the given one. > +watchFileEx :: (Eq a, Eq b) => Integer -> b -> IORef b -> a -> IO a -> IO > a > +watchFileEx endtime base ref old read_fn = do > + current <- getCurrentTimeUSec > + if current > endtime then read_fn else do > + val <- readIORef ref > + if val /= base > + then do > + new <- read_fn > + if new /= old then return new else do > + threadDelay 1000 > + watchFileEx endtime val ref old read_fn > + else do > + threadDelay 1000 > + watchFileEx endtime base ref old read_fn > + > +-- | Within the given timeout (in seconds), wait for for the output > +-- of the given method to change and return the new value; make use of > +-- the promise that the method will only change its value, if > +-- the given file changes on disk. If the file does not exist on disk, > return > +-- immediately. > +watchFile :: Eq a => FilePath -> Int -> a -> IO a -> IO a > +watchFile fpath timeout old read_fn = do > + current <- getCurrentTimeUSec > + let endtime = current + fromIntegral timeout * 1000000 > + let fstat_fn = liftM (either (const nullFStat) id) > + ((try $ getFStat fpath) :: IO (Either IOError FStat)) > + fstat <- fstat_fn > + ref <- newIORef fstat > + inotify <- initINotify > + _ <- addWatch inotify [Modify, Delete] fpath . const $ do > + logDebug $ "Notified of change in " ++ fpath > + fstat' <- fstat_fn > + writeIORef ref fstat' > + result <- watchFileEx endtime fstat ref old read_fn > + killINotify inotify > + return result > + > -- > 1.8.5.1 > >
