3
\$\begingroup\$

This is a port of a C# cache manager we use to F#. This is my first F# code, and I've tried to make it as idiomatic as possible. I would appreciate input on style, performance considerations,correctness, anything at all. The goal is to learn more about F# and functional programming. The purpose of the code is to abstract away the IIS cache, and make it possible to use multiple levels of cache, such as using Redis as a second level cache.

namespace FSharpTools
open System.Web
open System.Web.Caching
open System.Collections
open System.Web.Configuration
open Microsoft.FSharp.Reflection


module TheOneCache =

type private CacheType = Web | Redis

//The ICache interface, which can be implemented for IIS cache, Redis, etc
type private ICache =
    abstract member Add: string -> 'T -> unit
    abstract member AddForTime: string -> 'T -> System.TimeSpan -> unit
    abstract member Get: string -> 'T option
    abstract member Exists: string -> bool
    abstract member Remove: string -> unit
    abstract member FlushAll: unit
    abstract member FlushKeysThatStartWith: string -> unit                       
    abstract member GetCountStartsWith: string -> int
    abstract member GetCacheType: CacheType

//Implement the ICache interface as an IIS cache using an object expression
let private WebCache = 
    let GetHttpCacheEnum =
            HttpRuntime.Cache 
            |> Seq.cast<DictionaryEntry> 

    let FilterKeys keyPrefix = 
            GetHttpCacheEnum
            |> Seq.filter(fun e -> e.Key.ToString().StartsWith(keyPrefix))

    {   new ICache with

        member __.Add key value =
            HttpRuntime.Cache.Insert(key, value, null, System.Web.Caching.Cache.NoAbsoluteExpiration, System.Web.Caching.Cache.NoSlidingExpiration, CacheItemPriority.Normal, null)                            

        member __.AddForTime key value duration =
            HttpRuntime.Cache.Insert(key, value, null, System.Web.Caching.Cache.NoAbsoluteExpiration, duration, CacheItemPriority.NotRemovable, null)                            

        member __.Get<'T> key =
             match HttpRuntime.Cache.Get(key) with 
             | null -> None
             | result -> Some (result :?> 'T) 

        member __.Exists key =
            match HttpRuntime.Cache.Get(key) with
            | null -> false
            | _ -> true

        member __.Remove key = 
            HttpRuntime.Cache.Remove(key)  |> ignore        

        member __.FlushAll =                                
            GetHttpCacheEnum
            |> Seq.iter(fun e -> HttpRuntime.Cache.Remove(e.Key.ToString()) |> ignore)

        member __.FlushKeysThatStartWith keyPrefix = 
            FilterKeys keyPrefix
            |> Seq.iter(fun e -> HttpRuntime.Cache.Remove(e.Key.ToString()) |> ignore)                                                            

        member __.GetCountStartsWith keyPrefix =
            FilterKeys keyPrefix                 
            |> Seq.length                

        member this.GetCacheType = 
            CacheType.Web


    }



//Our list of caches, for now just the IIS cache. The order of this determines
//priority of caches when a user does a Get
let private caches = [WebCache]       

//prints a union name as a string
let private unionToString (x:'a) = 
    match FSharpValue.GetUnionFields(x, typeof<'a>) with
    | case, _ -> case.Name

//This is used to enforce that keys are prepended with some granularity
//So that later we can flush the cache by entry type if desired
type EntryType = Marklogic | SQL | Netsuite | Other with
    member this.ToString = unionToString this

//We want to keep track of state for each entry type
type private EntryTypeRecord = { theType: EntryType;name: string; enabled: bool; mutable hits:int; mutable misses:int}
let private CreateEntryTypeRecord entryType =
    { 
        theType = entryType;
        name = entryType.ToString;
        enabled = System.Convert.ToBoolean(WebConfigurationManager.AppSettings.Get("Cache-"+entryType.ToString))
        hits = 0;
        misses = 0
    }

//lets us iterate over union cases
let private allUnionCases<'T> =
    FSharpType.GetUnionCases(typeof<'T>)
    |> Array.map (fun case -> FSharpValue.MakeUnion(case,[||]):?>'T)

//Build up a dictionary of entry type records
let private EntryTypeMap =
    allUnionCases<EntryType>
    |> Seq.map( fun e -> e, CreateEntryTypeRecord e) |> Map.ofSeq


//No need for objects, just functions
let private ClearCounters entryType =
    EntryTypeMap.[entryType].hits <- 0 
    EntryTypeMap.[entryType].misses <- 0 

let private ClearAllCounters =
    EntryTypeMap |> Seq.iter(fun r-> ClearCounters r.Value.theType)


let Add (entryType:EntryType, key, value) =
    let entryRecord = EntryTypeMap.[entryType]
    match entryRecord.enabled with
    | true -> caches |> List.iter (fun c -> c.Add (entryRecord.name + key) value )
    | false -> ()           

let AddForTime(entryType:EntryType, key, value, duration) =
    let entryRecord = EntryTypeMap.[entryType]
    match entryRecord.enabled with
    | true ->  caches |> List.iter (fun c-> c.AddForTime (entryRecord.name + key) value duration)
    | false -> ()   

//Get should return from the first cache that has the key
let Get<'T> (entryType:EntryType, key) =
    let entryRecord = EntryTypeMap.[entryType]
    match entryRecord.enabled with        
    | true -> let result = caches |> List.tryPick (fun c -> c.Get (entryType.ToString + key))   
              match result with                  
              | None ->  entryRecord.misses <- entryRecord.misses + 1;  result
              | _ ->  entryRecord.hits <- entryRecord.hits + 1; result
    | false -> None   

let Remove (entryType:EntryType, key) = 
    caches |> List.iter (fun c -> c.Remove (entryType.ToString + key ))   

let FlushAll =
    caches |> List.iter (fun c -> c.FlushAll)       

let FlushKeysThatStartWith keyPrefix = 
    caches |> List.iter (fun c -> c.FlushKeysThatStartWith keyPrefix)

let FlushEntryType (entryType:EntryType) =
    FlushKeysThatStartWith entryType.ToString

let GetHits entryType = 
    EntryTypeMap.[entryType].hits

let GetMisses entryType = 
    EntryTypeMap.[entryType].misses

let GetCount entryType =
    caches |> List.map(fun c-> c.GetCountStartsWith entryType) |> List.reduce (+) 


//Special cases for caching in the Session or Request
//Which can only go in the IIS cache
let AddSession (entryType:EntryType, key, value) =
    HttpContext.Current.Session.Add(key+entryType.ToString, value)

let AddRequest (entryType:EntryType, key, value) =
    HttpContext.Current.Items.Add(key+entryType.ToString, value)

let GetFromSession<'T> (entryType:EntryType, key) =
    match HttpContext.Current.Session.[entryType.ToString + key] with 
             | null -> None
             | result -> Some (result :?> 'T) 

let GetFromRequest<'T> (entryType:EntryType, key) =
    match HttpContext.Current.Items.[entryType.ToString + key] with 
             | null -> None
             | result -> Some (result :?> 'T) 
\$\endgroup\$
2
\$\begingroup\$

My suggestion here is to just make a class for the multiple cache backed version that you are exposing. It can Implement ICache, and add the other ethods you require. This will mean there are less function names to reason about, slightly less code, and will avoid module functions backed by stateful objects, which seem unidiomatic (subjective). The module functions as public APIs will also prevent you from adding optional parameters, passing a common parameter to all the functions if needed, and having overloaded functions, many of which tend to happen in a public API as needs change.

Eirik recently tweeted about this:

https://twitter.com/eiriktsarpalis/status/964067904164651008

If I hadn't suggested converting to a class, I'd also point out that normally, people try to do lowercase for module functions. You may think you have seen some counterexamples in FSharp.Core, but you are usually looking at Static class functions in that case, which tend to be upper case.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.