let useConnection expr =
let Expr(conn : MySqlConnection) =
try
try
conn.Open()
with
| :? MySqlException as ex
-> printfn "Exception! %s" ex.Message
expr(conn)
finally
try
conn.Close() |> ignore
with
| :? MySqlException as ex
-> printfn "Exception! %s" ex.Message
using (new MySqlConnection(ConnectionString =
"server = " + MySQLServer + ";
uid = " + MySQLUID + ";
pwd = " + MySQLPW + ";
database = " + MySQLDB + ";
Charset=utf8;")) Expr
member x.reportToDB (msg:string) =
useConnection // <--- SO HERE I WANT TO KNOW WHAT IS conn
(let cmd = new MySqlCommand(Connection = conn)
cmd.CommandText <- ("insert into "+MySQLTable+"(system,dt,logMessage);")
ignore <| cmd.Parameters.AddWithValue("?system", Net.Dns.GetHostName())
ignore <| cmd.Parameters.AddWithValue("?dt", DateTime.Now.ToString() )
ignore <| cmd.Parameters.AddWithValue("?logMessage", msg )
try
try
cmd.ExecuteNonQuery() |> ignore
with
| :? MySqlException as ex when ex.Message.Contains("Duplicate entry")
-> printfn "MySQL Duplicate entry Exception: discarding the data set! %s" ex.Message
printfn ""
| :? MySqlException as ex
-> printfn "MySQL Exception, requeing data set and trying again later! %s" ex.Message
reraise()
with
| :? MySqlException as ex
-> printfn "Exception! %s" ex.Message)
It's hard to explain but I want to use delegate conn from useConnection to x.reportToDB , how can I do it ?
thank you.
#Tim Robinson , yes I don't know about conn there and that is a problem I want to solve,
why you think that lambda is bad idea here ?
useConnection appears to want a function that takes a MySqlConnection. It supplies this function with the connection object that you want.
The fix is:
useConnection (fun conn (* here's your connection *) ->
let cmd = new MySqlCommand(Connection = conn)
// etc.
Edit: It's maybe clearer with type annotations added to the useConnection function:
let useConnection (expr : MySqlConnection -> 'a) : 'a =
let Expr(conn : MySqlConnection) : 'a =
// etc.
Related
F# 6.0.3
I have seen some solutions on Google that are close to what I need; but being a Newbie I can't quite get how to use bind and map to get the solution.
I have many working procedures of the following format:
Example #1:
let saveAllDiagnosis =
let savealldiagnosis = match m.Encounter with
| None -> failwith "No encounter found"
| Some e -> match e.EncounterId with
| None -> failwith "No Encounter id found"
| Some id -> m.AllDiagnosisList
|> List.iter ( fun dx -> match dx.Key with
| None -> ()
| Some k -> Async.RunSynchronously (editAllDiagnosisInPreviousEncountersAsync id dx))
savealldiagnosis
Example #2
let saveEncounterDiagnosis =
let savedx = match m.Encounter with
| None -> failwith "No encounter found"
| Some e -> match e.EncounterId with
| None -> failwith "No Encounter id found"
| Some id -> m.BillingDiagnosisList |> List.iter ( fun dx -> Async.RunSynchronously (saveDxAsync id dx))
savedx
As can be seen, these are nested methods with almost identical behavior--differing only in the async procedure being called and the initializing list. What I would like to do is something along the lines of:
let runProcedures (fn: Model->Async) Model = ????
That is, a single procedue that encapsulates everything except the Async method and it's parameters but manages all the "None"s in a better way.
I hope my intent is clear.
TIA
If you are happy with using exceptions, then you do not even need railway-oriented programming (ROP). ROP is useful for more complex validation tasks, but I think exceptions are often perfectly reasonable and easy way of handling errors. In your case, you could define a helper that extracts a value of option<'T> or fails with a given error message:
let orFailWith msg opt =
match opt with
| Some v -> v
| None -> failwithf "%s" msg
Using this, you can then rewrite your code as follows:
let saveAllDiagnosis =
let e = m.Encounter |> orFailWith "No encounter found"
let id = e.EncounterId |> orFailWith "No Encounter id found"
for dx in m.AllDiagnosisList do
dx.Key |> Option.iter (fun k ->
editAllDiagnosisInPreviousEncountersAsync id dx |> Async.RunSynchronously)
let saveEncounterDiagnosis =
let e = m.Encounter |> orFailWith "No encounter found"
let id = e.EncounterId |> orFailWith "No Encounter id found"
for dx in m.BillingDiagnosisList do
saveDxAsync id dx |> Async.RunSynchronously
As I do not know the broader context of this, it is hard to say more - your code is imperative, but that may be perfectly fine if you are following the sandwich pattern.
Using mentioned ROP code can be rewritten as such. Result is used to track error and throw it at the end of pipeline. With current design is possible to avoid exceptions by just logging error instead of throwing at before last line.
type Encounter = { EncounterId : int option }
type Diagnostic = { Key : int option }
type Thing = {
Encounter : Encounter option
AllDiagnosisList : Diagnostic list
}
let editAllDiagnosisInPreviousEncountersAsync id diag = async { return () }
module Result =
let ofOption err opt =
match opt with
| Some v -> Ok v
| None -> Error err
let join res =
match res with
| Error v
| Ok v -> v
let saveAllDiagnosis m =
m.Encounter
|> Result.ofOption "No encounter found" // get value from option or log error
|> Result.map (fun e -> e.EncounterId)
|> Result.bind (Result.ofOption "No Encounter id found") // get EncounterId or log error
|> Result.map (fun id -> (
m.AllDiagnosisList
|> Seq.where (fun dx -> dx.Key.IsSome)
|> Seq.iter (fun dx -> Async.RunSynchronously (editAllDiagnosisInPreviousEncountersAsync id dx))
))
|> Result.mapError failwith // throw error
|> Result.join // Convert Result<unit, unit> into unit
The solutions posted above are very helpful to this newbie. But adding my own two cents worth, I going with this:
let _deleteDxFromEncounterAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = deleteDxFromEncounterAsync encounterId dx.Description
let _deleteDxFromAllPreviousEncountersAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = deleteDxFromAllPreviousEncountersAsync encounterId dx.Description
let _saveDxAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = saveDxAsync encounterId dx
let _editAllDiagnosisInPreviousEncountersAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = editAllDiagnosisInPreviousEncountersAsync encounterId dx
let listchk (dxs:Diagnosis list) : Diagnosis list option =
match dxs with
| [] -> None
| _ -> Some dxs
let _save (fn:int -> Diagnosis-> Async<unit>) (dxs:Diagnosis list) : unit =
match dxs |> listchk, m.Encounter |> Option.bind (fun v -> v.EncounterId) with
| Some dxs, Some id -> dxs |> List.iter (fun dx -> Async.RunSynchronously(fn id dx))
| _,_ -> failwith "Missing Encounter or EncounterId or Empty List"
m.DeletedBillingDiagnosis |>_save _deleteDxFromEncounterAsync
m.DeletedAllDiagnosis |>_save _deleteDxFromAllPreviousEncountersAsync
m.BillingDiagnosisList |>_save _saveDxAsync
m.AllDiagnosisList |> List.filter (fun dx -> dx.Key.IsSome) |>_save _editAllDiagnosisInPreviousEncountersAsync
For speed, in the future, I will probably have the Async functions act on the entire list at one time rather then one item; but for now, this code comes closest to my intent in asking the question. IMPROVEMENTS AND CRITISM IS GLADDLY APPRECIATED! F# is fun!
Thanks to all.
When I have a runtime error like this one
type Msg = Any
type Agent() =
let agent =
MailboxProcessor.Start(fun inbox ->
let rec messageLoop (oldState) =
async {
let! msg = inbox.Receive()
printfn "1"
match msg with
| Any ->
printfn "2"
let neverFound=
oldState
|> List.find (fun x -> x = 42)
printfn "3" // <- never happens, because I tried to find something that does not exists
return! messageLoop (oldState # [neverFound])
}
printfn "0"
messageLoop ([ 1; 2; 3 ]))
member __.Post a = agent.Post a
let agent = Agent()
agent.Post ( Any)
it doest crash, the error is completely silent, but if I do explicitly try .. with:
type Msg = Any
type Agent() =
let agent =
MailboxProcessor.Start(fun inbox ->
let rec messageLoop (oldState) =
async {
let! msg = inbox.Receive()
printfn "1"
match msg with
| Any ->
printfn "2"
try
let neverFound=
oldState
|> List.find (fun x -> x = 42)
printfn "3"
return! messageLoop (oldState # [neverFound])
with e ->
printfn "%A" e <-- does print
printfn "4"
}
printfn "0"
messageLoop ([ 1; 2; 3 ]))
member __.Post a = agent.Post a
let agent = Agent()
agent.Post ( Any)
if does catches the error.
This is not the only place this happens, apparently, errors that happen inside async are silent? How can I prevent this? Is there a flag one can run with no silent errors? or maybe a global async error handler?
This is by design. You don't expect actors to crash on receiving a message.
Start is essentially:
Async.Start(async { try do! body x with exn -> trigger exn })
So if you expose MailboxProcessor.Error with
member _.Error = agent.Error
and listen to it:
agent.Error
|> Observable.subscribe(fun (err) -> printfn "Oh no, an error: %s" err.Message)
|> ignore
you will indeed see:
Oh no, an error: An index satisfying the predicate was not found in the collection.
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
I have the following code. And I want to run without blocking the main thread.
let post () = .....
try
let response = post ()
logger.Info(response.ToString())
with
| ex -> logger.Error(ex, "Exception: " + ex.Message)
So I changed the code to the following. However, how to catch the exception in post?
let post = async {
....
return X }
try
let response = post |> Async.StartChild
logger.Info(response.ToString())
with
| ex -> logger.Error(ex, "Exception: " + ex.Message)
One way is to use Async.Catch in a calling workflow. Given a couple of functions (a throwaway "async" function and something to work with the result):
let work a = async {
return
match a with
| 1 -> "Success!"
| _ -> failwith "Darnit"
}
let printResult (res:Choice<'a,System.Exception>) =
match res with
| Choice1Of2 a -> printfn "%A" a
| Choice2Of2 e -> printfn "Exception: %s" e.Message
One can use Async.Catch
let callingWorkflow =
async {
let result = work 1 |> Async.Catch
let result2 = work 0 |> Async.Catch
[ result; result2 ]
|> Async.Parallel
|> Async.RunSynchronously
|> Array.iter printResult
}
callingWorkflow |> Async.RunSynchronously
Async.Catch returns a Choice<'T1,'T2>. Choice1Of2 for a successful execution, and the exception thrown for the Choice2Of2.
You'd put the try/catch in an async block as well
let post = async { .... }
async {
try
let! response = post
logger.Info(response.ToString())
with
| ex -> logger.Error(ex, "Exception: " + ex.Message)
} |> Async.Start
Is there a way to use F#'s sprintf float formating with a decimal comma? It would be nice if this worked:
sprintf "%,1f" 23.456
// expected: "23,456"
Or can I only use String.Format Method (IFormatProvider, String, Object()) ?
EDIT: I would like to have a comma not a point as a decimal separator. Like most non-English speaking countries use it.
It's quite a pain, but you can write your own version of sprintf that does exactly what you want:
open System
open System.Text.RegularExpressions
open System.Linq.Expressions
let printfRegex = Regex(#"^(?<text>[^%]*)((?<placeholder>%(%|((0|-|\+| )?([0-9]+)?(\.[0-9]+)?b|c|s|d|i|u|x|X|o|e|E|f|F|g|G|M|O|A|\+A|a|t)))(?<text>[^%]*))*$", RegexOptions.ExplicitCapture ||| RegexOptions.Compiled)
type PrintfExpr =
| K of Expression
| F of ParameterExpression * Expression
let sprintf' (c:System.Globalization.CultureInfo) (f:Printf.StringFormat<'a>) : 'a =
//'a has form 't1 -> 't2 -> ... -> string
let cultureExpr = Expression.Constant(c) :> Expression
let m = printfRegex.Match(f.Value)
let prefix = m.Groups.["text"].Captures.[0].Value
let inputTypes =
let rec loop t =
if Reflection.FSharpType.IsFunction t then
let dom, rng = Reflection.FSharpType.GetFunctionElements t
dom :: loop rng
else
if t <> typeof<string> then
failwithf "Unexpected return type: %A" t
[]
ref(loop typeof<'a>)
let pop() =
let (t::ts) = !inputTypes
inputTypes := ts
t
let exprs =
K(Expression.Constant(prefix)) ::
[for i in 0 .. m.Groups.["placeholder"].Captures.Count - 1 do
let ph = m.Groups.["placeholder"].Captures.[i].Value
let text = m.Groups.["text"].Captures.[i+1].Value
// TODO: handle flags, width, precision, other placeholder types, etc.
if ph = "%%" then yield K(Expression.Constant("%" + text))
else
match ph with
| "%f" ->
let t = pop()
if t <> typeof<float> && t <> typeof<float32> then
failwithf "Unexpected type for %%f placeholder: %A" t
let e = Expression.Variable t
yield F(e, Expression.Call(e, t.GetMethod("ToString", [| typeof<System.Globalization.CultureInfo> |]), [cultureExpr]))
| "%s" ->
let t = pop()
if t <> typeof<string> then
failwithf "Unexpected type for %%s placeholder: %A" t
let e = Expression.Variable t
yield F(e, e)
| _ ->
failwithf "unhandled placeholder: %s" ph
yield K (Expression.Constant text)]
let innerExpr =
Expression.Call(typeof<string>.GetMethod("Concat", [|typeof<string[]>|]), Expression.NewArrayInit(typeof<string>, exprs |> Seq.map (fun (K e | F(_,e)) -> e)))
:> Expression
let funcConvert =
typeof<FuncConvert>.GetMethods()
|> Seq.find (fun mi -> mi.Name = "ToFSharpFunc" && mi.GetParameters().[0].ParameterType.GetGenericTypeDefinition() = typedefof<Converter<_,_>>)
let body =
List.foldBack (fun pe (e:Expression) ->
match pe with
| K _ -> e
| F(p,_) ->
let m = funcConvert.MakeGenericMethod(p.Type, e.Type)
Expression.Call(m, Expression.Lambda(m.GetParameters().[0].ParameterType, e, p))
:> Expression) exprs innerExpr
Expression.Lambda(body, [||]).Compile().DynamicInvoke() :?> 'a
sprintf' (Globalization.CultureInfo.GetCultureInfo "fr-FR") "%s %f > %f" "It worked!" 1.5f -12.3
Taking a look at source code of Printf module, it uses invariantCulture. I don't think printf-like functions are culture aware.
If you always need a comma, you could use sprintf and string.Replace function. If your code is culture-dependent, using ToString or String.Format is your best bet.