mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -06:00
gf -server: include list of loaded PGFs in version info
This commit is contained in:
@@ -18,7 +18,7 @@ import GF.System.Directory(doesDirectoryExist,doesFileExist,createDirectory,
|
|||||||
import Data.Time (getCurrentTime,formatTime)
|
import Data.Time (getCurrentTime,formatTime)
|
||||||
import System.Locale(defaultTimeLocale,rfc822DateFormat)
|
import System.Locale(defaultTimeLocale,rfc822DateFormat)
|
||||||
import System.FilePath(dropExtension,takeExtension,takeFileName,takeDirectory,
|
import System.FilePath(dropExtension,takeExtension,takeFileName,takeDirectory,
|
||||||
(</>))
|
(</>),makeRelative)
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
import System.Posix.Files(getSymbolicLinkStatus,isSymbolicLink,removeLink,
|
import System.Posix.Files(getSymbolicLinkStatus,isSymbolicLink,removeLink,
|
||||||
createSymbolicLink)
|
createSymbolicLink)
|
||||||
@@ -158,7 +158,9 @@ handle logLn documentroot state0 cache execute1 stateVar
|
|||||||
-- "/stop" ->
|
-- "/stop" ->
|
||||||
-- "/start" ->
|
-- "/start" ->
|
||||||
"/parse" -> parse (decoded qs)
|
"/parse" -> parse (decoded qs)
|
||||||
"/version" -> return (ok200 gf_version)
|
"/version" -> do (c1,c2) <- PS.listPGFCache cache
|
||||||
|
let rel = map (makeRelative documentroot)
|
||||||
|
return $ ok200 (unlines (gf_version:"":rel c1++"":rel c2))
|
||||||
"/flush" -> do PS.flushPGFCache cache; return (ok200 "flushed")
|
"/flush" -> do PS.flushPGFCache cache; return (ok200 "flushed")
|
||||||
'/':rpath ->
|
'/':rpath ->
|
||||||
-- This code runs without mutual exclusion, so it must *not*
|
-- This code runs without mutual exclusion, so it must *not*
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
module Cache (Cache,newCache,flushCache,readCache,readCache') where
|
module Cache (Cache,newCache,flushCache,listCache,readCache,readCache') where
|
||||||
|
|
||||||
import Control.Concurrent.MVar
|
import Control.Concurrent.MVar
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
@@ -22,6 +22,9 @@ flushCache :: Cache a -> IO ()
|
|||||||
flushCache c = do modifyMVar_ (cacheObjects c) (const (return Map.empty))
|
flushCache c = do modifyMVar_ (cacheObjects c) (const (return Map.empty))
|
||||||
performGC
|
performGC
|
||||||
|
|
||||||
|
listCache :: Cache a -> IO [FilePath]
|
||||||
|
listCache = fmap Map.keys . readMVar . cacheObjects
|
||||||
|
|
||||||
readCache :: Cache a -> FilePath -> IO a
|
readCache :: Cache a -> FilePath -> IO a
|
||||||
readCache c file = snd `fmap` readCache' c file
|
readCache c file = snd `fmap` readCache' c file
|
||||||
|
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
module PGFService(cgiMain,cgiMain',getPath,
|
module PGFService(cgiMain,cgiMain',getPath,
|
||||||
logFile,stderrToFile,
|
logFile,stderrToFile,
|
||||||
newPGFCache,flushPGFCache) where
|
newPGFCache,flushPGFCache,listPGFCache) where
|
||||||
|
|
||||||
import PGF (PGF)
|
import PGF (PGF)
|
||||||
import qualified PGF
|
import qualified PGF
|
||||||
@@ -57,11 +57,13 @@ newPGFCache = do pgfCache <- newCache PGF.readPGF
|
|||||||
return (pgf,({-pc-}))
|
return (pgf,({-pc-}))
|
||||||
return (pgfCache,cCache)
|
return (pgfCache,cCache)
|
||||||
flushPGFCache (c1,c2) = flushCache c1 >> flushCache c2
|
flushPGFCache (c1,c2) = flushCache c1 >> flushCache c2
|
||||||
|
listPGFCache (c1,c2) = (,) # listCache c1 % listCache c2
|
||||||
#else
|
#else
|
||||||
type Caches = (Cache PGF,())
|
type Caches = (Cache PGF,())
|
||||||
newPGFCache = do pgfCache <- newCache PGF.readPGF
|
newPGFCache = do pgfCache <- newCache PGF.readPGF
|
||||||
return (pgfCache,())
|
return (pgfCache,())
|
||||||
flushPGFCache (c1,_) = flushCache c1
|
flushPGFCache (c1,_) = flushCache c1
|
||||||
|
listPGFCache (c1,_) = (,) # listCache c1 % return []
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
getPath =
|
getPath =
|
||||||
|
|||||||
Reference in New Issue
Block a user