I want to make a module which helps to execute SQL query from F#. I unable to use System.Data.SqlClient and getting error.
module SQL_Helper
open System.Data.SqlClient
type SqlHelper (connection) =
let exec bind parametres query =
use conn = new SqlConnection (connection)
conn.Open()
use cmd = new SqlCommand (query, conn)
parametres |> List.iteri (fun i p ->
cmd.Parameters.AddWithValue(sprintf "#p%d" i, box p) |> ignore)
bind cmd
member __.Execute = exec <| fun c -> c.ExecuteNonQuery() |> ignore
member __.Scalar = exec <| fun c -> c.ExecuteScalar()
member __.Read f = exec <| fun c -> [ let read = c.ExecuteReader()
while read.Read() do
yield f read ]
Related
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"
I am looking to build a computation expression where I can express the following:
let x = someComputationExpression {
do! "Message 1"
printfn "something 1"
do! "Message 2"
printfn "something 2"
do! "Message 3"
printfn "something 3"
let lastValue = 4
do! "Message 4"
// need to reference values across `do!`
printfn "something %s" lastValue
}
and be able to take from x a list:
[| "Message 1"
"Message 2"
"Message 3"
"Message 4" |]
without printfn ever getting called, but with the ability to later execute it (if that makes sense).
It doesn't need to be with the do! keyword, it could be yield or return, whatever is required for it to work.
To put it another way, I want to be able to collect some state in a computation express, and queue up work (the printfns) that can be executed later.
I have tried a few things, but am not sure it's possible.
It's a bit hard to figure out a precise solution from the OP question. Instead I am going to post some code that the OP perhaps can adjust to the needs.
I define Result and ResultGenerator
type Result =
| Direct of string
| Delayed of (unit -> unit)
type ResultGenerator<'T> = G of (Result list -> 'T*Result list )
The generator produces a value and a list of direct and delayed values, the direct values are the string list above but intermingled with them are the delayed values. I like returning intermingled so that the ordering is preserved.
Note this is a version of what is sometimes called a State monad.
Apart from the class CE components like bind and Builders I created two functions direct and delayed.
direct is used to create a direct value and delayed a delayed one (takes a function)
let direct v : ResultGenerator<_> =
G <| fun rs ->
(), Direct v::rs
let delayed d : ResultGenerator<_> =
G <| fun rs ->
(), Delayed d::rs
To improve the readability I defined delayed trace functions:
let trace m : ResultGenerator<_> =
G <| fun rs ->
(), Delayed (fun () -> printfn "%s" m)::rs
let tracef fmt = kprintf trace fmt
From an example generator:
let test =
builder {
do! direct "Hello"
do! tracef "A trace:%s" "!"
do! direct "There"
return 123
}
The following result was achieved:
(123, [Direct "Hello"; Delayed <fun:trace#37-1>; Direct "There"])
(Delayed will print the trace when executed).
Hope this can give some ideas on how to attack the actual problem.
Full source:
open FStharp.Core.Printf
type Result =
| Direct of string
| Delayed of (unit -> unit)
type ResultGenerator<'T> = G of (Result list -> 'T*Result list )
let value v : ResultGenerator<_> =
G <| fun rs ->
v, rs
let bind (G t) uf : ResultGenerator<_> =
G <| fun rs ->
let tv, trs = t rs
let (G u) = uf tv
u trs
let combine (G t) (G u) : ResultGenerator<_> =
G <| fun rs ->
let _, trs = t rs
u trs
let direct v : ResultGenerator<_> =
G <| fun rs ->
(), Direct v::rs
let delayed d : ResultGenerator<_> =
G <| fun rs ->
(), Delayed d::rs
let trace m : ResultGenerator<_> =
G <| fun rs ->
(), Delayed (fun () -> printfn "%s" m)::rs
let tracef fmt = kprintf trace fmt
type Builder() =
class
member x.Bind (t, uf) = bind t uf
member x.Combine (t, u) = combine t u
member x.Return v = value v
member x.ReturnFrom t = t : ResultGenerator<_>
end
let run (G t) =
let v, rs = t []
v, List.rev rs
let builder = Builder ()
let test =
builder {
do! direct "Hello"
do! tracef "A trace:%s" "!"
do! direct "There"
return 123
}
[<EntryPoint>]
let main argv =
run test |> printfn "%A"
0
With Suave 2.4.0 supporting TransferEncoding.chunked and HttpOutput.writeChunk I have written the below code to stream out data over HTTP.
let sendStrings getStringsFromProducer : WebPart =
Writers.setStatus HTTP_200 >=>
TransferEncoding.chunked (fun conn -> socket {
let refConn = ref conn
for str in getStringsFromProducer do
let! (_, conn) = (str |> stringToBytes |> HttpOutput.writeChunk) !refConn
refConn := conn
return! HttpOutput.writeChunk [||] !refConn
}
)
While this works, I question the reliability of using ref and hoping there are better way out there to do the same in a more functional manner. Are there better way to do this? Assuming I cannot change getStringsFromProducer?
I think you cannot avoid all mutation in this case - writing chunks one by one is a fairly imperative operation and iterating over a lazy sequence also requires (mutable) iterator, so there is no way to avoid all mutation. I think your sendStrings function does a nice job at hiding the mutation from the consumer and provides a nice functional API.
You can avoid using ref cells and replace them with local mutable variable, which is a bit safer - because the mutable variable cannot escape the local scope:
TransferEncoding.chunked (fun conn -> socket {
let mutable conn = conn
for str in getStringsFromProducer do
let! _, newConn = HttpOutput.writeChunk (stringToBytes str) conn
conn <- newConn
return! HttpOutput.writeChunk [||] conn
}
You could avoid the mutable conn variable by using recursion, but this requires you to work with IEnumerator<'T> rather than using a nice for loop to iterate over the sequence, so I think this is actually less nice than the version using a mutable variable:
TransferEncoding.chunked (fun conn -> socket {
let en = getStringsFromProducer.GetEnumerator()
let rec loop conn = socket {
if en.MoveNext() then
let! _, conn = HttpOutput.writeChunk (stringToBytes en.Current) conn
return! loop conn }
do! loop conn
return! HttpOutput.writeChunk [||] conn })
I was looking for a way to replace refs/mutables in F# in a general way, and while I came up with a solution, it might be overkill in your case. It looks like the ref is a local that is only updated from within a single thread, so it's probably fairly safe. However, if you want to replace it, here's how I solved the problem:
type private StateMessage<'a> =
| Get of AsyncReplyChannel<'a>
| GetOrSet of 'a * AsyncReplyChannel<'a>
| GetOrSetResult of (unit -> 'a) * AsyncReplyChannel<'a>
| Set of 'a
| Update of ('a -> 'a) * AsyncReplyChannel<'a>
type Stateful<'a>(?initialValue: 'a) =
let agent = MailboxProcessor<StateMessage<'a>>.Start
<| fun inbox ->
let rec loop state =
async {
let! message = inbox.Receive()
match message with
| Get channel ->
match state with
| Some value -> channel.Reply(value)
| None -> channel.Reply(Unchecked.defaultof<'a>)
return! loop state
| GetOrSet (newValue, channel) ->
match state with
| Some value ->
channel.Reply(value)
return! loop state
| None ->
channel.Reply(newValue)
return! loop (Some newValue)
| GetOrSetResult (getValue, channel) ->
match state with
| Some value ->
channel.Reply(value)
return! loop state
| None ->
let newValue = getValue ()
channel.Reply(newValue)
return! loop (Some newValue)
| Set value ->
return! loop (Some value)
| Update (update, channel) ->
let currentValue =
match state with
| Some value -> value
| None -> Unchecked.defaultof<'a>
let newValue = update currentValue
channel.Reply(newValue)
return! loop (Some newValue)
}
loop initialValue
let get () = agent.PostAndReply Get
let asyncGet () = agent.PostAndAsyncReply Get
let getOrSet value = agent.PostAndReply <| fun reply -> GetOrSet (value, reply)
let asyncGetOrSet value = agent.PostAndAsyncReply <| fun reply -> GetOrSet (value, reply)
let getOrSetResult getValue = agent.PostAndReply <| fun reply -> GetOrSetResult (getValue, reply)
let asyncGetOrSetResult getValue = agent.PostAndAsyncReply <| fun reply -> GetOrSetResult (getValue, reply)
let set value = agent.Post <| Set value
let update f = agent.PostAndReply <| fun reply -> Update (f, reply)
let asyncUpdate f = agent.PostAndAsyncReply <| fun reply -> Update (f, reply)
member __.Get () = get ()
member __.AsyncGet () = asyncGet ()
member __.GetOrSet value = getOrSet value
member __.AsyncGetOrSet value = asyncGetOrSet value
member __.GetOrSetResult getValue = getOrSetResult getValue
member __.AsyncGetOrSetResult getValue = asyncGetOrSetResult getValue
member __.Set value = set value
member __.Update f = update f
member __.AsyncUpdate f = asyncUpdate f
This basically uses a MailboxProcessor to serialize updates to state that's managed by a tail-recursive function, similar to Tomas' second example. However, this allows you to call Get/Set/Update in a way that's more like traditional mutable state, even though it's not actually doing mutation. You can use it like this:
let state = Stateful(0)
state.Get() |> printfn "%d"
state.Set(1)
state.Get() |> printfn "%d"
state.Update(fun x -> x + 1) |> printfn "%d"
This will print:
0
1
2
[<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.
I'm working on some DSL for my application and here's how I defined computation type and builder:
// expression type
type Action<'a,'b> = Action of ('a -> Async<'b>)
let runAction (Action r) ctx = r ctx
let returnF a = Action (fun _ -> async {return a})
let bind m f = Action (fun r -> async {
let! a = runAction m r in return! runAction (f a) r
})
let bindA ac f = Action (fun r -> async {
let! a = ac in return! runAction (f a) r
})
type ActionBuilder<'x>() =
member this.Return(c) = returnF c
member this.Zero() = returnF ()
member this.Delay(f) = bind (returnF ()) f
// binds both monadic and for async computations
member this.Bind(m, f) = bind m f
member this.Bind(m, f) = bindA m f
member this.Combine(r1, r2) = bind r1 (fun () -> r2)
member this.For(s:seq<_>, f) = Action (fun x -> async {
for i in s do runAction (f i) x |> ignore
})
// here's the attempt to implement 'need' operations
[<CustomOperation("need")>]
member this.Need(Action a, targets: string list) =
Action (fun x ->
let r = a x
printfn "need(%A, [%A])" a targets
r)
member this.For(a, f) = bindA a f
member this.Yield(()) =
returnF ()
let action = ActionBuilder<string>()
/////////////////////////////////////////////////////////////
// other functions for Action
/// Gets action context
let getCtx = Action (fun ctx -> async {return ctx})
let needFn res = action {
let! ctx = getCtx
printfn "need([%A]) in %A" res ctx
}
The resulting code is supposed to be:
let program1 = fun filename -> action {
let! a = async {return 123}
let f = a+1
// need ["def"; "dd"]
do! needFn ["def"; "dd"]
printfn "after need"
for i in [0..10] do
do! Async.Sleep (1)
printfn "i: %A" i
let! d = async {return f}
let! ctx = getCtx
printfn "ctx: %A, %A" ctx f
}
Async.RunSynchronously(runAction (program1 "m.c") "abc")
Now I would like to change do! needFn ["def"; "dd"] syntax to a nicer one by defining "need" custom operation, but getting various complains from compiler. Is it correct approach or I'm misusing the computation expressions?
The other issue is that for does not work if do! is used inside loop body.
After reading papers, by trial and error method I came to the following for implementation (Yield builder method is not required):
let forF (e: seq<_>) prog =
usingF (e.GetEnumerator()) (fun e ->
whileF
(fun () -> e.MoveNext())
((fun () -> prog e.Current) |> delayF)
)
Full source code for computation expression builder could be found in the target project. The whole project is a variation of Fake build system.
Note: Action was renamed to Recipe. need operator cannot be implemented at all.