root / src / Ganeti / Utils.hs @ 557f5dad
History  View  Annotate  Download (21.8 kB)
1 
{ Utility functions. } 

2  
3 
{ 
4  
5 
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc. 
6  
7 
This program is free software; you can redistribute it and/or modify 
8 
it under the terms of the GNU General Public License as published by 
9 
the Free Software Foundation; either version 2 of the License, or 
10 
(at your option) any later version. 
11  
12 
This program is distributed in the hope that it will be useful, but 
13 
WITHOUT ANY WARRANTY; without even the implied warranty of 
14 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 
15 
General Public License for more details. 
16  
17 
You should have received a copy of the GNU General Public License 
18 
along with this program; if not, write to the Free Software 
19 
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 
20 
021101301, USA. 
21  
22 
} 
23  
24 
module Ganeti.Utils 
25 
( debug 
26 
, debugFn 
27 
, debugXy 
28 
, sepSplit 
29 
, stdDev 
30 
, if' 
31 
, select 
32 
, applyIf 
33 
, commaJoin 
34 
, ensureQuoted 
35 
, tryRead 
36 
, formatTable 
37 
, printTable 
38 
, parseUnit 
39 
, parseUnitAssumeBinary 
40 
, plural 
41 
, niceSort 
42 
, niceSortKey 
43 
, exitIfBad 
44 
, exitErr 
45 
, exitWhen 
46 
, exitUnless 
47 
, logWarningIfBad 
48 
, rStripSpace 
49 
, newUUID 
50 
, getCurrentTime 
51 
, getCurrentTimeUSec 
52 
, clockTimeToString 
53 
, chompPrefix 
54 
, warn 
55 
, wrap 
56 
, trim 
57 
, defaultHead 
58 
, exitIfEmpty 
59 
, splitEithers 
60 
, recombineEithers 
61 
, resolveAddr 
62 
, monadicThe 
63 
, setOwnerAndGroupFromNames 
64 
, formatOrdinal 
65 
, atomicWriteFile 
66 
, tryAndLogIOError 
67 
, lockFile 
68 
, FStat 
69 
, nullFStat 
70 
, getFStat 
71 
, getFStatSafe 
72 
, needsReload 
73 
, watchFile 
74 
) where 
75  
76 
import Control.Concurrent 
77 
import Control.Exception (try) 
78 
import Data.Char (toUpper, isAlphaNum, isDigit, isSpace) 
79 
import Data.Function (on) 
80 
import Data.IORef 
81 
import Data.List 
82 
import qualified Data.Map as M 
83 
import Control.Monad (foldM, liftM) 
84 
import System.Directory (renameFile) 
85 
import System.FilePath.Posix (takeDirectory, takeBaseName) 
86 
import System.INotify 
87 
import System.Posix.Types 
88  
89 
import Debug.Trace 
90 
import Network.Socket 
91  
92 
import Ganeti.BasicTypes 
93 
import qualified Ganeti.ConstantUtils as ConstantUtils 
94 
import Ganeti.Logging 
95 
import Ganeti.Runtime 
96 
import System.IO 
97 
import System.Exit 
98 
import System.Posix.Files 
99 
import System.Posix.IO 
100 
import System.Time 
101  
102 
 * Debug functions 
103  
104 
  To be used only for debugging, breaks referential integrity. 
105 
debug :: Show a => a > a 
106 
debug x = trace (show x) x 
107  
108 
  Displays a modified form of the second parameter before returning 
109 
 it. 
110 
debugFn :: Show b => (a > b) > a > a 
111 
debugFn fn x = debug (fn x) `seq` x 
112  
113 
  Show the first parameter before returning the second one. 
114 
debugXy :: Show a => a > b > b 
115 
debugXy = seq . debug 
116  
117 
 * Miscellaneous 
118  
119 
  Apply the function if condition holds, otherwise use default value. 
120 
applyIf :: Bool > (a > a) > a > a 
121 
applyIf b f x = if b then f x else x 
122  
123 
  Commajoin a string list. 
124 
commaJoin :: [String] > String 
125 
commaJoin = intercalate "," 
126  
127 
  Split a list on a separator and return an array. 
128 
sepSplit :: Eq a => a > [a] > [[a]] 
129 
sepSplit sep s 
130 
 null s = [] 
131 
 null xs = [x] 
132 
 null ys = [x,[]] 
133 
 otherwise = x:sepSplit sep ys 
134 
where (x, xs) = break (== sep) s 
135 
ys = drop 1 xs 
136  
137 
  Simple pluralize helper 
138 
plural :: Int > String > String > String 
139 
plural 1 s _ = s 
140 
plural _ _ p = p 
141  
142 
  Ensure a value is quoted if needed. 
143 
ensureQuoted :: String > String 
144 
ensureQuoted v = if not (all (\c > isAlphaNum c  c == '.') v) 
145 
then '\'':v ++ "'" 
146 
else v 
147  
148 
 * Mathematical functions 
149  
150 
 Simple and slow statistical functions, please replace with better 
151 
 versions 
152  
153 
  Standard deviation function. 
154 
stdDev :: [Double] > Double 
155 
stdDev lst = 
156 
 first, calculate the list length and sum lst in a single step, 
157 
 for performance reasons 
158 
let (ll', sx) = foldl' (\(rl, rs) e > 
159 
let rl' = rl + 1 
160 
rs' = rs + e 
161 
in rl' `seq` rs' `seq` (rl', rs')) (0::Int, 0) lst 
162 
ll = fromIntegral ll'::Double 
163 
mv = sx / ll 
164 
av = foldl' (\accu em > let d = em  mv in accu + d * d) 0.0 lst 
165 
in sqrt (av / ll)  stddev 
166  
167 
 * Logical functions 
168  
169 
 Avoid syntactic sugar and enhance readability. These functions are proposed 
170 
 by some for inclusion in the Prelude, and at the moment they are present 
171 
 (with various definitions) in the utilityht package. Some rationale and 
172 
 discussion is available at <http://www.haskell.org/haskellwiki/Ifthenelse> 
173  
174 
  \"if\" as a function, rather than as syntactic sugar. 
175 
if' :: Bool  ^ condition 
176 
> a  ^ \"then\" result 
177 
> a  ^ \"else\" result 
178 
> a  ^ \"then\" or "else" result depending on the condition 
179 
if' True x _ = x 
180 
if' _ _ y = y 
181  
182 
 * Parsing utility functions 
183  
184 
  Parse results from readsPrec. 
185 
parseChoices :: (Monad m, Read a) => String > String > [(a, String)] > m a 
186 
parseChoices _ _ ((v, ""):[]) = return v 
187 
parseChoices name s ((_, e):[]) = 
188 
fail $ name ++ ": leftover characters when parsing '" 
189 
++ s ++ "': '" ++ e ++ "'" 
190 
parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'" 
191  
192 
  Safe 'read' function returning data encapsulated in a Result. 
193 
tryRead :: (Monad m, Read a) => String > String > m a 
194 
tryRead name s = parseChoices name s $ reads s 
195  
196 
  Format a table of strings to maintain consistent length. 
197 
formatTable :: [[String]] > [Bool] > [[String]] 
198 
formatTable vals numpos = 
199 
let vtrans = transpose vals  transpose, so that we work on rows 
200 
 rather than columns 
201 
mlens = map (maximum . map length) vtrans 
202 
expnd = map (\(flds, isnum, ml) > 
203 
map (\val > 
204 
let delta = ml  length val 
205 
filler = replicate delta ' ' 
206 
in if delta > 0 
207 
then if isnum 
208 
then filler ++ val 
209 
else val ++ filler 
210 
else val 
211 
) flds 
212 
) (zip3 vtrans numpos mlens) 
213 
in transpose expnd 
214  
215 
  Constructs a printable table from given header and rows 
216 
printTable :: String > [String] > [[String]] > [Bool] > String 
217 
printTable lp header rows isnum = 
218 
unlines . map ((++) lp . (:) ' ' . unwords) $ 
219 
formatTable (header:rows) isnum 
220  
221 
  Converts a unit (e.g. m or GB) into a scaling factor. 
222 
parseUnitValue :: (Monad m) => Bool > String > m Rational 
223 
parseUnitValue noDecimal unit 
224 
 binary conversions first 
225 
 null unit = return 1 
226 
 unit == "m"  upper == "MIB" = return 1 
227 
 unit == "g"  upper == "GIB" = return kbBinary 
228 
 unit == "t"  upper == "TIB" = return $ kbBinary * kbBinary 
229 
 SI conversions 
230 
 unit == "M"  upper == "MB" = return mbFactor 
231 
 unit == "G"  upper == "GB" = return $ mbFactor * kbDecimal 
232 
 unit == "T"  upper == "TB" = return $ mbFactor * kbDecimal * kbDecimal 
233 
 otherwise = fail $ "Unknown unit '" ++ unit ++ "'" 
234 
where upper = map toUpper unit 
235 
kbBinary = 1024 :: Rational 
236 
kbDecimal = if noDecimal then kbBinary else 1000 
237 
decToBin = kbDecimal / kbBinary  factor for 1K conversion 
238 
mbFactor = decToBin * decToBin  twice the factor for just 1K 
239  
240 
  Tries to extract number and scale from the given string. 
241 
 
242 
 Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is 
243 
 specified, it defaults to MiB. Return value is always an integral 
244 
 value in MiB; if the first argument is True, all kilos are binary. 
245 
parseUnitEx :: (Monad m, Integral a, Read a) => Bool > String > m a 
246 
parseUnitEx noDecimal str = 
247 
 TODO: enhance this by splitting the unit parsing code out and 
248 
 accepting floatingpoint numbers 
249 
case (reads str::[(Int, String)]) of 
250 
[(v, suffix)] > 
251 
let unit = dropWhile (== ' ') suffix 
252 
in do 
253 
scaling < parseUnitValue noDecimal unit 
254 
return $ truncate (fromIntegral v * scaling) 
255 
_ > fail $ "Can't parse string '" ++ str ++ "'" 
256  
257 
  Tries to extract number and scale from the given string. 
258 
 
259 
 Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is 
260 
 specified, it defaults to MiB. Return value is always an integral 
261 
 value in MiB. 
262 
parseUnit :: (Monad m, Integral a, Read a) => String > m a 
263 
parseUnit = parseUnitEx False 
264  
265 
  Tries to extract a number and scale from a given string, taking 
266 
 all kilos to be binary. 
267 
parseUnitAssumeBinary :: (Monad m, Integral a, Read a) => String > m a 
268 
parseUnitAssumeBinary = parseUnitEx True 
269  
270 
  Unwraps a 'Result', exiting the program if it is a 'Bad' value, 
271 
 otherwise returning the actual contained value. 
272 
exitIfBad :: String > Result a > IO a 
273 
exitIfBad msg (Bad s) = exitErr (msg ++ ": " ++ s) 
274 
exitIfBad _ (Ok v) = return v 
275  
276 
  Exits immediately with an error message. 
277 
exitErr :: String > IO a 
278 
exitErr errmsg = do 
279 
hPutStrLn stderr $ "Error: " ++ errmsg 
280 
exitWith (ExitFailure 1) 
281  
282 
  Exits with an error message if the given boolean condition if true. 
283 
exitWhen :: Bool > String > IO () 
284 
exitWhen True msg = exitErr msg 
285 
exitWhen False _ = return () 
286  
287 
  Exits with an error message /unless/ the given boolean condition 
288 
 if true, the opposite of 'exitWhen'. 
289 
exitUnless :: Bool > String > IO () 
290 
exitUnless cond = exitWhen (not cond) 
291  
292 
  Unwraps a 'Result', logging a warning message and then returning a default 
293 
 value if it is a 'Bad' value, otherwise returning the actual contained value. 
294 
logWarningIfBad :: String > a > Result a > IO a 
295 
logWarningIfBad msg defVal (Bad s) = do 
296 
logWarning $ msg ++ ": " ++ s 
297 
return defVal 
298 
logWarningIfBad _ _ (Ok v) = return v 
299  
300 
  Try an IO interaction, log errors and unfold as a 'Result'. 
301 
tryAndLogIOError :: IO a > String > (a > Result b) > IO (Result b) 
302 
tryAndLogIOError io msg okfn = 
303 
try io >>= either 
304 
(\ e > do 
305 
let combinedmsg = msg ++ ": " ++ show (e :: IOError) 
306 
logError combinedmsg 
307 
return . Bad $ combinedmsg) 
308 
(return . okfn) 
309  
310 
  Print a warning, but do not exit. 
311 
warn :: String > IO () 
312 
warn = hPutStrLn stderr . (++) "Warning: " 
313  
314 
  Helper for 'niceSort'. Computes the key element for a given string. 
315 
extractKey :: [Either Integer String]  ^ Current (partial) key, reversed 
316 
> String  ^ Remaining string 
317 
> ([Either Integer String], String) 
318 
extractKey ek [] = (reverse ek, []) 
319 
extractKey ek xs@(x:_) = 
320 
let (span_fn, conv_fn) = if isDigit x 
321 
then (isDigit, Left . read) 
322 
else (not . isDigit, Right) 
323 
(k, rest) = span span_fn xs 
324 
in extractKey (conv_fn k:ek) rest 
325  
326 
{ Sort a list of strings based on digit and nondigit groupings. 
327  
328 
Given a list of names @['a1', 'a10', 'a11', 'a2']@ this function 
329 
will sort the list in the logical order @['a1', 'a2', 'a10', 'a11']@. 
330  
331 
The sort algorithm breaks each name in groups of either onlydigits or 
332 
nodigits, and sorts based on each group. 
333  
334 
Internally, this is not implemented via regexes (like the Python 
335 
version), but via actual splitting of the string in sequences of 
336 
either digits or everything else, and converting the digit sequences 
337 
in /Left Integer/ and the nondigit ones in /Right String/, at which 
338 
point sorting becomes trivial due to the builtin 'Either' ordering; 
339 
we only need one extra step of dropping the key at the end. 
340  
341 
} 
342 
niceSort :: [String] > [String] 
343 
niceSort = niceSortKey id 
344  
345 
  Keyversion of 'niceSort'. We use 'sortBy' and @compare `on` fst@ 
346 
 since we don't want to add an ordering constraint on the /a/ type, 
347 
 hence the need to only compare the first element of the /(key, a)/ 
348 
 tuple. 
349 
niceSortKey :: (a > String) > [a] > [a] 
350 
niceSortKey keyfn = 
351 
map snd . sortBy (compare `on` fst) . 
352 
map (\s > (fst . extractKey [] $ keyfn s, s)) 
353  
354 
  Strip space characthers (including newline). As this is 
355 
 expensive, should only be run on small strings. 
356 
rStripSpace :: String > String 
357 
rStripSpace = reverse . dropWhile isSpace . reverse 
358  
359 
  Returns a random UUID. 
360 
 This is a Linuxspecific method as it uses the /proc filesystem. 
361 
newUUID :: IO String 
362 
newUUID = do 
363 
contents < readFile ConstantUtils.randomUuidFile 
364 
return $! rStripSpace $ take 128 contents 
365  
366 
  Returns the current time as an 'Integer' representing the number 
367 
 of seconds from the Unix epoch. 
368 
getCurrentTime :: IO Integer 
369 
getCurrentTime = do 
370 
TOD ctime _ < getClockTime 
371 
return ctime 
372  
373 
  Returns the current time as an 'Integer' representing the number 
374 
 of microseconds from the Unix epoch (hence the need for 'Integer'). 
375 
getCurrentTimeUSec :: IO Integer 
376 
getCurrentTimeUSec = do 
377 
TOD ctime pico < getClockTime 
378 
 pico: 10^12, micro: 10^6, so we have to shift seconds left and 
379 
 picoseconds right 
380 
return $ ctime * 1000000 + pico `div` 1000000 
381  
382 
  Convert a ClockTime into a (secondsonly) timestamp. 
383 
clockTimeToString :: ClockTime > String 
384 
clockTimeToString (TOD t _) = show t 
385  
386 
{ Strip a prefix from a string, allowing the last character of the prefix 
387 
(which is assumed to be a separator) to be absent from the string if the string 
388 
terminates there. 
389  
390 
\>>> chompPrefix \"foo:bar:\" \"a:b:c\" 
391 
Nothing 
392  
393 
\>>> chompPrefix \"foo:bar:\" \"foo:bar:baz\" 
394 
Just \"baz\" 
395  
396 
\>>> chompPrefix \"foo:bar:\" \"foo:bar:\" 
397 
Just \"\" 
398  
399 
\>>> chompPrefix \"foo:bar:\" \"foo:bar\" 
400 
Just \"\" 
401  
402 
\>>> chompPrefix \"foo:bar:\" \"foo:barbaz\" 
403 
Nothing 
404 
} 
405 
chompPrefix :: String > String > Maybe String 
406 
chompPrefix pfx str = 
407 
if pfx `isPrefixOf` str  str == init pfx 
408 
then Just $ drop (length pfx) str 
409 
else Nothing 
410  
411 
  Breaks a string in lines with length \<= maxWidth. 
412 
 
413 
 NOTE: The split is OK if: 
414 
 
415 
 * It doesn't break a word, i.e. the next line begins with space 
416 
 (@isSpace . head $ rest@) or the current line ends with space 
417 
 (@null revExtra@); 
418 
 
419 
 * It breaks a very big word that doesn't fit anyway (@null revLine@). 
420 
wrap :: Int  ^ maxWidth 
421 
> String  ^ string that needs wrapping 
422 
> [String]  ^ string \"broken\" in lines 
423 
wrap maxWidth = filter (not . null) . map trim . wrap0 
424 
where wrap0 :: String > [String] 
425 
wrap0 text 
426 
 length text <= maxWidth = [text] 
427 
 isSplitOK = line : wrap0 rest 
428 
 otherwise = line' : wrap0 rest' 
429 
where (line, rest) = splitAt maxWidth text 
430 
(revExtra, revLine) = break isSpace . reverse $ line 
431 
(line', rest') = (reverse revLine, reverse revExtra ++ rest) 
432 
isSplitOK = 
433 
null revLine  null revExtra  startsWithSpace rest 
434 
startsWithSpace (x:_) = isSpace x 
435 
startsWithSpace _ = False 
436  
437 
  Removes surrounding whitespace. Should only be used in small 
438 
 strings. 
439 
trim :: String > String 
440 
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace 
441  
442 
  A safer head version, with a default value. 
443 
defaultHead :: a > [a] > a 
444 
defaultHead def [] = def 
445 
defaultHead _ (x:_) = x 
446  
447 
  A 'head' version in the I/O monad, for validating parameters 
448 
 without which we cannot continue. 
449 
exitIfEmpty :: String > [a] > IO a 
450 
exitIfEmpty _ (x:_) = return x 
451 
exitIfEmpty s [] = exitErr s 
452  
453 
  Obtain the unique element of a list in an arbitrary monad. 
454 
monadicThe :: (Eq a, Monad m) => String > [a] > m a 
455 
monadicThe s [] = fail s 
456 
monadicThe s (x:xs) 
457 
 all (x ==) xs = return x 
458 
 otherwise = fail s 
459  
460 
  Split an 'Either' list into two separate lists (containing the 
461 
 'Left' and 'Right' elements, plus a \"trail\" list that allows 
462 
 recombination later. 
463 
 
464 
 This is splitter; for recombination, look at 'recombineEithers'. 
465 
 The sum of \"left\" and \"right\" lists should be equal to the 
466 
 original list length, and the trail list should be the same length 
467 
 as well. The entries in the resulting lists are reversed in 
468 
 comparison with the original list. 
469 
splitEithers :: [Either a b] > ([a], [b], [Bool]) 
470 
splitEithers = foldl' splitter ([], [], []) 
471 
where splitter (l, r, t) e = 
472 
case e of 
473 
Left v > (v:l, r, False:t) 
474 
Right v > (l, v:r, True:t) 
475  
476 
  Recombines two \"left\" and \"right\" lists using a \"trail\" 
477 
 list into a single 'Either' list. 
478 
 
479 
 This is the counterpart to 'splitEithers'. It does the opposite 
480 
 transformation, and the output list will be the reverse of the 
481 
 input lists. Since 'splitEithers' also reverses the lists, calling 
482 
 these together will result in the original list. 
483 
 
484 
 Mismatches in the structure of the lists (e.g. inconsistent 
485 
 lengths) are represented via 'Bad'; normally this function should 
486 
 not fail, if lists are passed as generated by 'splitEithers'. 
487 
recombineEithers :: (Show a, Show b) => 
488 
[a] > [b] > [Bool] > Result [Either a b] 
489 
recombineEithers lefts rights trail = 
490 
foldM recombiner ([], lefts, rights) trail >>= checker 
491 
where checker (eithers, [], []) = Ok eithers 
492 
checker (_, lefts', rights') = 
493 
Bad $ "Inconsistent results after recombination, l'=" ++ 
494 
show lefts' ++ ", r'=" ++ show rights' 
495 
recombiner (es, l:ls, rs) False = Ok (Left l:es, ls, rs) 
496 
recombiner (es, ls, r:rs) True = Ok (Right r:es, ls, rs) 
497 
recombiner (_, ls, rs) t = Bad $ "Inconsistent trail log: l=" ++ 
498 
show ls ++ ", r=" ++ show rs ++ ",t=" ++ 
499 
show t 
500  
501 
  Default hints for the resolver 
502 
resolveAddrHints :: Maybe AddrInfo 
503 
resolveAddrHints = 
504 
Just defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV] } 
505  
506 
  Resolves a numeric address. 
507 
resolveAddr :: Int > String > IO (Result (Family, SockAddr)) 
508 
resolveAddr port str = do 
509 
resolved < getAddrInfo resolveAddrHints (Just str) (Just (show port)) 
510 
return $ case resolved of 
511 
[] > Bad "Invalid results from lookup?" 
512 
best:_ > Ok (addrFamily best, addrAddress best) 
513  
514 
  Set the owner and the group of a file (given as names, not numeric id). 
515 
setOwnerAndGroupFromNames :: FilePath > GanetiDaemon > GanetiGroup > IO () 
516 
setOwnerAndGroupFromNames filename daemon dGroup = do 
517 
 TODO: it would be nice to rework this (or getEnts) so that runtimeEnts 
518 
 is read only once per daemon startup, and then cached for further usage. 
519 
runtimeEnts < getEnts 
520 
ents < exitIfBad "Can't find required user/groups" runtimeEnts 
521 
 note: we use directly ! as lookup failures shouldn't happen, due 
522 
 to the map construction 
523 
let uid = fst ents M.! daemon 
524 
let gid = snd ents M.! dGroup 
525 
setOwnerAndGroup filename uid gid 
526  
527 
  Formats an integral number, appending a suffix. 
528 
formatOrdinal :: (Integral a, Show a) => a > String 
529 
formatOrdinal num 
530 
 num > 10 && num < 20 = suffix "th" 
531 
 tens == 1 = suffix "st" 
532 
 tens == 2 = suffix "nd" 
533 
 tens == 3 = suffix "rd" 
534 
 otherwise = suffix "th" 
535 
where tens = num `mod` 10 
536 
suffix s = show num ++ s 
537  
538 
  Atomically write a file, by first writing the contents into a temporary 
539 
 file and then renaming it to the old position. 
540 
atomicWriteFile :: FilePath > String > IO () 
541 
atomicWriteFile path contents = do 
542 
(tmppath, tmphandle) < openTempFile (takeDirectory path) (takeBaseName path) 
543 
hPutStr tmphandle contents 
544 
hClose tmphandle 
545 
renameFile tmppath path 
546  
547 
  Attempt, in a nonblocking way, to obtain a lock on a given file; report 
548 
 back success. 
549 
lockFile :: FilePath > IO (Result ()) 
550 
lockFile path = do 
551 
handle < openFile path WriteMode 
552 
fd < handleToFd handle 
553 
Control.Monad.liftM (either (Bad . show) Ok) 
554 
(try (setLock fd (WriteLock, AbsoluteSeek, 0, 0)) :: IO (Either IOError ())) 
555  
556 
  File stat identifier. 
557 
type FStat = (EpochTime, FileID, FileOffset) 
558  
559 
  Null 'FStat' value. 
560 
nullFStat :: FStat 
561 
nullFStat = (1, 1, 1) 
562  
563 
  Computes the file cache data from a FileStatus structure. 
564 
buildFileStatus :: FileStatus > FStat 
565 
buildFileStatus ofs = 
566 
let modt = modificationTime ofs 
567 
inum = fileID ofs 
568 
fsize = fileSize ofs 
569 
in (modt, inum, fsize) 
570  
571 
  Wrapper over 'buildFileStatus'. This reads the data from the 
572 
 filesystem and then builds our cache structure. 
573 
getFStat :: FilePath > IO FStat 
574 
getFStat p = liftM buildFileStatus (getFileStatus p) 
575  
576 
  Safe version of 'getFStat', that ignores IOErrors. 
577 
getFStatSafe :: FilePath > IO FStat 
578 
getFStatSafe fpath = liftM (either (const nullFStat) id) 
579 
((try $ getFStat fpath) :: IO (Either IOError FStat)) 
580  
581 
  Check if the file needs reloading 
582 
needsReload :: FStat > FilePath > IO (Maybe FStat) 
583 
needsReload oldstat path = do 
584 
newstat < getFStat path 
585 
return $ if newstat /= oldstat 
586 
then Just newstat 
587 
else Nothing 
588  
589 
  Until the given point in time (useconds since the epoch), wait 
590 
 for the output of a given method to change and return the new value; 
591 
 make use of the promise that the output only changes if the reference 
592 
 has a value different than the given one. 
593 
watchFileEx :: (Eq a, Eq b) => Integer > b > IORef b > a > IO a > IO a 
594 
watchFileEx endtime base ref old read_fn = do 
595 
current < getCurrentTimeUSec 
596 
if current > endtime then read_fn else do 
597 
val < readIORef ref 
598 
if val /= base 
599 
then do 
600 
new < read_fn 
601 
if new /= old then return new else do 
602 
threadDelay 100000 
603 
watchFileEx endtime val ref old read_fn 
604 
else do 
605 
threadDelay 100000 
606 
watchFileEx endtime base ref old read_fn 
607  
608 
  Within the given timeout (in seconds), wait for for the output 
609 
 of the given method to change and return the new value; make use of 
610 
 the promise that the method will only change its value, if 
611 
 the given file changes on disk. If the file does not exist on disk, return 
612 
 immediately. 
613 
watchFile :: Eq a => FilePath > Int > a > IO a > IO a 
614 
watchFile fpath timeout old read_fn = do 
615 
current < getCurrentTimeUSec 
616 
let endtime = current + fromIntegral timeout * 1000000 
617 
fstat < getFStatSafe fpath 
618 
ref < newIORef fstat 
619 
inotify < initINotify 
620 
_ < addWatch inotify [Modify, Delete] fpath . const $ do 
621 
logDebug $ "Notified of change in " ++ fpath 
622 
fstat' < getFStatSafe fpath 
623 
writeIORef ref fstat' 
624 
result < watchFileEx endtime fstat ref old read_fn 
625 
killINotify inotify 
626 
return result 
627 
