Verified Commit 9146a5ae authored by Camil Staps's avatar Camil Staps 🚀

Purge old cache files; also cache 127 responses

parent 4e57a4b6
......@@ -5,7 +5,7 @@ from Data.Maybe import :: Maybe
from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode
// Check if for the hash of the argument a JSON file exists of type b
readCache :: !a -> (!*World -> (Maybe b, !*World)) | toString a & JSONDecode{|*|} b
readCache :: !a -> *World -> (Maybe b, !*World) | toString a & JSONDecode{|*|} b
// Write for the hash of a a JSON file of type b
writeCache :: !a !b -> (!*World -> (!b, !*World)) | toString a & JSONEncode{|*|} b
writeCache :: !a !b -> *World -> *World | toString a & JSONEncode{|*|} b
implementation module Cache
import StdFunc
import StdTuple
import StdOrdList
from Data.Func import $
import Control.Monad
import Control.Applicative
......@@ -9,15 +11,43 @@ import Crypto.Hash.MD5
import Text.JSON
import Data.Error
import StdFile
import System.Directory
import System.FilePath
import System.File
import System.Time
import Data.Tuple
import GenLexOrd
CACHE_DIR :== "./cache"
CACHE_SIZE :== 100
toCacheFile :: (a -> FilePath) | toString a
toCacheFile = ((</>) "./cache") o md5 o toString
toCacheFile = ((</>) CACHE_DIR) o md5 o toString
readCache :: !a -> (!*World -> (Maybe b, !*World)) | toString a & JSONDecode{|*|} b
readCache :: !a -> *World -> (Maybe b, !*World) | toString a & JSONDecode{|*|} b
readCache k = appFst (join o fmap (fromJSON o fromString) o error2mb) o readFile (toCacheFile k)
writeCache :: !a !b -> (!*World -> (!b, !*World)) | toString a & JSONEncode{|*|} b
writeCache k v = appFst (const v) o writeFile (toCacheFile k) (toString $ toJSON v)
writeCache :: !a !b -> *World -> *World | toString a & JSONEncode{|*|} b
writeCache k v = purgeCache o snd o writeFile (toCacheFile k) (toString $ toJSON v)
purgeCache :: *World -> *World
purgeCache w
# (fs,w) = readDirectory CACHE_DIR w
| isError fs
= w
# fs = map ((</>) CACHE_DIR) $ fromOk fs
| length fs < CACHE_SIZE
= w
# (infos,w) = seqList (map (\f st -> let (i,w) = getFileInfo f st in ((f,i),w)) fs) w
| any (isError o snd) infos
= w
# infos = map (appSnd fromOk) infos
# infos = sortBy (\(_,a) (_,b) -> usedLess a b) infos
= snd $ deleteFile (fst $ hd infos) w
where
usedLess :: FileInfo FileInfo -> Bool
usedLess a b = a.lastAccessedTime < b.lastAccessedTime
instance < Tm
where
(<) a b = LT === ([a.year,a.yday,a.hour,a.min,a.sec] =?= [b.year,b.yday,b.hour,b.min,b.sec])
......@@ -173,14 +173,16 @@ where
(mbType >>= \t -> suggs name t db)
# results = take MAX_RESULTS results
// Response
| isEmpty results = (err E_NORESULTS "No results", w)
// Save cache file
= writeCache request {return = 0
# response = if (isEmpty results)
(err E_NORESULTS "No results")
{ return = 0
, msg = "Success"
, data = results
, more_available = Just more
, suggestions = suggestions
} w
}
// Save cache file
= (response, writeCache request response w)
suggs :: !(Maybe String) !Type !TypeDB -> Maybe [(Request, Int)]
suggs n (Func is r cc) db
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment