I defined some custom pipeline operators for Async and Task objects, but get compile error FS0002.
[<AutoOpen>]
module AsyncOperators =
type AsyncOperatorHelper = AsyncOperatorHelper with
static member (=>) (computation, AsyncOperatorHelper) =
fun cont ->
async.Bind(computation, cont)
static member (=>) (computation: Task<'a>, AsyncOperatorHelper) =
fun cont ->
async.Bind(computation |> Async.AwaitTask, cont)
static member (=>) (computation: Task, AsyncOperatorHelper) =
fun cont ->
async.Bind(computation |> Async.AwaitTask, cont)
static member (=->) (cont: 'a -> Task<'b>, AsyncOperatorHelper) =
cont >> Async.AwaitTask
static member (=->) (cont: 'a -> Task, AsyncOperatorHelper) =
cont >> Async.AwaitTask
static member (=->) (cont: 'a -> Async<'t>, AsyncOperatorHelper) =
cont
let inline (|~>) a b = (a => AsyncOperatorHelper) (b =-> AsyncOperatorHelper)
let inline (>~>) a b x = x |> (a =-> AsyncOperatorHelper) |~> (b =-> AsyncOperatorHelper)
let _test () =
let x = async.Return 0
let add1 = fun (s: int) -> (async.Return(s + 1))
// COMPILE OK !!
let y = x |~> add1
// But if I expand add1 in the expression:
// error FS0002: This function takes too many arguments, or is used in a context where a function is not expected
let z = x |~> (fun (s: int) -> (async.Return(s + 1)))
()
The two expressions look the same, but why the second one get FS0002 error? How can I fix the problem?
Related
How to allow a function to accept a generic list of functions?
I have the code below, but the compiler is rejecting the line where I try to set partiallyAppliedAdds, with the error:
Type mismatch. Expecting a int -> int' given a int -> 'a -> 'b'
type ApplicativeFunctor(fnList: 'a list) =
member private this.fnList: 'a list = fnList
member this.ap (apTarget: int list) = ([], this.fnList) ||> List.fold (fun (acc: 'a list) fn -> acc # (apTarget |> List.map fn))
let add1 a = a + 1
ApplicativeFunctor([add1]).ap([1]) // [2]
let arg1 = [1; 3]
let add x = fun y -> x + y
let partiallyAppliedAdds = ApplicativeFunctor[add].ap(arg1) // Type mismatch. Expecting a int -> int' given a int -> 'a -> 'b'
Is this easily accomplishable in F#, or should I approach this differently?
To fix your version, you do:
type ApplicativeFunctor<'a,'b>(fnList: list<'a -> 'b>) =
member private _.fnList = fnList
member this.ap apTarget =
([], this.fnList)
||> List.fold (fun acc fn -> acc # List.map fn apTarget)
let add1 a = a + 1
let res1 = ApplicativeFunctor([add1]).ap([1]) (* [2] *)
printfn "%A" res1
let paAdd = ApplicativeFunctor[fun x y -> x + y].ap([1;3])
printfn "%A" paAdd
But the general approach is just
let ap fs xs =
List.foldBack2 (fun f x state ->
f x :: state
) fs xs []
let add x y z = x + y + z
let xs = [1..3]
let ys = [10;20;30]
let zs = [100;200;300]
let res1 = (ap (ap (List.map add xs) ys) zs)
printfn "%A" res1 (* [111;222;333] *)
(* Custom operators *)
let (<!>) = List.map
let (<*>) = ap
let res2 = add <!> xs <*> ys <*> zs
printfn "%A" res2 (* [111;222;333] *)
I have this code:
Ok stringBuffer {
let r = get some list....
match r with
| [] -> "no active tasks"
| r -> String.Join("\n", r)
}
with stringBuffer defined as:
[<AutoOpen>]
module StringBuffer =
type StringBuffer = StringBuilder -> unit
type StringBufferBuilder () =
member inline this.Yield (txt: string) = fun (b: StringBuilder) -> Printf.bprintf b "%s" txt
member inline this.Yield (c: char) = fun (b: StringBuilder) -> Printf.bprintf b "%c" c
member inline this.Yield (strings: #seq<string>) = fun (b: StringBuilder) -> for s in strings do Printf.bprintf b "%s\n" s
member inline this.YieldFrom (f: StringBuffer) = f
member this.Combine (f, g) = fun (b: StringBuilder) -> f b; g b
member this.Delay f = fun (b: StringBuilder) -> (f()) b
member this.Zero () = ignore
member this.For (xs: 'a seq, f: 'a -> StringBuffer) =
fun (b: StringBuilder) ->
use e = xs.GetEnumerator ()
while e.MoveNext() do
(f e.Current) b
member this.While (p: unit -> bool, f: StringBuffer) =
fun (b: StringBuilder) -> while p () do f b
member this.Run (f: StringBuffer) =
let b = StringBuilder()
do f b
b.ToString()
let stringBuffer = StringBufferBuilder()
type StringBufferBuilder with
member inline this.Yield (b: byte) = fun (sb: StringBuilder) -> Printf.bprintf sb "%02x " b
I am not the author of the StringBuffer module. I'm using it regularly as it makes using StringBuilder super convenient to use in F#
I can mix strings and logic easily:
stringBuffer {
"hello"
if x = 3 then "world"
}
but, in the example at the beginning of this post, I am getting the following compilation error:
[FS0708] This control construct may only be used if the computation expression builder defines a 'Zero' method.
In the computation expression, the Zero method is defined as ignore so the problem is probably there. But my question is:
What is this error about? why does this specific use case require the implementation of the Zero method?
My understanding is that the Zero method is used if the expression would return nothing, as it is not valid for a computation expression; But since I specify a string, why would this execution path return nothing?
Edit:
Screenshot of the error (Rider / dotnet 5)
Now, the error is reduced to this scenario:
Ok stringBuffer {
let r = get some list....
match r with
| [] -> "no active tasks"
| r -> String.Join("\n", r)
}
trigger the error, but
let s =
stringBuffer {
let r = get some list....
match r with
| [] -> "no active tasks"
| r -> String.Join("\n", r)
}
Ok s
does not
It works for me if I add parens:
let result =
Ok (stringBuffer {
let r = [1;2;3]
match r with
| [] -> "no active tasks"
| r -> String.Join("\n", r)
})
printfn "%A" result
Without the parens, the "Zero" error message occurs because function application is left-associative, so the compiler thinks you mean something like this: (Ok stringBuffer) { "str" }. Since Ok stringBuffer is an expression that lacks a Zero member, this does not compile.
Amusingly, if you define your own Ok operator that returns a valid builder, it will compile fine:
let Ok (sb : StringBufferBuilder) = sb
let result = Ok stringBuffer { "hello "; "world" } // produces: "hello world"
I am trying to express the Church encoding of the Free monad in F#. Free is specialized to a particular functor, Effect.
I am able to write both return_ : 'T -> Free<'T> and bind: ('T -> Free<'U>) -> Free<'T> -> Free<'U> without any problems.
A sketch of my implementation is given below.
type Effect<'T>
= GetStr of (string -> 'T)
| PutStr of string * 'T
module Effect =
let map (f: 'a -> 'b) : Effect<'a> -> Effect<'b> = function
| GetStr k ->
GetStr(f << k)
| PutStr (s,t) ->
PutStr(s, f t)
type Free<'T> =
abstract Apply : ('T -> 'R) -> (Effect<'R> -> 'R) -> 'R
module Free =
let inline runFree (f:Free<'T>) (kp: 'T -> 'R) (kf: Effect<'R> -> 'R) : 'R =
f.Apply kp kf
let return_ (x: 'a) : Free<'a> =
{ new Free<'a>
with
member __.Apply kp _ =
kp x
}
let bind (f: 'a -> Free<'b>) (m: Free<'a>) : Free<'b> =
{ new Free<'b>
with
member __.Apply kp kf =
runFree m
(fun a ->
runFree (f a) kp kf
)
kf
}
When I try to write an interpreter for this encoding, I hit a problem.
Given the following code:
module Interpret =
let interpretEffect = function
| GetStr k ->
let s = System.Console.ReadLine()
(k s , String.length s)
| PutStr(s,t) ->
do System.Console.WriteLine s
(t , 0)
let rec interpret (f: Free<string * int>) =
Free.runFree
f
(fun (str,len) -> (str,len))
(fun (a: Effect<Free<string*int>>) ->
let (b,n) = interpretEffect a
let (c,n') = interpret b
(c, n + n')
)
I get a type error in the third argument to Free.runFree within the interpret function:
...
(fun (a: Effect<Free<string*int>>) ->
^^^^^^^^^^^^^^^^^^ ------ Expecting a Effect<string * int> but given a Effect<Free<string*int>>
I understand why this is happening (the result type of the first function determines 'R === string*int) and suspect that can be solved using a rank-2 function (which can be encoded in F# e.g. http://eiriktsarpalis.github.io/typeshape/#/33) but I am not sure how to apply it.
Any pointers would be much appreciated.
Michael
You do not need to do anything there, the compiler suggested type is in fact correct (and in line with the type of runFree).
It seems that what you're thinking of there is Scott encoding (ripped from this Haskell question):
runFree :: Functor f => (a -> r) -> (f (F f a) -> r) -> F f a -> r
where F f a would be your Effect-specialised Free<'a>, and f (F f a) would be Effect<Free<'a>>, which is what you're trying to use.
Whereas Church encoding would be:
runFree :: Functor f => (a -> r) -> (f r -> r) -> F f a -> r
where f r is Effect<'a> - thus making it easier to express in F# (which is why I assume you're using it in the first place.
This is what I had for interpret:
let rec interpret (f: Free<string * int>) =
Free.runFree
f
(fun (str,len) -> (str,len))
(fun (a: Effect<_>) ->
let (b,n) = interpretEffect a
let (c,n') = interpret (Free.pureF b)
(c, n + n')
)
where pureF is
let pureF (x: 'a) : Free<'a> =
{ new Free<'a> with member __.Apply kp _ = kp x }
i.e. your return_ function.
I think defining the corresponding freeF function would clear some things (like why is Effect<'a> a functor - you're not making use of this fact anywhere in the code you pasted).
[<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.