The following code sample is from Scott Wlaschin's site F# for fun and profit.
type LoggingBuilder() =
let log p = printfn "expression is %A" p
member this.Bind(x, f) =
log x
f x
member this.Return(x) =
x
let logger = new LoggingBuilder()
let loggedWorkflow =
logger
{
let! x = 42
let! y = 43
let! z = x + y
return z
}
Is there a way to inject a function instead of printfn into the LoggingBuilder()?
You can just add a parameter to the builder type:
type LoggingBuilder(lf: obj -> unit) =
let log p = lf p
member this.Bind(x, f) =
log x
f x
member this.Return(x) =
x
let logger = new LoggingBuilder(printfn "expression is %A")
You could make the builder generic if you want to make the input type more specific than obj e.g.
type LoggingBuilder<'a>(lf: 'a -> unit) =
...
let logger = new LoggingBuilder<int>(printfn "Got %i")
If your intention is to replace printfn with a logger such as NLog, you can use Printf.ksprintf.
open NLog
open NLog.Config
open NLog.Targets
let private logger =
let config = new LoggingConfiguration()
let consoleTarget = new ColoredConsoleTarget()
config.AddTarget("console", consoleTarget)
consoleTarget.Layout <- Layouts.SimpleLayout.FromString
#"${longdate}|${level:uppercase=true}|${logger}|${message}"
let rule = new LoggingRule("*", LogLevel.Debug, consoleTarget)
config.LoggingRules.Add rule
LogManager.Configuration <- config
LogManager.GetLogger "MyLogger"
type LoggingBuilder(lf: string -> unit) =
let log format =
let doAfter (s: string) = lf s
Printf.ksprintf doAfter format
member this.Bind(x, f) =
log "%A" x
f x
member this.Return(x) =
x
let logger = new LoggingBuilder(logger.Info)
Related
I'm trying to build a type provider for Bloomberg (they provide schema xml files that describe the types). I'm able to generate types that look like the following class:
type Example(x: option<int>) as self =
[<DefaultValue>] val mutable X: option<int>
do
self.X <- x
member this.GetX with get() = self.X
The problem is that this requires you to instantiate the example type as follows:
Example(Some 1)
Ideally I would prefer to instantiate it as like the XmlProvider choice type:
type Example(x: int) as self =
[<DefaultValue>] val mutable X: option<int>
do
self.X <- Some x
member this.GetX with get() = self.X
let example = Example(1)
When I attempt doing this:
let some =
FSharpType.GetUnionCases(field.FieldType)
|> Array.filter (fun x -> x.Name = "Some")
|> Array.exactlyOne
let arg' = Expr.NewUnionCase(some, arg)
let setValue = Expr.FieldSet(this, field, arg')
I get the following error:
"Specified method is not supported."
I can successfully generate the first type using this:'
let setValue = Expr.FieldSet(this, field, arg)
The full source code is available here: https://github.com/alphaarchitect/BloombergProvider/blob/main/src/BloombergProvider.DesignTime/BloombergProvider.DesignTime.fs#L457
Any ideas?
///Edit
The entire code block is from this:
es
|> Result.mapError (fun xs -> ChoiceError.Element(c.Name, xs))
|> Result.map (fun xs ->
xs
|> List.iter (fun (_, field) ->
let parameter = ProvidedParameter(field.Name, field.FieldType)
providedChoiceType.AddMember
<| ProvidedConstructor(
[parameter],
invokeCode =
fun args ->
match args with
| this :: [arg] ->
let setValue = Expr.FieldSet(this, field, arg)
let enumField = Expr.FieldSet(this, enumField, Expr.FieldGet(enum.GetField(field.Name)))
Expr.Sequential(enumField, setValue)
| _ -> failwith "wrong ctor parameters"))
{
Enum = enum
Object = providedChoiceType
}))
to this:
es
|> Result.mapError (fun xs -> ChoiceError.Element(c.Name, xs))
|> Result.map (fun xs ->
xs
|> List.iter (fun (type', field) ->
let parameter = ProvidedParameter(field.Name, type')
providedChoiceType.AddMember
<| ProvidedConstructor(
[parameter],
invokeCode =
fun args ->
match args with
| this :: [arg] ->
let some =
FSharpType.GetUnionCases(field.FieldType)
|> Array.filter (fun x -> x.Name = "Some")
|> Array.exactlyOne
let arg' = Expr.NewUnionCase(some, arg)
let setValue = Expr.FieldSet(this, field, arg')
let enumField = Expr.FieldSet(this, enumField, Expr.FieldGet(enum.GetField(field.Name)))
Expr.Sequential(enumField, setValue)
| _ -> failwith "wrong ctor parameters"))
{
Enum = enum
Object = providedChoiceType
}))
The error occurs when you try to instantiate the type provider.
Running and evaluating the code works correctly in the quotation evaluator.
This is not a direct answer to the question, but it may help you if you cannot figure out how to get this to work. In general, I think that building type providers is easier if you do not try to do a "lot of coding" in the provided methods and constructors.
In your approach, you have a type that inherits from obj and so you have to generate a lot of code to store data in fields. In contrast, the JSON provider types inherit from JsonValue which does all the storing for them - so they have to do relatively little. For example, say you want to generate something like:
type Example(x: int, y:string) as self =
[<DefaultValue>] val mutable X: option<int>
[<DefaultValue>] val mutable Y: option<string>
do
self.X <- Some x
self.Y <- Some y
member this.GetX = self.X
member this.GetY = self.Y
It may be easier to define a base class which is essentially a dictionary an then generate a class inheriting from this:
type DataClass() =
let d = System.Collections.Generic.Dictionary<_, _>()
member x.SetSome(s, v) = d.[s] <- Some v
member x.Get<'T>(s) = d.[s] |> Option.map (fun v -> unbox<'T> v)
type Example(x: int, y:string) =
inherit DataClass()
do
base.SetSome("x", box x)
base.SetSome("y", box y)
member this.GetX = base.Get<int>("x")
member this.GetY = base.Get<string>("y")
This way, the only kind of provided code that you have to write is method calls, which is generally easier to do - and possibly less error-prone.
type Identity<'T> = Identity of 'T
type IdentityBuilder() =
member __.Bind (Identity x) (k : 'a -> Identity<'b>) = k x
member __.Return x = Identity x
let identity = new IdentityBuilder()
let three = Identity 3
let four = Identity 4
let twelve =
identity.Bind three <| fun t ->
identity.Bind four <| fun f ->
identity.Return (t * f)
let twelve2 = identity {
let! t = three
let! f = four
return t * f
}
twelve does not introduce any problem, but twelve2 gives
FS0001: This expression was expected to have type
'Identity<'a>' but here has type
''b * 'c'
on the line let! t = three.
I thought twelve and twelve2 should be equivalent... Was I mistaken?
As noted in the comment by Szer, you need to use tupled parameters for the Computation Builder methods. However, it is often convenient to use the curried versions for pipelining, as in your example. Therefore, what I usually do is create a module that contains all the functions required for the Computation Builder in curried form, and then use them in the builder itself. That way I can use either the computation expression syntax or the pipelining syntax depending on the scenario.
In your case, that would look something like this:
type Identity<'T> = Identity of 'T
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Identity =
let bind (f: 'T -> Identity<'U>) (Identity x) = f x
let create x = Identity x
type IdentityBuilder() =
member __.Bind (x, f) = Identity.bind f x
member __.Return x = Identity.create x
let identity = new IdentityBuilder()
let three = Identity 3
let four = Identity 4
let twelve =
three |> Identity.bind (fun t ->
four |> Identity.bind (fun f ->
Identity.create (t * f)))
let twelve2 = identity {
let! t = three
let! f = four
return t * f
}
Another common practice is to define an operator >>= for the bind function so that you can streamline the syntax even more:
let (>>=) f x = Identity.bind x f
let twelve3 = three >>= (fun t -> four >>= (fun f -> Identity.create (t * f)))
I'm trying to write a computational workflow which would allow a computation which can produce side effects like log or sleep and a return value
A usage example would be something like this
let add x y =
compute {
do! log (sprintf "add: x = %d, y= %d" x y)
do! sleep 1000
let r = x + y
do! log (sprintf "add: result= %d" r)
return r
}
...
let result = run (add 100 1000)
and I would like the side effects to be produced when executeComputation is called.
My attempt is
type Effect =
| Log of string
| Sleep of int
type Computation<'t> = Computation of Lazy<'t * Effect list>
let private bind (u : 'u, effs : Effect list)
(f : 'u -> 'v * Effect list)
: ('v * Effect list) =
let v, newEffs = f u
let allEffects = List.append effs newEffs
v, allEffects
type ComputeBuilder() =
member this.Zero() = lazy ((), [])
member this.Return(x) = x, []
member this.ReturnFrom(Computation f) = f.Force()
member this.Bind(x, f) = bind x f
member this.Delay(funcToDelay) = funcToDelay
member this.Run(funcToRun) = Computation (lazy funcToRun())
let compute = new ComputeBuilder()
let log msg = (), [Log msg]
let sleep ms = (), [Sleep ms]
let run (Computation x) = x.Force()
...but the compiler complains about the let! lines in the following code:
let x =
compute {
let! a = add 10 20
let! b = add 11 2000
return a + b
}
Error FS0001: This expression was expected to have type
'a * Effect list
but here has type
Computation<'b> (FS0001)
Any suggestions?
The main thing that is not right with your definition is that some of the members of the computation builder use your Computation<'T> type and some of the other members use directly a pair of value and list of effects.
To make it type check, you need to be consistent. The following version uses Computation<'T> everywhere - have a look at the type signature of Bind, for example:
let private bind (Computation c) f : Computation<_> =
Computation(Lazy.Create(fun () ->
let u, effs = c.Value
let (Computation(c2)) = f u
let v, newEffs = c2.Value
let allEffects = List.append effs newEffs
v, allEffects))
type ComputeBuilder() =
member this.Zero() = Computation(lazy ((), []))
member this.Return(x) = Computation(lazy (x, []))
member this.ReturnFrom(c) = c
member this.Bind(x, f) = bind x f
member this.Delay(funcToDelay:_ -> Computation<_>) =
Computation(Lazy.Create(fun () ->
let (Computation(r)) = funcToDelay()
r.Value))
Here is a very simple class with static property:
[<AbstractClass; Sealed>]
type test () =
static member ttc = (new Random()).Next()
When I access ttc, it always changes... like this: (in fsi.exe)
What is my purpose is to store values in static member:
type typDimTablesArray () =
static member DimApplication = typDimTables.DimApplication |> Seq.toArray
static member DimApplicationState = typDimTables.DimApplicationState |> Seq.toArray
static member DimDatetime = typDimTables.DimDatetime |> Seq.toArray
static member DimDbQuery = typDimTables.DimDbQuery |> Seq.toArray
static member DimDeveloper = typDimTables.DimDeveloper |> Seq.toArray
static member DimPlatform = typDimTables.DimPlatform |> Seq.toArray
But each time I access typDimTablesArray.DimDatetime.Length
It just query the database again and never store the data in the static member...
Here's a short example of the differences:
type Test3() =
let random = new System.Random()
let y = random.Next()
member __.X = random.Next()
member __.Y = y
static member val Z = (new Random()).Next()
let x = Test3()
x.X
x.X
x.Y
x.Y
Test3.Z
Test3.Z
Also, you could just create an instance of your type and pass in whatever object you need to work on. Now if it's something lazy you might need to cache it:
let rnd = new System.Random()
let rnds = Seq.init 10 (fun _ -> rnd.Next())
type Test4(rndsX:int seq) =
let xx = rndsX |> Seq.cache
member __.Length = xx |> Seq.toArray |> Seq.length
member __.First = xx |> Seq.head
member __.Last = xx |> Seq.last
(Having failed to 'grok' FParsec, I followed the advice I read somewhere and started trying to write a little parser myself. Somehow I spotted what looked like a chance to try and monadify it, and now I have N problems...)
This is my 'Result' type (simplified)
type Result<'a> =
| Success of 'a
| Failure of string
Here's the computation expression builder
type ResultBuilder() =
member m.Return a = Success(a)
member m.Bind(r,fn) =
match r with
| Success(a) -> fn a
| Failure(m) -> Failure(m)
In this first example, everything works (compiles) as expected:
module Parser =
let res = ResultBuilder()
let Combine p1 p2 fn =
fun a -> res { let! x = p1 a
let! y = p2 a
return fn(x,y) }
My problem is here: I'd like to be able to catch any failure in the 'combining' function and return a failure, but it says that I should define a 'Zero'.
let Combine2 p1 p2 fn =
fun a -> res { let! x = p1 a
let! y = p2 a
try
return fn(x,y)
with
| ex -> Failure(ex.Message) }
Having no idea what I should return in a Zero, I just threw in member m.Zero() = Failure("hello world"), and it now says I need TryWith.
So:
member m.TryWith(r,fn) =
try
r()
with
| ex -> fn ex
And now it wants Delay, so member m.Delay f = (fun () -> f()).
At which point it says (on the ex -> Failure), This expression should have type 'unit', but has type 'Result<'a>', and I throw up my arms and turn to you guys...
Link for playing: http://dotnetfiddle.net/Ho1sGS
The with block should also return a result from the computation expression. Since you want to return Result.Failure you need to define the member m.ReturnFrom a = a and use it to return the Failure from the with block. In the try block you should also specify that fn returns Success if it doesn't throw.
let Combine2 p1 p2 fn =
fun a -> res { let! x = p1 a
let! y = p2 a
return!
try
Success(fn(x,y))
with
| ex -> Failure(ex.Message)
}
Update:
The original implementation was showing a warning, not an error. The expression in the with block was not used since you returned from the try block, so you could simply add |> ignore. In that case if fn throws then the return value is m.Zero() and the only difference is that you would get "hello world" instead of ex.Message. Illustrated with an example below. Full script here: http://dotnetfiddle.net/mFbeZg
Original implementation with |> ignore to mute the warning:
let Combine3 p1 p2 fn =
fun a -> res { let! x = p1 a
let! y = p2 a
try
return fn(x,y)
with
| ex -> Failure(ex.Message) |> ignore // no warning
}
Run it:
let comb2 a =
let p1' x = Success(x)
let p2' y = Success(y)
let fn' (x,y) = 1/0 // div by zero
let func = Parser.Combine2 p1' p2' fn' a
func()
let comb3 a =
let p1' x = Success(x)
let p2' y = Success(y)
let fn' (x,y) = 1/0 // div by zero
let func = Parser.Combine3 p1' p2' fn' a
func()
let test2 = comb2 1
let test3 = comb3 1
Result:
val test2 : Result<int> = Failure "Attempted to divide by zero."
val test3 : Result<int> = Failure "hello world"
If you want to support try ... with inside a computation builder, you need to add TryWith (as you tried) as well as a few other members including Delay and Run (depending on how you want to implement Delay). In order to be able to return failure, you also need to support return! by adding ReturnFrom:
type ResultBuilder() =
member m.Return a = Success(a)
member m.Bind(r,fn) =
match r with
| Success(a) -> fn a
| Failure(m) -> Failure(m)
member m.TryWith(r,fn) =
try r() with ex -> fn ex
member m.Delay(f) = f
member m.Run(f) = f()
member m.ReturnFrom(r) = r
Now you can do the following:
let Combine2 p1 p2 fn = fun a -> res {
let! x = p1 a
let! y = p2 a
try
return fn(x,y)
with ex ->
return! Failure(ex.Message) }
The trick is that the normal branch uses just return (representing success), but the exception handler uses return! to return an explicitly created result using Failure.
That said, if you are interested in parsers, then you need to use a different type - what you are describing here is more like the option (or Maybe) monad. To implement parser combinators you need a type that represents a parser rather than result of a parser. See for example this article.