FsCheck lazy generators - f#

I have issues with generation of data within my tests.
testProperty "calculate Operation against different operations should increase major" <| fun operationIdApi operationIdClient summaryApi summaryClient descriptionApi descriptionClient ->
( notAllEqual [
fun () -> assessEquality <| StringEquals(operationIdApi, operationIdClient)
fun () -> assessEquality <| StringEquals(summaryApi , summaryClient)
fun () -> assessEquality <| StringEquals(descriptionApi, descriptionClient)
]) ==> lazy (
let operationClient = createOpenApiOperation operationIdClient summaryClient descriptionClient
let operationAPI = createOpenApiOperation operationIdApi summaryApi descriptionApi
let actual = calculate operationAPI operationClient
Expect.equal actual (Fact.Semver.IncreaseMajor) "return IncreaseMajor"
)
The code that is actually tested is :
semver {
if operationAPI.OperationId<> operationClient.OperationId then yield! IncreaseMajor
if operationAPI.Summary <> operationClient.Summary then yield! IncreaseMajor
}
The test should fail when the data produced is same OperationId, same summary and different description.
But it does not and it led me to create my own generator or at least try to do so:
I wanted my test to be written like this :
testProperty "calculate Operation against different operations should increase major" <| fun (operationId:ElementSet<string>) (summary:ElementSet<string>) ->
Therefore I create a type accordingly:
type ElementSet<'a> =
| Same of 'a
| Different
and a generator for this type :
let setGen<'a> =
Gen.oneof [
gen {
let! v = Arb.generate<'a>
return Same(v)
}
gen { return Different}
]
type ElementSetGenerator =
static member ElementSet() =
Arb.fromGen setGen<'a>
do Arb.register<ElementSetGenerator>() |> ignore
I was then trying to extract the data to construct my object :
let createOpenApiOperation operationId summary=
let pi = OpenApiOperation(OperationId=operationId.Get, Summary=summary.Get)
pi
The Get method did not exist yet so I was about to implement it by adding a member to my ElementSet<'a>:
type ElementSet<'a> =
| Same of 'a
| Different
with member this.Get =
match this with
| Same s -> s
| Different -> Arb.generate<'a>// some random generation here
And this is where I am stuck. I would love to get some randomness here when I extract data. I wonder if this is the correct way to do so, or if I should have answered the problem earlier?
Thanks for your inputs.

I think I found it, the answer was to handle it at the beginning :
let setGen<'a when 'a:equality> =
Gen.oneof [
gen {
let! v = Arb.generate<'a>
return Same(v)
}
gen {
let! x,y =
Arb.generate<'a>
|> Gen.two
|> Gen.filter (fun (a,b)-> a <> b)
return Different(x,y)
}
]
and then to use two getter to access the values :
type ElementSet<'a> when 'a:equality=
| Same of 'a
| Different of 'a*'a
with member this.Fst = match this with | Same s -> s | Different (a, b)-> a
member this.Snd = match this with | Same s -> s | Different (a, b)-> b
this way I can access values within my test:
testProperty "calculate Operation against different operations should increase major" <| fun (operationId:ElementSet<NonWhiteSpaceString>) (summary:ElementSet<NonWhiteSpaceString>) (description:ElementSet<NonWhiteSpaceString>) ->
let operationClient = createOpenApiOperation operationId.Fst summary.Fst description.Fst
let operationAPI = createOpenApiOperation operationId.Snd summary.Snd description.Snd
let actual = calculate operationAPI operationClient
Expect.equal actual (Fact.Semver.IncreaseMajor) "return IncreaseMajor"
for the record I then have the creation of my stub as follows :
let createOpenApiOperation (operationId:NonWhiteSpaceString) (summary:NonWhiteSpaceString) (description:NonWhiteSpaceString)=
let pi = OpenApiOperation(OperationId=operationId.Get, Summary=summary.Get, Description=description.Get)
pi

Related

async programming, async's in asycns

I have a DU (don't worry about the specific types, but 2 normal options, or some errors)
type Content =
| Episode of EpisodeJSON.Root
| Program of string
| Errors of List<exn>
I have 2 functions (again the specifics don't matter, just the types):
let getEpisode : _ -> _ -> Async<Content> = ...
let getProgram : _ -> _ -> Async<Content> = ...
I want to write
let getContent : _ -> _ -> Async<Content> =
fun (contentBAPIClient: ContentBAPI.Client) id -> ...
such that, it tries to get the data from getEpisode, if there's an error, it tries to get it from getProgram, and if there is an error again, it returns both errors as the Error DU.
so, this works
let getContent : _ -> _ -> Async<Content> =
fun (contentBAPIClient: ContentBAPI.Client) id ->
async {
let! episodeMaybe = getEpisode contentBAPIClient id
let! programMaybe = getProgram contentBAPIClient id
return
match episodeMaybe with
| Errors xs ->
match programMaybe with
| Errors ys ->
Errors (List.append xs ys)
| program ->
program
| episode ->
episode
}
but I notice that getprogram is being executed even when the data is found via getepisode.
How do i structure this simple function to try getEpisode first, then only try getProgram if episode 'fails'
this works, still feels a bit clunky
let getContent : _ -> _ -> Async<Content> =
fun (contentBAPIClient: ContentBAPI.Client) id ->
async {
let! episodeMaybe = getEpisode contentBAPIClient id
match episodeMaybe with
| Errors xs ->
let! programMaybe = getProgram contentBAPIClient id
match programMaybe with
| Errors ys ->
return Errors (List.append xs ys)
| program ->
return program
| episode ->
return episode
}
This will get a lot easier if you use some library that lets you work with values representing asynchronous computations that may fail, i.e. type Async<Result<'TOk, 'TErrror>>.
A good choice would be something like FsToolkit.ErrorHandling. This defines the asyncResult computation expression as well as a number of primitives that you may find useful.
To get this to compile, I started with this:
#r "nuget: FsToolkit.ErrorHandling"
open FsToolkit.ErrorHandling
type Client = class end
let getEpisode contentBAPIClient id =
async { return Error ["no episode"] }
let getProgram contentBAPIClient id =
async { return Ok "fine" }
Now, to do what (I think) you are doing, you can use:
let getContent (contentBAPIClient: Client) id =
getEpisode contentBAPIClient id
|> AsyncResult.orElseWith (fun e1 ->
getProgram contentBAPIClient id
|> AsyncResult.mapError (fun e2 -> e1 # e2) )
Here, we try to return the episode, but if there is not one, we try to get program (using orElseWith). The only tricky thing is that we need to pass the errors from the first call, which are then appended to (potential) errors of the second call using mapError.
Note that you can also write:
let getContent (contentBAPIClient: Client) id =
asyncResult {
let! ep = getEpisode contentBAPIClient id
and! prog = getProgram contentBAPIClient id
return ep, prog }
This succeeds only if both calls succeed, so it can be quite useful in many scenarios, but does not exactly do the thing that you are trying to do.

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
}

How to implement Task.Map

Have I correctly implemented map for Task?
let map continuation (t: Task<'A>) =
t.ContinueWith(fun (antecedent: Task<'A>) ->
if antecedent.Status <> TaskStatus.Canceled &&
antecedent.Status <> TaskStatus.Faulted then
continuation antecedent.Result
else
raise antecedent.Exception // must I?
)
I got the TaskStatus checks from the docs. I feel most uncertain about raise antecedent.Exception, but I can't think of another way to handle it.
As background, yes I'm aware of Async, but my current stack uses Entity Framework and Blazor, so I have a backend that uses things like .ToListAsync() and a front end in C#, so I'd rather just not deal with converting from Task to Async then back again.
I would suggest implementing your solution in terms of the interfaces behind the concept of awaitable in the TPL, namely INotifyCompletion and ICriticalNotifyCompletion. Also, to implement map correctly, you should really do it in terms of bind. This is something that there are already some existing solutions for in F#, such as the TaskBuilder library. Personally, I have been using the following in a library for years without any issues:
open System.Runtime.CompilerServices
open System.Threading.Tasks
type TaskStep<'result> =
| Value of 'result
| AsyncValue of 'result Task
| Continuation of ICriticalNotifyCompletion * (unit -> 'result TaskStep)
and StateMachine<'a>(firstStep) as this =
let methodBuilder = AsyncTaskMethodBuilder<'a Task>()
let mutable continuation = fun () -> firstStep
let nextAwaitable() =
try
match continuation() with
| Value r ->
methodBuilder.SetResult(Task.FromResult(r))
null
| AsyncValue t ->
methodBuilder.SetResult(t)
null
| Continuation (await, next) ->
continuation <- next
await
with
| exn ->
methodBuilder.SetException(exn)
null
let mutable self = this
member __.Run() =
methodBuilder.Start(&self)
methodBuilder.Task
interface IAsyncStateMachine with
member __.MoveNext() =
let mutable await = nextAwaitable()
if not (isNull await) then
methodBuilder.AwaitUnsafeOnCompleted(&await, &self)
member __.SetStateMachine(_) =
()
type Binder<'out> =
static member inline GenericAwait< ^abl, ^awt, ^inp
when ^abl : (member GetAwaiter : unit -> ^awt)
and ^awt :> ICriticalNotifyCompletion
and ^awt : (member get_IsCompleted : unit -> bool)
and ^awt : (member GetResult : unit -> ^inp) >
(abl : ^abl, continuation : ^inp -> 'out TaskStep) : 'out TaskStep =
let awt = (^abl : (member GetAwaiter : unit -> ^awt)(abl))
if (^awt : (member get_IsCompleted : unit -> bool)(awt))
then continuation (^awt : (member GetResult : unit -> ^inp)(awt))
else Continuation (awt, fun () -> continuation (^awt : (member GetResult : unit -> ^inp)(awt)))
module TaskStep =
let inline bind f step : TaskStep<'a> =
Binder<'a>.GenericAwait(step, f)
let inline toTask (step: TaskStep<'a>) =
try
match step with
| Value x -> Task.FromResult(x)
| AsyncValue t -> t
| Continuation _ as step -> StateMachine<'a>(step).Run().Unwrap()
with
| exn ->
let src = new TaskCompletionSource<_>()
src.SetException(exn)
src.Task
module Task =
let inline bind f task : Task<'a> =
TaskStep.bind f task |> TaskStep.toTask
let inline map f task : Task<'b> =
bind (f >> Value) task
FsToolkit.ErrorHandling implements it here. I'll paste the current version below as it's quite short. It uses the TaskBuilder library Aaron mentioned.
module Task =
let singleton value = value |> Task.FromResult
let bind (f : 'a -> Task<'b>) (x : Task<'a>) = task {
let! x = x
return! f x
}
let map f x = x |> bind (f >> singleton)
Additionally, FSharpPlus has an independent implementation of Task.map here.
Throwing the exception again in the continuation would make for an incorrect stack trace.
It's a mapping from 'A -> 'B, so it's probably best to lay it out explicitly.
let rec map (continuation: 'A -> 'B) (t: Task<'A>) =
let rec map_resolved (task: Task<'A>) =
match task.Status with
| TaskStatus.RanToCompletion -> Task.FromResult(continuation task.Result)
| TaskStatus.Faulted -> Task.FromException<'B>(task.Exception)
| TaskStatus.Canceled -> Task.FromCanceled<'B>(CancellationToken.None)
| _ -> task.ContinueWith(map_resolved).Unwrap()
map_resolved t

Avoiding nested pattern matching (possibly with maybe monad)

How could nested pattern matching, such as the following example, be re-written so that None is specified only once? I think the Maybe monad solves this problem. Is there something similar in the F# core library? Or, is there an alternative approach?
match a with
| Some b ->
let c = b.SomeProperty
match c with
| Some d ->
let e = d.SomeProperty
//and so on...
| None -> ()
| None -> ()
you can solve this using built-in capabilities: Option.bind
type A =
member this.X : B option = Unchecked.defaultof<_>
and B =
member this.Y : С option = Unchecked.defaultof<_>
and С =
member this.Z : string option = Unchecked.defaultof<_>
let a : A = Unchecked.defaultof<_>
let v =
match
a.X
|> Option.bind (fun v -> v.Y)
|> Option.bind (fun v -> v.Z) with
| Some s -> s
| None -> "<none>"
Frankly, I doubt that introducing full-fledged 'maybe' implementation (via computation expressions) here can shorten the code.
EDIT: Dream mode - on
I think that version with Option.bind can be made smaller if F# has more lightweight syntax for the special case: lambda that refer to some member of its argument:
"123" |> fun s -> s.Length // current version
"123" |> #.Length // hypothetical syntax
This is how the sample can be rewritten in Nemerle that already has such capabilities:
using System;
using Nemerle.Utility; // for Accessor macro : generates property for given field
variant Option[T]
{
| Some {value : T}
| None
}
module OptionExtensions
{
public Bind[T, U](this o : Option[T], f : T -> Option[U]) : Option[U]
{
match(o)
{
| Option.Some(value) => f(value)
| Option.None => Option.None()
}
}
}
[Record] // Record macro: checks existing fields and creates constructor for its initialization
class A
{
[Accessor]
value : Option[A];
}
def print(_)
{
// shortened syntax for functions with body -> match over arguments
| Option.Some(_) => Console.WriteLine("value");
| Option.None => Console.WriteLine("none");
}
def x = A(Option.Some(A(Option.Some(A(Option.None())))));
print(x.Value.Bind(_.Value)); // "value"
print(x.Value.Bind(_.Value).Bind(_.Value)); // "none"
I like desco's answer; one should always favor built-in constructs. But FWIW, here's what a workflow version might look like (if I understand the problem correctly):
type CE () =
member this.Bind (v,f) =
match v with
| Some(x) -> f x
| None -> None
member this.Return v = v
type A (p:A option) =
member this.P
with get() = p
let f (aIn:A option) = CE () {
let! a = aIn
let! b = a.P
let! c = b.P
return c.P }
let x = f (Some(A(None)))
let y = f (Some(A(Some(A(Some(A(Some(A(None)))))))))
printfn "Your breakpoint here."
I don't suggest this, but you can also solve it with exception handling:
try
<code that just keeps dotting into option.Value with impunity>
with
| :? System.NullReferenceException -> "None"
I just wanted to point out the rough equivalence of exception-handling to the Maybe/Either monads or Option.bind. Typically prefer one of them to throwing and catching exceptions.
Using Option.maybe from FSharpx:
open FSharpx
type Pet = { Name: string; PreviousOwner: option<string> }
type Person = { Name: string; Pet: option<Pet> }
let pers = { Name = "Bob"; Pet = Some {Name = "Mr Burns"; PreviousOwner = Some "Susan"} }
Option.maybe {
let! pet = pers.Pet
let! prevOwner = pet.PreviousOwner
do printfn "%s was the previous owner of %s." prevOwner pet.Name
}
Output:
Susan was the previous owner of Mr Burns.
But, e.g. with this person instead there is just no output:
let pers = { Name = "Bob"; Pet = None }

Working with Nullable<'T> in F#

I'm wondering what others have come up with for dealing with Nullable<'T> in F#. I want to use Nullable<'T> on data types so that serialization works properly (i.e., doesn't write out F# option type to XML). But, I don't want my code stuck dealing with the ugliness of dealing with Nullable<'T> directly. Any suggestions?
Is it better to use active patterns to match directly on Nullable, or just a converter to option and use Some/None matching?
Additionally, I'd love to hear ideas on dealing with nullable references in a nice manner too. If I use, say "string option", then I end up with the F# option type wrapping things. If I don't then I can't distinguish between truly optional strings and strings that shouldn't be null.
Any chance .NET 4 will take on an Option<'T> to help out? (If it's part of the BCL, then we might see better support for it...)
As active patterns as options plays nicely with pattern matching, but is seems by using active patterns (i.e. typeof and ??) your code will eat more ticks.
The base question is how you will deal with your nullable references?
In case your code is long chained computations it's nice to use monadic syntax:
type Maybe<'a> = (unit -> 'a option)
let succeed x : Maybe<'a> = fun () -> Some(x)
let fail : Maybe<'a> = fun () -> None
let run (a: Maybe<'a>) = a()
let bind p rest = match run p with None -> fail | Some r -> (rest r)
let delay f = fun () -> run (f ())
type MaybeBuilder() =
member this.Return(x) = succeed x
member this.Let(p,rest) = rest p
member this.Bind(p,rest) = bind p rest
member this.Delay(f) = delay f
let maybe = new MaybeBuilder()
let add (a:'a) (b:'a) =
maybe {
match TryGetNumericAssociation<'a>() with
| Some v -> return (v.Add(a,b))
| _ -> return! fail
}
let add3 (a:'a) (b:'a) (c:'a) =
maybe {
let! ab = add a b
let! abc = add ab c
return abc
}
> let r1 = add 1 2;;
val r1 : (unit -> int option)
> r1();;
val it : int option = Some 3
> let r2 = add "1" "2";;
val r2 : (unit -> string option)
> r2();;
val it : string option = None
> let r3 = add3 "one" "two" "three";;
val r3 : (unit -> string option)
> r3();;
val it : string option = None

Resources