diff --git a/backend/src/LibPackageManager/PackageManager.fs b/backend/src/LibPackageManager/PackageManager.fs index 9e0125847e..b55c8da9f6 100644 --- a/backend/src/LibPackageManager/PackageManager.fs +++ b/backend/src/LibPackageManager/PackageManager.fs @@ -31,22 +31,93 @@ module EPT = ProgramTypes module ET2PT = ExternalTypesToProgramTypes -let withCache (f : 'name -> Ply>) = - let cache = System.Collections.Concurrent.ConcurrentDictionary<'name, 'value>() - fun (name : 'name) -> - uply { +module Cache = + module OnDisk = + // TODO if the shape of these types change, or if we change the definitions of the things we're caching, + // then this cache will be invalid. We should have a version number in the cache, and check it when we load. + // This will be less of an issue when package things don't change. + + open System.IO + open System.Runtime.Serialization.Formatters.Binary + + let baseTempPath = Path.Combine(Path.GetTempPath(), "darklang") + let dirPath = Path.Combine(baseTempPath, "packages") + + let getFilePath (cacheId : string) (key : string) = + let dirPath = Path.Combine(dirPath, cacheId) + + if not (Directory.Exists(dirPath)) then + Directory.CreateDirectory(dirPath) |> ignore + + Path.Combine(dirPath, $"{key}.json") + + let saveToDisk (cacheId : string) (key : string) (value : 'value) = + let filePath = getFilePath cacheId key + let json = Json.Vanilla.serialize value + File.WriteAllText(filePath, json) + + let loadFromDisk (cacheId : string) (key : string) : Option<'value> = + let filePath = getFilePath cacheId key + if File.Exists filePath then + try + let json = File.ReadAllText filePath + let value = Json.Vanilla.deserialize<'value> json + Some value + with _ -> + None + else + None + + + module InMemory = + open System.Collections.Concurrent + + let createCache () = ConcurrentDictionary<'name, 'value>() + + let saveToMemory + (cache : ConcurrentDictionary<'name, 'value>) + (name : 'name) + (value : 'value) + = + cache.TryAdd(name, value) |> ignore + + let loadFromMemory + (cache : ConcurrentDictionary<'name, 'value>) + (name : 'name) + : Option<'value> = let mutable cached = Unchecked.defaultof<'value> let inCache = cache.TryGetValue(name, &cached) - if inCache then - return Some cached - else - let! result = f name - match result with - | Some v -> cache.TryAdd(name, v) |> ignore - | None -> () - return result + if inCache then Some cached else None + + +let withCache (cacheId : string) (f : 'name -> Ply>) = + let memoryCache = Cache.InMemory.createCache () + fun (name : 'name) -> + uply { + let key = name.ToString() + // first, check in-mem cache + match Cache.InMemory.loadFromMemory memoryCache name with + | Some value -> return Some value + | None -> + // if that fails, check on-disk cache + match Cache.OnDisk.loadFromDisk cacheId key with + | Some value -> + Cache.InMemory.saveToMemory memoryCache name value + return Some value + | None -> + // otherwise, fetch and save to both + let! result = f name + match result with + | Some v -> + Cache.InMemory.saveToMemory memoryCache name v + Cache.OnDisk.saveToDisk cacheId key v + | None -> () + return result } + + + let httpClient = new System.Net.Http.HttpClient() // CLEANUP pass this in as param? or mutate it externally? let fetch @@ -113,7 +184,7 @@ let rt (baseUrl : string) : RT.PackageManager = "type" JsonDeserialization.ProgramTypes.PackageType.decoder (fun t -> t |> ET2PT.PackageType.toPT |> PT2RT.PackageType.toRT) - |> withCache + |> withCache "getTypeRT" getFn = getById @@ -121,7 +192,7 @@ let rt (baseUrl : string) : RT.PackageManager = "function" JsonDeserialization.ProgramTypes.PackageFn.PackageFn.decoder (fun f -> f |> ET2PT.PackageFn.toPT |> PT2RT.PackageFn.toRT) - |> withCache + |> withCache "getFnRT" getConstant = getById @@ -129,7 +200,7 @@ let rt (baseUrl : string) : RT.PackageManager = "constant" JsonDeserialization.ProgramTypes.PackageConstant.decoder (fun c -> c |> ET2PT.PackageConstant.toPT |> PT2RT.PackageConstant.toRT) - |> withCache + |> withCache "getConstantRT" init = uply { return () } } @@ -154,17 +225,17 @@ let pt (baseUrl : string) : PT.PackageManager = { findType = (fun (name : PT.PackageType.Name) -> findByName baseUrl "type" name.owner name.modules name.name) - |> withCache + |> withCache "findTypePT" findConstant = (fun (name : PT.PackageConstant.Name) -> findByName baseUrl "constant" name.owner name.modules name.name) - |> withCache + |> withCache "findConstantPT" findFn = (fun (name : PT.PackageFn.Name) -> findByName baseUrl "function" name.owner name.modules name.name) - |> withCache + |> withCache "findFnPT" getType = @@ -173,7 +244,7 @@ let pt (baseUrl : string) : PT.PackageManager = "type" JsonDeserialization.ProgramTypes.PackageType.decoder ET2PT.PackageType.toPT - |> withCache + |> withCache "getTypePT" getFn = getById @@ -181,7 +252,7 @@ let pt (baseUrl : string) : PT.PackageManager = "function" JsonDeserialization.ProgramTypes.PackageFn.PackageFn.decoder ET2PT.PackageFn.toPT - |> withCache + |> withCache "getFnPT" getConstant = getById @@ -189,6 +260,6 @@ let pt (baseUrl : string) : PT.PackageManager = "constant" JsonDeserialization.ProgramTypes.PackageConstant.decoder ET2PT.PackageConstant.toPT - |> withCache + |> withCache "getConstantPT" init = uply { return () } }