From bdc070df8bd6e04ab08221e34ff977ea9e0b524c Mon Sep 17 00:00:00 2001 From: Abel Braaksma Date: Mon, 18 Dec 2023 01:11:39 +0100 Subject: [PATCH 1/4] Non-working code for CE PoC to combined custom operations with standard CE --- src/FSharp.Control.TaskSeq.Test/CEPoC.fs | 217 ++++++++++++++++++ .../FSharp.Control.TaskSeq.Test.fsproj | 3 +- 2 files changed, 219 insertions(+), 1 deletion(-) create mode 100644 src/FSharp.Control.TaskSeq.Test/CEPoC.fs diff --git a/src/FSharp.Control.TaskSeq.Test/CEPoC.fs b/src/FSharp.Control.TaskSeq.Test/CEPoC.fs new file mode 100644 index 00000000..8a60c3aa --- /dev/null +++ b/src/FSharp.Control.TaskSeq.Test/CEPoC.fs @@ -0,0 +1,217 @@ +namespace TaskSeq.Tests + +open Xunit +open FsUnit.Xunit + +open FSharp.Control + + +module CEs = + + type M<'T, 'Vars> = { + Name: string option + IsMember: bool option + IsMember2: bool // confirming that shape of the container is not restricted, just need clear default the CE understands + Members: 'T list + Variables: 'Vars + } + + type M<'T> = M<'T, unit> + + type CE() = + + member _.Zero() : M<'T> = { + Name = None + IsMember = None + IsMember2 = false + Members = [] + Variables = () + } + + member _.Combine(model1: M<'T>, model2: M<'T>) : M<'T> = + let newName = + match model2.Name with + | None -> model1.Name + | res -> res + + let newIsMember = + match model2.IsMember with + | None -> model1.IsMember + | res -> res + + let newIsMember2 = + match model2.IsMember2 with + | true -> true + | res -> res + + { + Name = newName + IsMember = newIsMember + IsMember2 = newIsMember2 + Members = List.append model1.Members model2.Members + Variables = () + } + + member _.Delay(f) : M<'T, 'Vars> = f () + + member _.Run(model: M<'T, 'Vars>) : M<'T> = { + Name = model.Name + IsMember = model.IsMember + IsMember2 = model.IsMember2 + Members = model.Members + Variables = () + } + + member this.For(methods, f) : M<'T> = + let methodList = Seq.toList methods + + match methodList with + | [] -> this.Zero() + | [ x ] -> f (x) + | head :: tail -> + let mutable headResult = f (head) + + for x in tail do + headResult <- this.Combine(headResult, f (x)) + + headResult + + member _.Yield(item: 'T) : M<'T> = { + Name = None + IsMember = None + IsMember2 = false + Members = [ item ] + Variables = () + } + + // Only for packing/unpacking the implicit variable space + member _.Bind(model1: M<'T, 'Vars>, f: ('Vars -> M<'T>)) : M<'T> = + let model2 = f model1.Variables + + let newName = + match model2.Name with + | None -> model1.Name + | res -> res + + let newIsMember = + match model2.IsMember with + | None -> model1.IsMember + | res -> res + + let newIsMember2 = + match model2.IsMember2 with + | true -> true + | res -> res + + { + Name = newName + IsMember = newIsMember + IsMember2 = newIsMember2 + Members = model1.Members @ model2.Members + Variables = model2.Variables + } + + // Only for packing/unpacking the implicit variable space + member _.Return(varspace: 'Vars) : M<'T, 'Vars> = { + Name = None + IsMember = None + IsMember2 = false + Members = [] + Variables = varspace + } + + [] + member _.setName(model: M<'T, 'Vars>, [] name: ('Vars -> string)) : M<'T, 'Vars> = { + model with + Name = Some(name model.Variables) + } + + [] + member _.setIsMember(model: M<'T, 'Vars>, [] isMember: ('Vars -> bool)) : M<'T, 'Vars> = { + model with + IsMember = Some(isMember model.Variables) + } + + // We can skip + [] + member _.setIsMember2(model: M<'T, 'Vars>, [] isMember: ('Vars -> bool)) : M<'T, 'Vars> = { + model with + IsMember2 = isMember model.Variables + } + + [] + member _.addMember(model: M<'T, 'Vars>, [] item: ('Vars -> 'T)) : M<'T, 'Vars> = { + model with + Members = List.append model.Members [ item model.Variables ] + } + + // Note, using ParamArray doesn't work in conjunction with ProjectionParameter + [] + member _.addMembers(model: M<'T, 'Vars>, [] items: ('Vars -> 'T list)) : M<'T, 'Vars> = { + model with + Members = List.append model.Members (items model.Variables) + } + + let ce = CE() + + module Test = + let x: M = ce { Name "Fred" } + + let x2: M = ce { + Name "Fred" + IsMember true + IsMember true + IsMember2 true // Note, I can call this twice without compiler error, but not Name in z5 + IsMember2 true + } + + let y = ce { 42 } + + let z1 = ce { Member 42 } + + let z2 = ce { Members [ 41; 42 ] } + + let z3 = ce { + Name "Fred" + 42 + } + + let z4 = ce { + Member 41 + Member 42 + } + + let z5: M = ce { + Name "a" + Name "b" + //42 // removing this line results in compiler error + } + + let z6: M = ce { + let x = 1 + let y = 2 + let z = 3 + let! foo = Unchecked.defaultof> + Name "a" + Member 4.0 + } + + let z7: M = ce { + let x = "a" + Name(x + "b") + Member 4.0 + } + + let z8: M = ce { + let x1 = 1.0 + let y2 = 2.0 + Member(x1 + 3.0) + Member(y2 + 4.0) + } + + let z9 = ce { + let x = 1.0 + Members [ 42.3; 43.1 + x ] + } +//let empty = +// ce { } diff --git a/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj b/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj index d625d93a..92794887 100644 --- a/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj +++ b/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj @@ -1,4 +1,4 @@ - + net6.0 @@ -9,6 +9,7 @@ + From f6abc0d65a201cff2aded26b139f1686325e9c18 Mon Sep 17 00:00:00 2001 From: Abel Braaksma Date: Thu, 28 Mar 2024 15:58:17 +0100 Subject: [PATCH 2/4] Remove compile error --- src/FSharp.Control.TaskSeq.Test/CEPoC.fs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/FSharp.Control.TaskSeq.Test/CEPoC.fs b/src/FSharp.Control.TaskSeq.Test/CEPoC.fs index 8a60c3aa..13a51a15 100644 --- a/src/FSharp.Control.TaskSeq.Test/CEPoC.fs +++ b/src/FSharp.Control.TaskSeq.Test/CEPoC.fs @@ -5,6 +5,10 @@ open FsUnit.Xunit open FSharp.Control +/// +/// EXAMPLE OF USING BIND AND YIELD AND CUSTOM: +/// https://github.com/cannorin/FSharp.CommandLine/blob/master/src/FSharp.CommandLine/commands.fs +/// module CEs = @@ -192,8 +196,10 @@ module CEs = let y = 2 let z = 3 let! foo = Unchecked.defaultof> - Name "a" - Member 4.0 + // leaving the following two lines in creates an "expected to have type unit" error + //Name "a" + //Member 4.0 + () // cannot end with a let! } let z7: M = ce { From 5fb8a9a837992962582823d5961a50fab6e78d4b Mon Sep 17 00:00:00 2001 From: Abel Braaksma Date: Fri, 29 Mar 2024 01:08:18 +0100 Subject: [PATCH 3/4] Allow for a variables list --- src/FSharp.Control.TaskSeq.Test/CEPoC.fs | 40 ++++++++++++++----- .../FSharp.Control.TaskSeq.Test.fsproj | 1 + 2 files changed, 31 insertions(+), 10 deletions(-) diff --git a/src/FSharp.Control.TaskSeq.Test/CEPoC.fs b/src/FSharp.Control.TaskSeq.Test/CEPoC.fs index 13a51a15..7c1972ef 100644 --- a/src/FSharp.Control.TaskSeq.Test/CEPoC.fs +++ b/src/FSharp.Control.TaskSeq.Test/CEPoC.fs @@ -20,7 +20,7 @@ module CEs = Variables: 'Vars } - type M<'T> = M<'T, unit> + type M<'T> = M<'T, obj List> type CE() = @@ -29,7 +29,7 @@ module CEs = IsMember = None IsMember2 = false Members = [] - Variables = () + Variables = [] } member _.Combine(model1: M<'T>, model2: M<'T>) : M<'T> = @@ -53,7 +53,7 @@ module CEs = IsMember = newIsMember IsMember2 = newIsMember2 Members = List.append model1.Members model2.Members - Variables = () + Variables = [] } member _.Delay(f) : M<'T, 'Vars> = f () @@ -63,7 +63,7 @@ module CEs = IsMember = model.IsMember IsMember2 = model.IsMember2 Members = model.Members - Variables = () + Variables = [] } member this.For(methods, f) : M<'T> = @@ -85,7 +85,7 @@ module CEs = IsMember = None IsMember2 = false Members = [ item ] - Variables = () + Variables = [] } // Only for packing/unpacking the implicit variable space @@ -127,9 +127,12 @@ module CEs = [] member _.setName(model: M<'T, 'Vars>, [] name: ('Vars -> string)) : M<'T, 'Vars> = { model with - Name = Some(name model.Variables) + Name = let m = Unchecked.defaultof> in Some(name m.Variables) } + //[] + //member _.setName(model: M<'T, 'Vars * 'Vars2>, [] name: ('Vars -> string)) : M<'T, 'Vars> = Unchecked.defaultof<_> + [] member _.setIsMember(model: M<'T, 'Vars>, [] isMember: ('Vars -> bool)) : M<'T, 'Vars> = { model with @@ -161,6 +164,14 @@ module CEs = module Test = let x: M = ce { Name "Fred" } + let queryTest = query { + for i in [ 1..10 ] do + where (i < 10) + minBy (i + -i) + //headOrDefault + //sumBy 10 + } + let x2: M = ce { Name "Fred" IsMember true @@ -186,7 +197,7 @@ module CEs = } let z5: M = ce { - Name "a" + Name("a" + "b") Name "b" //42 // removing this line results in compiler error } @@ -203,9 +214,18 @@ module CEs = } let z7: M = ce { - let x = "a" - Name(x + "b") - Member 4.0 + let a = "a" + let b = "b" + let c = "c" + let! (d: int) = Unchecked.defaultof<_> + let e = "" + let! (f: System.Guid) = Unchecked.defaultof<_> + //Name("b") + //Member 4.0 + //return () + //let x = "b" + //let! x = Unchecked.defaultof<_> + return [] } let z8: M = ce { diff --git a/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj b/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj index 92794887..a6fcaa8c 100644 --- a/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj +++ b/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj @@ -63,6 +63,7 @@ + From d37ab57a6f1a771fb00ef4ca75cfcc4e37c945bf Mon Sep 17 00:00:00 2001 From: Abel Braaksma Date: Wed, 17 Apr 2024 10:14:42 +0200 Subject: [PATCH 4/4] Add command proc as example --- src/FSharp.Control.TaskSeq.Test/CEPoC.fs | 69 +++++++++++++++++++ .../FSharp.Control.TaskSeq.Test.fsproj | 2 + 2 files changed, 71 insertions(+) diff --git a/src/FSharp.Control.TaskSeq.Test/CEPoC.fs b/src/FSharp.Control.TaskSeq.Test/CEPoC.fs index 7c1972ef..238d6593 100644 --- a/src/FSharp.Control.TaskSeq.Test/CEPoC.fs +++ b/src/FSharp.Control.TaskSeq.Test/CEPoC.fs @@ -10,6 +10,75 @@ open FSharp.Control /// https://github.com/cannorin/FSharp.CommandLine/blob/master/src/FSharp.CommandLine/commands.fs /// +module Cmd = + open FSharp.CommandLine + + let fileOption = commandOption { + names [ "f"; "file" ] + description "Name of a file to use (Default index: 0)" + takes (format("%s:%i").withNames [ "filename"; "index" ]) + takes (format("%s").map (fun filename -> (filename, 0))) + suggests (fun _ -> [ CommandSuggestion.Files None ]) + } + + type Verbosity = + | Quiet + | Normal + | Full + | Custom of int + + let verbosityOption = commandOption { + names [ "v"; "verbosity" ] + description "Display this amount of information in the log." + takes (regex @"q(uiet)?$" |> asConst Quiet) + takes (regex @"n(ormal)?$" |> asConst Quiet) + takes (regex @"f(ull)?$" |> asConst Full) + takes (format("custom:%i").map (fun level -> Custom level)) + takes (format("c:%i").map (fun level -> Custom level)) + } + + let mainCommand () = + let x = CommandBuilder() + + let c1 = command { + name "main" + description "The main command." + opt files in fileOption |> CommandOption.zeroOrMore + + opt verbosity in verbosityOption + |> CommandOption.zeroOrExactlyOne + |> CommandOption.whenMissingUse Normal + + do printfn "%A, %A" files verbosity + let! x = command { name "main" } + name "foo" + //for x in 1 .. 3 do + // yield 42 + + //for x in 1 .. 3 do + // yield 42 + + do printfn "%A, %A" files verbosity + let! x = command { name "main" } + description "The main command." + + return "foo" + } + + command { + let! x = c1 + name "main" + description "The main command." + opt files in fileOption |> CommandOption.zeroOrMore + + opt verbosity in verbosityOption + |> CommandOption.zeroOrExactlyOne + |> CommandOption.whenMissingUse Normal + + do printfn "%A, %A" files verbosity + return "foo" + } + module CEs = type M<'T, 'Vars> = { diff --git a/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj b/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj index a6fcaa8c..03c65f35 100644 --- a/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj +++ b/src/FSharp.Control.TaskSeq.Test/FSharp.Control.TaskSeq.Test.fsproj @@ -66,6 +66,8 @@ + + runtime; build; native; contentfiles; analyzers; buildtransitive