How do I register my own FsCheck Generator on Expecto - f#

I've built my generator type that generates multiples of three. I want to use it in a test with Expecto. How can register this generator and tell my test to use it?
let multipleOfThree n = n * 3
type ThreeGenerator =
static member ThreeMultiple() =
Arb.generate<NonNegativeInt>
|> Gen.map (fun (NonNegativeInt n) -> multipleOfThree n)
|> Gen.filter (fun n -> n > 0)
|> Arb.fromGen

I've found answare my self. For register your generator in Expecto
let multipleOfThree =
{ FsCheckConfig.defaultConfig with
arbitrary = [ typeof<ThreeGenerator> ] }
And can use in your test
testPropertyWithConfig multipleOfThree "test with your generator "
<| fun x -> Expect.equal (FunctionUnderTest x) "Expected" "Error message"

Related

Dynamic functions in F#

I'm trying to explore the dynamic capabilities of F# for situations where I can't express some function with the static type system. As such, I'm trying to create a mapN function for (say) Option types, but I'm having trouble creating a function with a dynamic number of arguments. I've tried:
let mapN<'output> (f : obj) args =
let rec mapN' (state:obj) (args' : (obj option) list) =
match args' with
| Some x :: xs -> mapN' ((state :?> obj -> obj) x) xs
| None _ :: _ -> None
| [] -> state :?> 'output option
mapN' f args
let toObjOption (x : #obj option) =
Option.map (fun x -> x :> obj) x
let a = Some 5
let b = Some "hi"
let c = Some true
let ans = mapN<string> (fun x y z -> sprintf "%i %s %A" x y z) [a |> toObjOption; b |> toObjOption; c |> toObjOption]
(which takes the function passed in and applies one argument at a time) which compiles, but then at runtime I get the following:
System.InvalidCastException: Unable to cast object of type 'ans#47' to type
'Microsoft.FSharp.Core.FSharpFunc`2[System.Object,System.Object]'.
I realize that it would be more idiomatic to either create a computation expression for options, or to define map2 through map5 or so, but I specifically want to explore the dynamic capabilities of F# to see whether something like this would be possible.
Is this just a concept that can't be done in F#, or is there an approach that I'm missing?
I think you would only be able to take that approach with reflection.
However, there are other ways to solve the overall problem without having to go dynamic or use the other static options you mentioned. You can get a lot of the same convenience using Option.apply, which you need to define yourself (or take from a library). This code is stolen and adapted from F# for fun and profit:
module Option =
let apply fOpt xOpt =
match fOpt,xOpt with
| Some f, Some x -> Some (f x)
| _ -> None
let resultOption =
let (<*>) = Option.apply
Some (fun x y z -> sprintf "%i %s %A" x y z)
<*> Some 5
<*> Some "hi"
<*> Some true
To explain why your approach does not work, the problem is that you cannot cast a function of type int -> int (represented as FSharpFunc<int, int>) to a value of type obj -> obj (represented as FSharpFunc<obj, obj>). The types are the same generic types, but the cast fails because the generic parameters are different.
If you insert a lot of boxing and unboxing, then your function actually works, but this is probably not something you want to write:
let ans = mapN<string> (fun (x:obj) -> box (fun (y:obj) -> box (fun (z:obj) ->
box (Some(sprintf "%i %s %A" (unbox x) (unbox y) (unbox z))))))
[a |> toObjOption; b |> toObjOption; c |> toObjOption]
If you wanted to explore more options possible thanks to dynamic hacks - then you can probably do more using F# reflection. I would not typically use this in production (simple is better - I'd just define multiple map functions by hand or something like that), but the following runs:
let rec mapN<'R> f args =
match args with
| [] -> unbox<'R> f
| x::xs ->
let m = f.GetType().GetMethods() |> Seq.find (fun m ->
m.Name = "Invoke" && m.GetParameters().Length = 1)
mapN<'R> (m.Invoke(f, [| x |])) xs
mapN<obj> (fun a b c -> sprintf "%d %s %A" a b c) [box 1; box "hi"; box true]

How to create a dependency between observables?

I want a tool for testing Rx components that would work like this:
Given an order of the events specified as a 'v seq and a key selector function (keySelector :: 'v -> 'k) I want to create a Map<'k, IObservable<'k>> where the guarantee is that the groupped observables yield the values in the global order defined by the above enumerable.
For example:
makeObservables isEven [1;2;3;4;5;6]
...should produce
{ true : -2-4-6|,
false: 1-3-5| }
This is my attempt looks like this:
open System
open System.Reactive.Linq
open FSharp.Control.Reactive
let subscribeAfter (o1: IObservable<'a>) (o2 : IObservable<'b>) : IObservable<'b> =
fun (observer : IObserver<'b>) ->
let tempObserver = { new IObserver<'a> with
member this.OnNext x = ()
member this.OnError e = observer.OnError e
member this.OnCompleted () = o2 |> Observable.subscribeObserver observer |> ignore
}
o1.Subscribe tempObserver
|> Observable.Create
let makeObservables (keySelector : 'a -> 'k) (xs : 'a seq) : Map<'k, IObservable<'a>> =
let makeDependencies : ('k * IObservable<'a>) seq -> ('k * IObservable<'a>) seq =
let makeDep ((_, o1), (k2, o2)) = (k2, subscribeAfter o1 o2)
Seq.pairwise
>> Seq.map makeDep
let makeObservable x = (keySelector x, Observable.single x)
let firstItem =
Seq.head xs
|> makeObservable
|> Seq.singleton
let dependentObservables =
xs
|> Seq.map makeObservable
|> makeDependencies
dependentObservables
|> Seq.append firstItem
|> Seq.groupBy fst
|> Seq.map (fun (k, obs) -> (k, obs |> Seq.map snd |> Observable.concatSeq))
|> Map.ofSeq
[<EntryPoint>]
let main argv =
let isEven x = (x % 2 = 0)
let splits : Map<bool, IObservable<int>> =
[1;2;3;4;5]
|> makeObservables isEven
use subscription =
splits
|> Map.toSeq
|> Seq.map snd
|> Observable.mergeSeq
|> Observable.subscribe (printfn "%A")
Console.ReadKey() |> ignore
0 // return an integer exit code
...but the results are not as expected and the observed values are not in the global order.
Apparently the items in each group are yield correctly but when the groups are merged its more like a concat then a merge
The expected output is: 1 2 3 4 5
...but the actual output is 1 3 5 2 4
What am I doing wrong?
Thanks!
You describe wanting this:
{ true : -2-4-6|,
false: 1-3-5| }
But you're really creating this:
{ true : 246|,
false: 135| }
Since there's no time gaps between the items in the observables, the merge basically has a constant race condition. Rx guarantees that element 1 of a given sequence will fire before element 2, but Merge offers no guarantees around cases like this.
You need to introduce time gaps into your observables if you want Merge to be able to re-sequence in the original order.

How to get the AST of functions in a [<ReflectedDefinition>] tagged module?

[<ReflectedDefinition>]
module Foo =
let x = 5
let y () = 6
let z a = a
I tried to find out how to get the AST in this situation a couple of times now and keep failing. Time to ask the question here.
So far, I thought that a module would be mappped to a class with static members internally and as such, it should be the equivalent of:
[<ReflectedDefinition>]
type Foo =
static member x = 5
static member y () = 6
static member z a = a
let bar_members =
typeof<Bar>.GetMethods()
|> Array.filter (fun mi -> match mi with | MethodWithReflectedDefinition x -> true | _ -> false)
|> Array.map (fun m -> sprintf "%s: %A" (m.Name) (Expr.TryGetReflectedDefinition(m :> MethodBase) ) )
In the latter case, I could use typeof<Foo>.GetMembers() (or GetMethods()?!), cast it to Reflection.MethodBase and use this as an argument for Expr.TryGetReflectedDefinition().
But unfortunately, this is not working with the module version.
So, how to do it?
If you want to play with the code, you might want to open some namespaces:
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.DerivedPatterns
open Microsoft.FSharp.Reflection
open System.Reflection
The problem comes go down to actually getting the type of the Module. In order to do that, there's a great answer here by Phillip Trelford: https://stackoverflow.com/a/14706890/5438433
Basically, you add a helper value to your module which returns the type of that module:
[<ReflectedDefinition>]
module Foo =
type internal IMarker = interface end
let fooType = typeof<IMarker>.DeclaringType
let x = 5
let y () = 6
let z a = a
You can then use fooType to retrieve the reflected definitions.
let foo_members =
Foo.fooType.GetMethods()
|> Array.filter (fun mi -> match mi with | MethodWithReflectedDefinition x -> true | _ -> false)
|> Array.map (fun m -> sprintf "%s: %A" (m.Name) (Expr.TryGetReflectedDefinition(m :> MethodBase) ) )
I can then, e.g. print the results:
[|"get_fooType: Some PropertyGet (Some (Call (None, TypeOf, [])), DeclaringType, [])";
"get_x: Some Value (5)";
"y: Some Lambda (unitVar0, Value (6))";
"z: Some Lambda (a, a)"|]
For the use case, when the reflected definitions are in another assembly (like an F# dll, for example), you can do without the marker interface trick, as shown below:
open System
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.DerivedPatterns
open Microsoft.FSharp.Reflection
open System.Reflection
open FSharp.Reflection.FSharpReflectionExtensions
let tryGetReflectedModules (a : Assembly) : seq<TypeInfo> =
a.DefinedTypes
|> Seq.filter
(fun dt ->
dt.CustomAttributes
|> Seq.map (fun cad -> cad.AttributeType)
|> Seq.filter ((=) (typeof<ReflectedDefinitionAttribute>))
|> Seq.isEmpty
|> not
)
let astFromReflectedDefinition (mi : MethodInfo) : Expr option =
mi :> MethodBase |> Expr.TryGetReflectedDefinition
let reflectedMethodsOfAModule (m : System.Type) : (MethodInfo * Expr) [] =
m.GetMethods()
|> Array.map (fun m -> (m,astFromReflectedDefinition m))
|> Array.filter (snd >> Option.isSome)
|> Array.map (fun (x,y) -> (x, Option.get y))
let reflectAssembly (assemblyPath : string) =
let a = System.Reflection.Assembly.LoadFile(assemblyPath)
a
|> tryGetReflectedModules
|> Seq.map (fun x -> (x,reflectedMethodsOfAModule (x.AsType())))
Where, for example, the assembly I used for testing the code above looked like this:
namespace Input
[<ReflectedDefinition>]
module Api =
let trace s =
for _ in [0..3] do System.Diagnostics.Trace.WriteLine s
[<ReflectedDefinition>]
module Foo =
let foobar (x : string) : string =
x.ToUpper()
You get the top level types in the assembly, which just so happen to be the (static) classes, representing the modules of the Fsharp assembly and test for the ReflectedDefinitionAttribute presence. Then, you take it from there.

F# - Reverse Pipeline order

How come that I can do:
let printTeams x : unit =
let rnd = new Random()
Seq.toList x |> List.sortBy (fun x -> rnd.Next()) |> printTeams'
but not:
let printTeams x : unit =
let rnd = new Random()
printTeamsRec' <| Seq.toList x <| List.sortBy(fun x -> rnd.Next())
I'm just getting an error on the last one, which says:
Type mismatch. Expecting a string
list -> 'a -> 'b but given a
string list -> unit The type ''a
-> 'b' does not match the type 'unit'
The error occures on the third line at printTeamsRec'
Any help would be appreciate.
Two things: the translation of the forward pipe to backwards pipe is incorrect, and precedence is different.
let printTeams x : unit =
let rnd = new Random()
printTeamsRec' <| (List.sortBy(fun x -> rnd.Next()) <| Seq.toList x)

FsCheck NUnit . Tests with condition

I'm trying to make test for this function
let extract_one_rule (rule:Rule.t<'a,'b>) =
let rec expand = function
|PAlt (a,b) -> expand a # expand b
|PSeq (a,b) -> let wrap = List.map (fun x -> (x.rule, fun r -> {x with rule = r})) a
|> List.unzip
in
let rec gen = function
| hd::tl -> [for x in hd -> x :: ( gen tl |> List.concat)]
| [] -> []
in
fst wrap |> List.map expand |> gen
|> List.map (fun x -> PSeq ((List.map2 ( |> ) x (snd wrap)),b))
|PRef _
|PLiteral _
|PToken _ as t -> [t]
| _ -> (System.Console.WriteLine("incorrect tree for alternative expanding!")
; failwith "incorrect tree for alternative expanding!")
in
expand rule.body |> List.map (fun x -> {rule with body = x})
using FsCheck
so i have this
let ExpandAlterTest(t : Rule.t<Source.t,Source.t> ) = convertToMeta t |> List.forall (fun x -> ruleIsAfterEBNF x)
but i'l see exception "incorrect tree for alternative expanding!"
but when i use smth like that
let ExpandAlterTest(t : Rule.t<Source.t,Source.t> ) = (correctForAlExp t.body) ==> lazy ( convertToMeta t |> List.forall (fun x -> ruleIsAfterEBNF x))
NUnit doesn't stop working
Why it can be?
It could be that the precondition you added is very restrictive, so that it takes a long time before a good value (one that actually passes the precondition) is found. FsCheck is hardened against this - by default, it tries to find 100 values but when it has rejected 1000 it gives up and you should see a "Arguments exhausted after x tests" output. But this might take a long time, if generating and checking the value takes a long time.
Could also be that you actually have a bug somewhere, like an infinite loop.
Try changing the FsCheck config to run less tests, doing a verbose run (verboseCheck), and breaking in the debugger when it seems to hang.

Resources