Purge old cache files; also cache 127 responses

backend/Cache.dcl

@@ -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

backend/Cache.icl

 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])

backend/CloogleServer.icl

@@ -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