Simple timed-expiry cache

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 

open System

type CacheMessage<'a,'b> =
| Get of 'a * AsyncReplyChannel<'b option>
| Set of 'a * 'b

let cache timeout =
   let expiry = TimeSpan.FromMilliseconds (float timeout)
   let exp =
      Map.filter (fun _ (_,dt) -> DateTime.Now-dt >= expiry)
   let newValue k v = Map.add k (v, DateTime.Now)
   MailboxProcessor.Start(fun inbox ->
      let rec loop map =
         async {
            let! msg = inbox.TryReceive timeout
            match msg with
            | Some (Get (key, channel)) ->
               match map |> Map.tryFind key with
               | Some (v,dt) when DateTime.Now-dt < expiry ->
                  channel.Reply (Some v)
                  return! loop map
               | _ ->
                  channel.Reply None
                  return! loop (Map.remove key map)
            | Some (Set (key, value)) ->
               return! loop (newValue key value map)
            | None ->
               return! loop (exp map)
         }
      loop Map.empty
   )

// sample usage:
// let c = cache 1500
// let get k = c.PostAndReply (fun channel -> Get (k, channel))
// let set k v = c.Post (Set (k, v))
// set 5 "test"
// printfn "5 => %A" (get 5)
// ... wait for 1.5 seconds, expiry will kick in ...
// printfn "5 => %A" (get 5)

namespace System

type CacheMessage<'a,'b> =
  | Get of 'a * AsyncReplyChannel<'b option>
  | Set of 'a * 'b

Full name: Script.CacheMessage<_,_>

union case CacheMessage.Get: 'a * AsyncReplyChannel<'b option> -> CacheMessage<'a,'b>

type AsyncReplyChannel<'Reply>
member Reply : value:'Reply -> unit

Full name: Microsoft.FSharp.Control.AsyncReplyChannel<_>

type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>

Multiple items
union case CacheMessage.Set: 'a * 'b -> CacheMessage<'a,'b>

--------------------
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>

val cache : timeout:int -> MailboxProcessor<CacheMessage<'a,'b>> (requires comparison)

Full name: Script.cache

val timeout : int

val expiry : TimeSpan

Multiple items
type TimeSpan =
  struct
    new : ticks:int64 -> TimeSpan + 3 overloads
    member Add : ts:TimeSpan -> TimeSpan
    member CompareTo : value:obj -> int + 1 overload
    member Days : int
    member Duration : unit -> TimeSpan
    member Equals : value:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member Hours : int
    member Milliseconds : int
    member Minutes : int
    ...
  end

Full name: System.TimeSpan

--------------------
TimeSpan()
TimeSpan(ticks: int64) : unit
TimeSpan(hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int, milliseconds: int) : unit

TimeSpan.FromMilliseconds(value: float) : TimeSpan

Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>

val exp : (Map<'a,('b * DateTime)> -> Map<'a,('b * DateTime)>) (requires comparison)

Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>

val filter : predicate:('Key -> 'T -> bool) -> table:Map<'Key,'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.filter

val dt : DateTime

Multiple items
type DateTime =
  struct
    new : ticks:int64 -> DateTime + 10 overloads
    member Add : value:TimeSpan -> DateTime
    member AddDays : value:float -> DateTime
    member AddHours : value:float -> DateTime
    member AddMilliseconds : value:float -> DateTime
    member AddMinutes : value:float -> DateTime
    member AddMonths : months:int -> DateTime
    member AddSeconds : value:float -> DateTime
    member AddTicks : value:int64 -> DateTime
    member AddYears : value:int -> DateTime
    ...
  end

Full name: System.DateTime

--------------------
DateTime()
   (+0 other overloads)
DateTime(ticks: int64) : unit
   (+0 other overloads)
DateTime(ticks: int64, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, kind: DateTimeKind) : unit
   (+0 other overloads)

property DateTime.Now: DateTime

val newValue : ('c -> 'd -> Map<'c,('d * DateTime)> -> Map<'c,('d * DateTime)>) (requires comparison)

val k : 'c (requires comparison)

val v : 'd

val add : key:'Key -> value:'T -> table:Map<'Key,'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.add

Multiple items
type MailboxProcessor<'Msg> =
  interface IDisposable
  new : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:CancellationToken -> MailboxProcessor<'Msg>
  member Post : message:'Msg -> unit
  member PostAndAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply>
  member PostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply
  member PostAndTryAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply option>
  member Receive : ?timeout:int -> Async<'Msg>
  member Scan : scanner:('Msg -> Async<'T> option) * ?timeout:int -> Async<'T>
  member Start : unit -> unit
  member TryPostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply option
  ...

Full name: Microsoft.FSharp.Control.MailboxProcessor<_>

--------------------
new : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:Threading.CancellationToken -> MailboxProcessor<'Msg>

static member MailboxProcessor.Start : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:Threading.CancellationToken -> MailboxProcessor<'Msg>

val inbox : MailboxProcessor<CacheMessage<'a,'b>> (requires comparison)

val loop : (Map<'a,('b * DateTime)> -> Async<'c>) (requires comparison)

val map : Map<'a,('b * DateTime)> (requires comparison)

val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async

val msg : CacheMessage<'a,'b> option (requires comparison)

member MailboxProcessor.TryReceive : ?timeout:int -> Async<'Msg option>

union case Option.Some: Value: 'T -> Option<'T>

val key : 'a (requires comparison)

val channel : AsyncReplyChannel<'b option>

val tryFind : key:'Key -> table:Map<'Key,'T> -> 'T option (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.tryFind

val v : 'b

member AsyncReplyChannel.Reply : value:'Reply -> unit

union case Option.None: Option<'T>

val remove : key:'Key -> table:Map<'Key,'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.remove

val value : 'b

val empty<'Key,'T (requires comparison)> : Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.empty