diff --git a/src/FSharp.Control.TaskSeq.Test/CEPoC.fs b/src/FSharp.Control.TaskSeq.Test/CEPoC.fs new file mode 100644 index 0000000..238d659 --- /dev/null +++ b/src/FSharp.Control.TaskSeq.Test/CEPoC.fs @@ -0,0 +1,312 @@ +namespace TaskSeq.Tests + +open Xunit +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 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> = { + 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, obj List> + + 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 = 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 + 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 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 + 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" + "b") + 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> + // 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 { + 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 { + 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 d625d93..03c65f3 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 @@ + @@ -62,8 +63,11 @@ + + + runtime; build; native; contentfiles; analyzers; buildtransitive