diff --git a/src/compiler/GF/Server.hs b/src/compiler/GF/Server.hs index 346f1c6be..c2b163d44 100644 --- a/src/compiler/GF/Server.hs +++ b/src/compiler/GF/Server.hs @@ -162,8 +162,10 @@ handle logLn documentroot state0 cache execute1 stateVar -- "/start" -> "/parse" -> parse (decoded qs) "/version" -> do (c1,c2) <- PS.listPGFCache cache - let rel = map (makeRelative documentroot) - return $ ok200 (unlines (gf_version:"":rel c1++"":rel c2)) + let rel = makeRelative documentroot + sh1 (path,t) = rel path++" "++show t + sh = map sh1 + return $ ok200 (unlines (gf_version:"":sh c1++"":sh c2)) "/flush" -> do PS.flushPGFCache cache; return (ok200 "flushed") '/':rpath -> -- This code runs without mutual exclusion, so it must *not* diff --git a/src/server/Cache.hs b/src/server/Cache.hs index d841a2291..d05ee2557 100644 --- a/src/server/Cache.hs +++ b/src/server/Cache.hs @@ -38,11 +38,13 @@ expireCache age c = performGC -- | List currently cached files -listCache :: Cache a -> IO [FilePath] +listCache :: Cache a -> IO [(FilePath,UTCTime)] listCache c = fmap (mapMaybe id) . mapM check . Map.toList =<< readMVar (cacheObjects c) where - check (path,v) = maybe Nothing (const (Just path)) `fmap` readMVar v + check (path,v) = maybe Nothing (Just . (,) path . fst3) `fmap` readMVar v + +fst3 (x,y,z) = x -- | Lookup a cached object (or read the file if it is not in the cache or if -- it has been modified)