mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -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 System.Locale(defaultTimeLocale,rfc822DateFormat)
|
||||
import System.FilePath(dropExtension,takeExtension,takeFileName,takeDirectory,
|
||||
(</>))
|
||||
(</>),makeRelative)
|
||||
#ifndef mingw32_HOST_OS
|
||||
import System.Posix.Files(getSymbolicLinkStatus,isSymbolicLink,removeLink,
|
||||
createSymbolicLink)
|
||||
@@ -158,7 +158,9 @@ handle logLn documentroot state0 cache execute1 stateVar
|
||||
-- "/stop" ->
|
||||
-- "/start" ->
|
||||
"/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")
|
||||
'/':rpath ->
|
||||
-- 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 Data.Map (Map)
|
||||
@@ -22,6 +22,9 @@ flushCache :: Cache a -> IO ()
|
||||
flushCache c = do modifyMVar_ (cacheObjects c) (const (return Map.empty))
|
||||
performGC
|
||||
|
||||
listCache :: Cache a -> IO [FilePath]
|
||||
listCache = fmap Map.keys . readMVar . cacheObjects
|
||||
|
||||
readCache :: Cache a -> FilePath -> IO a
|
||||
readCache c file = snd `fmap` readCache' c file
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module PGFService(cgiMain,cgiMain',getPath,
|
||||
logFile,stderrToFile,
|
||||
newPGFCache,flushPGFCache) where
|
||||
newPGFCache,flushPGFCache,listPGFCache) where
|
||||
|
||||
import PGF (PGF)
|
||||
import qualified PGF
|
||||
@@ -57,11 +57,13 @@ newPGFCache = do pgfCache <- newCache PGF.readPGF
|
||||
return (pgf,({-pc-}))
|
||||
return (pgfCache,cCache)
|
||||
flushPGFCache (c1,c2) = flushCache c1 >> flushCache c2
|
||||
listPGFCache (c1,c2) = (,) # listCache c1 % listCache c2
|
||||
#else
|
||||
type Caches = (Cache PGF,())
|
||||
newPGFCache = do pgfCache <- newCache PGF.readPGF
|
||||
return (pgfCache,())
|
||||
flushPGFCache (c1,_) = flushCache c1
|
||||
listPGFCache (c1,_) = (,) # listCache c1 % return []
|
||||
#endif
|
||||
|
||||
getPath =
|
||||
|
||||
Reference in New Issue
Block a user