How can I manage an exclusive state in F#? - f#

I am not sure about "exclusive state management" thing in the title, I did my best making it up trying to put the problem concisely.
I am porting some of my C# code to F# trying to do it as idiomatic as I can. I have an entity that requests a number of ID's from a sequence in my database and then dispenses these ID to anyone in need. Once an id is given out it should no longer be available for anybody else. Hence there must be some sort of state associated with that entity that keeps track of the remaining number of IDs. Since using a mutable state is not idiomatic, what I can do is to write something like this:
let createIdManager =
let idToStartWith = 127
let allowed = 10
let givenOut = 0
(idToStartWith, allowed, givenOut)
-
let getNextAvailableId (idToStartWith, allowed, givenOut) =
if givenOut< allowed
then ((idToStartWith, allowed, givenOut+ 1), Some(idToStartWith + givenOut))
else ((idToStartWith, allowed, givenOut), None)
let (idManager, idOpt) = getNextAvailableId createIdManager()
match idOpt with
| Some(id) -> printf "Yay!"
| None -> reloadIdManager idManager |> getNextAvailableId
This approach is idiomatic (as far as I can tell) but extremely vulnerable. There are so many ways to get it messed up. My biggest concern is that once an id is advanced and a newer copy of id manager is made, there is no force that can stop you from using the older copy and get the same id again.
So how do I do exclusive state management, per se, in F#?

If you only need to initialize the set of ids once then you can simply hide a mutable reference to a list inside a local function scope, as in:
let nextId =
let idsRef = ref <| loadIdsFromDatabase()
fun () ->
match idsRef.Value with
| [] ->
None
| id::ids ->
idsRef := ids
Some id
let id1 = nextId ()
let id2 = nextId ()

You could use a state-monad(Computational Expression).
First we declare the state-monad
type State<'s,'a> = State of ('s -> 'a * 's)
type StateBuilder<'s>() =
member x.Return v : State<'s,_> = State(fun s -> v,s)
member x.Bind(State v, f) : State<'s,_> =
State(fun s ->
let (a,s) = v s
let (State v') = f a
v' s)
let withState<'s> = StateBuilder<'s>()
let runState (State f) init = f init
Then we define your 'IdManager' and a function to get the next available id as well as the new state after the execution of the function.
type IdManager = {
IdToStartWith : int
Allowed : int
GivenOut : int
}
let getNextId state =
if state.Allowed > state.GivenOut then
Some (state.IdToStartWith + state.GivenOut), { state with GivenOut = state.GivenOut + 1 }
else
None, state
Finally we define our logic that requests the ids and execute the state-monad.
let idStateProcess =
withState {
let! id1 = State(getNextId)
printfn "Got id %A" id1
let! id2 = State(getNextId)
printfn "Got id %A" id2
//...
return ()
}
let initState = { IdToStartWith = 127; Allowed = 10; GivenOut = 0 }
let (_, postState) =
runState
idStateProcess
initState //This should be loaded from database in your case
Output:
Got id Some 127
Got id Some 128

Related

how can I combine / compose computation expressions, in F#?

This is not for a practical need, but rather to try to learn something.
I am using FSToolKit's asyncResult expression which is very handy and I would like to know if there is a way to 'combine' expressions, such as async and result here, or does a custom expression have to be written?
Here is an example of my function to set the ip to a subdomain, with CloudFlare:
let setSubdomainToIpAsync zoneName url ip =
let decodeResult (r: CloudFlareResult<'a>) =
match r.Success with
| true -> Ok r.Result
| false -> Error r.Errors.[0].Message
let getZoneAsync (client: CloudFlareClient) =
asyncResult {
let! r = client.Zones.GetAsync()
let! d = decodeResult r
return!
match d |> Seq.filter (fun x -> x.Name = zoneName) |> Seq.toList with
| z::_ -> Ok z // take the first one
| _ -> Error $"zone '{zoneName}' not found"
}
let getRecordsAsync (client: CloudFlareClient) zoneId =
asyncResult {
let! r = client.Zones.DnsRecords.GetAsync(zoneId)
return! decodeResult r
}
let updateRecordAsync (client: CloudFlareClient) zoneId (records: DnsRecord seq) =
asyncResult {
return!
match records |> Seq.filter (fun x -> x.Name = url) |> Seq.toList with
| r::_ -> client.Zones.DnsRecords.UpdateAsync(zoneId, r.Id, ModifiedDnsRecord(Name = url, Content = ip, Type = DnsRecordType.A, Proxied = true))
| [] -> client.Zones.DnsRecords.AddAsync(zoneId, NewDnsRecord(Name = url, Content = ip, Proxied = true))
}
asyncResult {
use client = new CloudFlareClient(Credentials.CloudFlare.Email, Credentials.CloudFlare.Key)
let! zone = getZoneAsync client
let! records = getRecordsAsync client zone.Id
let! update = updateRecordAsync client zone.Id records
return! decodeResult update
}
It is interfacing with a C# lib that handles all the calls to the CloudFlare API and returns a CloudFlareResult object which has a success flag, a result and an error.
I remapped that type to a Result<'a, string> type:
let decodeResult (r: CloudFlareResult<'a>) =
match r.Success with
| true -> Ok r.Result
| false -> Error r.Errors.[0].Message
And I could write an expression for it (hypothetically since I've been using them but haven't written my own yet), but then I would be happy to have an asyncCloudFlareResult expression, or even an asyncCloudFlareResultOrResult expression, if that makes sense.
I am wondering if there is a mechanism to combine expressions together, the same way FSToolKit does (although I suspect it's just custom code there).
Again, this is a question to learn something, not about the practicality since it would probably add more code than it's worth.
Following Gus' comment, I realized it would be good to illustrate the point with some simpler code:
function DoA : int -> Async<AWSCallResult<int, string>>
function DoB : int -> Async<Result<int, string>>
AWSCallResultAndResult {
let! a = DoA 3
let! b = DoB a
return b
}
in this example I would end up with two types that can take an int and return an error string, but they are different. Both have their expressions so I can chain them as needed.
And the original question is about how these can be combined together.
It's possible to extend CEs with overloads.
The example below makes it possible to use the CustomResult type with a usual result builder.
open FsToolkit.ErrorHandling
type CustomResult<'T, 'TError> =
{ IsError: bool
Error: 'TError
Value: 'T }
type ResultBuilder with
member inline _.Source(result : CustomResult<'T, 'TError>) =
if result.IsError then
Error result.Error
else
Ok result.Value
let computeA () = Ok 42
let computeB () = Ok 23
let computeC () =
{ CustomResult.Error = "oops. This went wrong"
CustomResult.IsError = true
CustomResult.Value = 64 }
let computedResult =
result {
let! a = computeA ()
let! b = computeB ()
let! c = computeC ()
return a + b + c
}

Type inference workaround for generic function

Given the following parametric type
type SomeDU2<'a,'b> =
| One of 'a
| Two of 'a * 'b
I have to functions that check if the given param is the respective union case without regard to params
let checkOne x =
match x with
| One _ -> true
| _ -> false
let checkTwo x =
match x with
| Two _ -> true
| _ -> false
This works pretty nice and as expected
let oi = checkOne (One 1)
let os = checkOne (One "1")
let tis = checkTwo (Two (1, "1"))
let tsi = checkTwo (Two ("1", 1))
I can switch the types as I like.
Now However I like to combine those two functions into one creation function
let makeUC () = (checkOne, checkTwo)
and then instantiate like this
let (o,t) = makeUC ()
only it gives me this error message now
Value restriction. The value 'o' has been inferred to have generic type
val o : (SomeDU2<'_a,'_b> -> bool)
Either make the arguments to 'o' explicit or, if you do not intend for it to be generic, add a type annotation.
val o : (SomeDU2<obj,obj> -> bool)
Actually I dont want that - nor do I need that.
Probably its a instance of missing higher kinded types in F#
Is there a way around this?
Edit
Actually me question wasnt complety as per #johns comment below.
Obviously I can do the following
let ro1 = o ((One 1) : SomeDU2<int,int>)
let rt1 = t (Two (1,2))
which then will backwards infer o and t to be of type SomeDU2<int,int> -> bool (I find this backwards inference very strange thou). The problem then is that o wont allow for the below anymore.
let ro2 = o ((One "1") : SomeDU2<string,int>)
So I'd have to instantiate a specific o instance for every combination of generic parameters of SomeDU2.
You would run into the value restriction even without the tuple:
let o = (fun () -> checkOne)()
If you need the results of invoking a function to be applicable to values of any type, then one solution would be to create instances of a nominal type with a generic method:
type DU2Checker =
abstract Check : SomeDU2<'a,'b> -> bool
let checkOne = {
new DU2Checker with
member this.Check(x) =
match x with
| One _ -> true
| _ -> false }
let checkTwo = {
new DU2Checker with
member this.Check(x) =
match x with
| Two _ -> true
| _ -> false }
let makeUC() = checkOne, checkTwo
let o,t = makeUC()
let false = o.Check(Two(3,4))

Time to live memoization in F#

Not sure if I got this right or whether there's a better way or an existing library solving this problem already.
In particular I'm not sure if the CAS would need a memory fence... I think not but better ask.
I also tried with an agent and mutable dictionary but my intuition that it would be slower was confirmed and the implementation was more involved.
module CAS =
open System.Threading
let create (value: 'T) =
let cell = ref value
let get () = !cell
let rec swap f =
let before = get()
let newValue = f before
match Interlocked.CompareExchange<'T>(cell, newValue, before) with
| result when obj.ReferenceEquals(before, result) ->
newValue
| _ ->
swap f
get, swap
module Memoization =
let timeToLive milis f =
let get, swap = CAS.create Map.empty
let evict key =
async {
do! Async.Sleep milis
swap (Map.remove key) |> ignore
} |> Async.Start
fun key ->
let data = get()
match data.TryFind key with
| Some v -> v
| None ->
let v = f key
swap (Map.add key v) |> ignore
evict key
v
If you are willing to limit what to memoize to functions that take a string input, you can reuse the functionality from System.Runtime.Caching.
This should be reasonably robust as part of the core library (you would hope...) but the string limitation is a pretty heavy one and you'd have to benchmark against your current implementation if you want to do a comparison on performance.
open System
open System.Runtime.Caching
type Cached<'a>(func : string -> 'a, cache : IDisposable) =
member x.Func : string -> 'a = func
interface IDisposable with
member x.Dispose () =
cache.Dispose ()
let cache timespan (func : string -> 'a) =
let cache = new MemoryCache(typeof<'a>.FullName)
let newFunc parameter =
match cache.Get(parameter) with
| null ->
let result = func parameter
let ci = CacheItem(parameter, result :> obj)
let cip = CacheItemPolicy()
cip.AbsoluteExpiration <- DateTimeOffset(DateTime.UtcNow + timespan)
cip.SlidingExpiration <- TimeSpan.Zero
cache.Add(ci, cip) |> ignore
result
| result ->
(result :?> 'a)
new Cached<'a>(newFunc, cache)
let cacheAsync timespan (func : string -> Async<'a>) =
let cache = new MemoryCache(typeof<'a>.FullName)
let newFunc parameter =
match cache.Get(parameter) with
| null ->
async {
let! result = func parameter
let ci = CacheItem(parameter, result :> obj)
let cip = CacheItemPolicy()
cip.AbsoluteExpiration <- DateTimeOffset(DateTime.UtcNow + timespan)
cip.SlidingExpiration <- TimeSpan.Zero
cache.Add(ci, cip) |> ignore
return result
}
| result ->
async { return (result :?> 'a) }
new Cached<Async<'a>>(newFunc, cache)
Usage:
let getStuff =
let cached = cacheAsync (TimeSpan(0, 0, 5)) uncachedGetStuff
// deal with the fact that the cache is IDisposable here
// however is appropriate...
cached.Func
If you're never interested in accessing the underlying cache directly you can obviously just return a new function with the same signature of the old - but given the cache is IDisposable, that seemed unwise.
I think in many ways I prefer your solution, but when I faced a similar problem I had a perverse thought that I should really use the built in stuff if I could.

Eliminating my explicit state passing via like, monads and stuff

I'm working through the book Land of Lisp in F# (yeah weird, I know). For their first example text adventure, they make use of global variable mutation and I'd like to avoid it. My monad-fu is weak, so right now I'm doing ugly state passing like this:
let pickUp player thing (objects: Map<Location, Thing list>) =
let objs = objects.[player.Location]
let attempt = objs |> List.partition (fun o -> o.Name = thing)
match attempt with
| [], _ -> "You cannot get that.", player, objs
| thing :: _, things ->
let player' = { player with Objects = thing :: player.Objects }
let msg = sprintf "You are now carrying %s %s" thing.Article thing.Name
msg, player', things
let player = { Location = Room; Objects = [] }
let objects =
[Room, [{ Name = "whiskey"; Article = "some" }; { Name = "bucket"; Article = "a" }];
Garden, [{ Name = "chain"; Article = "a length of" }]]
|> Map.ofList
let msg, p', o' = pickUp player "bucket" objects
// etc.
How can I factor out the explicit state to make it prettier? (Assume I have access to a State monad type if it helps; I know there is sample code for it in F# out there.)
If you want to use the state monad to thread the player's inventory and world state through the pickUp function, here's one approach:
type State<'s,'a> = State of ('s -> 'a * 's)
type StateBuilder<'s>() =
member x.Return v : State<'s,_> = State(fun s -> v,s)
member x.Bind(State v, f) : State<'s,_> =
State(fun s ->
let (a,s) = v s
let (State v') = f a
v' s)
let withState<'s> = StateBuilder<'s>()
let getState = State(fun s -> s,s)
let putState v = State(fun _ -> (),v)
let runState (State f) init = f init
type Location = Room | Garden
type Thing = { Name : string; Article : string }
type Player = { Location : Location; Objects : Thing list }
let pickUp thing =
withState {
let! (player, objects:Map<_,_>) = getState
let objs = objects.[player.Location]
let attempt = objs |> List.partition (fun o -> o.Name = thing)
match attempt with
| [], _ ->
return "You cannot get that."
| thing :: _, things ->
let player' = { player with Objects = thing :: player.Objects }
let objects' = objects.Add(player.Location, things)
let msg = sprintf "You are now carrying %s %s" thing.Article thing.Name
do! putState (player', objects')
return msg
}
let player = { Location = Room; Objects = [] }
let objects =
[Room, [{ Name = "whiskey"; Article = "some" }; { Name = "bucket"; Article = "a" }]
Garden, [{ Name = "chain"; Article = "a length of" }]]
|> Map.ofList
let (msg, (player', objects')) =
(player, objects)
|> runState (pickUp "bucket")
If you want to use mutable state in F#, then the best way is just to write a mutable object. You can declare a mutable Player type like this:
type Player(initial:Location, objects:ResizeArray<Thing>) =
let mutable location = initial
member x.AddThing(obj) =
objects.Add(obj)
member x.Location
with get() = location
and set(v) = location <- v
Using monads to hide mutable state isn't as common in F#. Using monads gives you essentially the same imperative programming model. It hides the passing of state, but it doesn't change the programming model - there is some mutable state that makes it impossible to parallelize the program.
If the example uses mutation, then it is probably because it was designed in an imperative way. You can, change the program architecture to make it more functional. For example, instead of picking the item (and modifying the player), the pickUp function could just return some object representing a request to pick the item. The world would then have some engine that evaluates these requests (collected from all players) and calculates the new state of the world.

Rewriting simple C# nested class

What would be an elegant way to implement the functionality of this nested class in F#?
private class Aliaser {
private int _count;
internal Aliaser() { }
internal string GetNextAlias() {
return "t" + (_count++).ToString();
}
}
This was my first attempt, but it feels like there should be a sexy one-liner for this:
let aliases = (Seq.initInfinite (sprintf "t%d")).GetEnumerator()
let getNextAlias() =
aliases.MoveNext() |> ignore
aliases.Current
The usual way of writing is to create a function with local state captured in a closure:
let getNextAlias =
let count = ref 0
(fun () ->
count := !count + 1;
sprintf "t%d" (!count))
The type of getNextAlias is simply unit -> string and when you call it repeatedly, it returns strings "t1", "t2", ... This relies on mutable state, but the mutable state is hidden from the user.
Regarding whether you can do this without mutable state - the simple answer is NO, because when you call a purely functional function with the same parameter twice, it must return the same result. Thus, you'd have to write something with the following structure:
let alias, state1 = getNextAlias state0
printf "first alias %s" alias
let alias, state2 = getNextAlias state1
printf "second alias %s" alias
// ...
As you can see, you'd need to keep some state and maintain it through the whole code. In F#, the standard way of dealing with this is to use mutable state. In Haskell, you could use State monad, which allows you to hide the passing of the state. Using the implementation from this question, you could write something like:
let getNextAlias = state {
let! n = getState
do! setState (n + 1)
return sprintf "t%d" n }
let program =
state {
let! alias1 = getNextAlias()
let! alias2 = getNextAlias()
// ...
}
execute progam 0 // execute with initial state
This is quite similar to other computations such as lazy or seq, actually - computations in the state { .. } block have some state and you can execute them by providing initial value of the state. However, unless you have good reasons for requiring purely functional solution, I'd prefer the first version for practical F# programming.
Here is the quick and dirty translation
type Aliaser () =
let mutable _count = 0
member x.GetNextAlias() =
let value = _count.ToString()
_count <- _count + 1
"t" + value
A more functional approach without state is to use continuations.
let createAliaser callWithValue =
let rec inner count =
let value = "t" + (count.ToString())
callWithValue value (fun () -> inner (count + 1))
inner 1
This is a declaration which will call the function callWithValue with both the value and the function to execute to repeat with the next value.
And here's an example using it
let main () =
let inner value (next : unit -> unit )=
printfn "Value: %s" value
let input = System.Console.ReadLine()
if input <> "quit" then next()
createAliaser inner
main()
I would use Seq.unfold : (('a -> ('b * 'a) option) -> 'a -> seq<'b>) to generate the aliases.
Implemented as:
let alias =
Seq.unfold (fun count -> Some(sprintf "t%i" count, count+1)) 0

Resources