wip: cache cli pm on disk

backend/src/LibPackageManager/PackageManager.fs

@@ -31,22 +31,93 @@ module EPT = ProgramTypes
 module ET2PT = ExternalTypesToProgramTypes
 
 
-let withCache (f : 'name -> Ply<Option<'value>>) =
-  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<DirectoryInfo>
+
+      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<bool>
+
+    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<bool>
-        | None -> ()
-        return result
+      if inCache then Some cached else None
+
+
+let withCache (cacheId : string) (f : 'name -> Ply<Option<'value>>) =
+  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,23 +184,23 @@ 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
         baseUrl
         "function"
         JsonDeserialization.ProgramTypes.PackageFn.PackageFn.decoder
         (fun f -> f |> ET2PT.PackageFn.toPT |> PT2RT.PackageFn.toRT)
-      |> withCache
+      |> withCache "getFnRT"
 
     getConstant =
       getById
         baseUrl
         "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,22 +244,22 @@ let pt (baseUrl : string) : PT.PackageManager =
         "type"
         JsonDeserialization.ProgramTypes.PackageType.decoder
         ET2PT.PackageType.toPT
-      |> withCache
+      |> withCache "getTypePT"
 
     getFn =
       getById
         baseUrl
         "function"
         JsonDeserialization.ProgramTypes.PackageFn.PackageFn.decoder
         ET2PT.PackageFn.toPT
-      |> withCache
+      |> withCache "getFnPT"
 
     getConstant =
       getById
         baseUrl
         "constant"
         JsonDeserialization.ProgramTypes.PackageConstant.decoder
         ET2PT.PackageConstant.toPT
-      |> withCache
+      |> withCache "getConstantPT"
 
     init = uply { return () } }