6 people like it.
Like the snippet!
Lens Generation using TypeShape
Adaptation of https://bitbucket.org/rojepp/reflenses/overview using TypeShape
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
|
type Lens<'T, 'F> =
{
get : 'T -> 'F
set : 'T -> 'F -> 'T
}
module private Impl =
open FSharp.Quotations
open FSharp.Quotations.Patterns
open TypeShape.Core
open TypeShape.Clone
type Path = Node list
and Node =
| Property of string
| Item of int
// converts a quotation of the form <@ fun x -> x.Foo.Bar.[0].Baz @> into a path
let extractPath (e : Expr<'T -> 'F>) : Path =
let rec aux v acc e =
match e with
| Var v' when v = v' -> acc
| PropertyGet(Some o, p, [Value((:? int as i), _)]) when p.Name = "Item" -> aux v (Item i :: acc) o
| PropertyGet(Some o, p, []) -> aux v (Property p.Name :: acc) o
| Call(None, m, [o ; Value(:? int as i, _)]) when m.Name = "GetArray" && o.Type.IsArray && e.Type = o.Type.GetElementType() -> aux v (Item i :: acc) o
// we support tuples, as they are often used to encode fields in erased type providers
| TupleGet(x, i) -> aux v (Item i :: acc) x
| _ -> invalidArg "expr" "invalid lens expression"
match e with
| Lambda(v, body) -> aux v [] body
| _ -> invalidArg "expr" "lens expressions must be lambda literals"
let rec mkLensAux<'T, 'F> (path : Path) : Lens<'T, 'F> =
let wrap (l : Lens<'a,'b>) : Lens<'T, 'F> = unbox l
let nest chain (m : IShapeWriteMember<'T>) =
m.Accept { new IWriteMemberVisitor<'T, Lens<'T, 'F>> with
member __.Visit<'F0> (m : ShapeWriteMember<'T, 'F0>) =
let inner = mkLensAux<'F0, 'F> chain
{
get = fun (t:'T) -> inner.get (m.Project t)
set = fun (t:'T) (f:'F) -> m.Inject t (inner.set (m.Project t) f)
}
}
match shapeof<'T>, path with
| _, [] -> wrap { get = id<'F> ; set = fun (_:'F) (y:'F) -> y }
| Shape.FSharpList s, Item i :: rest ->
s.Accept { new IFSharpListVisitor<Lens<'T,'F>> with
member __.Visit<'t> () =
let inner = mkLensAux<'t, 'F> rest
wrap {
get = fun (ts : 't list) -> inner.get ts.[i]
set = fun (ts : 't list) (f : 'F) -> ts |> List.mapi (fun j t -> if j = i then inner.set t f else t)
}
}
| Shape.FSharpOption s, Property "Value" :: rest ->
s.Accept { new IFSharpOptionVisitor<Lens<'T,'F>> with
member __.Visit<'t> () =
let inner = mkLensAux<'t, 'F> rest
wrap {
get = fun (ts : 't option) -> inner.get (Option.get ts)
set = fun (ts : 't option) (f : 'F) -> inner.set (Option.get ts) f |> Some
}
}
| Shape.Tuple (:? ShapeTuple<'T> as s), Item i :: rest ->
s.Elements.[i] |> nest rest
| Shape.Array s, Item i :: rest when s.Rank = 1 ->
s.Accept { new IArrayVisitor<Lens<'T,'F>> with
member __.Visit<'t> _ =
let inner = mkLensAux<'t, 'F> rest
wrap {
get = fun (ts : 't[]) -> inner.get ts.[i]
set = fun (ts : 't[]) (f : 'F) -> ts.[i] <- inner.set ts.[i] f ; ts
}
}
| Shape.FSharpRecord (:? ShapeFSharpRecord<'T> as s) & Shape.FSharpRef _, Property "Value" :: rest ->
s.Fields |> Array.find (fun p -> p.Label = "contents") |> nest rest
| Shape.FSharpRecord (:? ShapeFSharpRecord<'T> as s), Property id :: rest ->
s.Fields |> Array.find (fun p -> p.Label = id) |> nest rest
| _ -> failwithf "unsupported lens type %O" typeof<'T>
let mkLens<'T, 'F> (expr : Expr<'T -> 'F>) : Lens<'T, 'F> =
let path = Impl.extractPath expr
let lens = Impl.mkLensAux<'T, 'F> path
{
get = lens.get
set = fun t f -> lens.set (clone t) f // TypeShape native lenses rely on mutation, so we clone to hide this fact
}
|
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
|
type Foo<'T> =
{
a : 'T
b : string
c : bool
}
let l1 = mkLens <@ fun (x:int) -> x @>
let l2 = mkLens <@ fun (x:Foo<int> ref) -> x.Value.a @>
let l3 = mkLens <@ fun (x:Foo<Foo<int> list> [] list option) -> x.Value.[0].[0].a.[0] @>
l1.get 42 // 42
l2.get (ref {a = 42; b = "" ; c = false}) // 42
l3.get (Some [[| { a = [{ a = 42 ; b = "" ; c = false }] ; b = "" ; c = false } |]]) // { a = 42 ; b = "" ; c = false }
l1.set 42 1
l2.set (ref {a = 42; b = "" ; c = false}) 5
l3.set (Some [[| { a = [{ a = 42 ; b = "" ; c = false }] ; b = "" ; c = false } |]]) { a = 42 ; b = "b" ; c = true }
// working with type providers
open FSharp.Data
type Bar = CsvProvider<Schema = "A (int), B (string), C (float)", HasHeaders = false>
let l4 = mkLens <@ fun (x:Bar.Row list) -> x.[1].B @>
let values = Bar.Parse("42, bar, 3.14\n55, baz, 2.17").Rows |> Seq.toList
l4.get values
l4.set values "foo"
|
Lens.get: 'T -> 'F
Lens.set: 'T -> 'F -> 'T
Multiple items
namespace FSharp
--------------------
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Quotations
module Patterns
from Microsoft.FSharp.Quotations
namespace TypeShape
namespace TypeShape.Core
Multiple items
namespace TypeShape
--------------------
type TypeShape =
private new : unit -> TypeShape
abstract member Accept : ITypeShapeVisitor<'R> -> 'R
abstract member ShapeInfo : TypeShapeInfo
abstract member Type : Type
override ToString : unit -> string
static member Create : unit -> TypeShape<'T>
static member Create : typ:Type -> TypeShape
static member FromValue : obj:obj -> TypeShape
Full name: TypeShape.Core.Core.TypeShape
--------------------
type TypeShape<'T> =
inherit TypeShape
new : unit -> TypeShape<'T>
override Accept : v:ITypeShapeVisitor<'a1> -> 'a1
override Equals : o:obj -> bool
override GetHashCode : unit -> int
override ShapeInfo : TypeShapeInfo
override Type : Type
Full name: TypeShape.Core.Core.TypeShape<_>
--------------------
new : unit -> TypeShape<'T>
module Clone
from TypeShape
type private Path = Node list
Full name: Script.Impl.Path
type private Node =
| Property of string
| Item of int
Full name: Script.Impl.Node
type 'T list = List<'T>
Full name: Microsoft.FSharp.Collections.list<_>
union case Node.Property: string -> Node
Multiple items
val string : value:'T -> string
Full name: Microsoft.FSharp.Core.Operators.string
--------------------
type string = System.String
Full name: Microsoft.FSharp.Core.string
union case Node.Item: int -> Node
Multiple items
val int : value:'T -> int (requires member op_Explicit)
Full name: Microsoft.FSharp.Core.Operators.int
--------------------
type int = int32
Full name: Microsoft.FSharp.Core.int
--------------------
type int<'Measure> = int
Full name: Microsoft.FSharp.Core.int<_>
val private extractPath : e:Expr<('T -> 'F)> -> Path
Full name: Script.Impl.extractPath
val e : Expr<('T -> 'F)>
Multiple items
type Expr =
override Equals : obj:obj -> bool
member GetFreeVars : unit -> seq<Var>
member Substitute : substitution:(Var -> Expr option) -> Expr
member ToString : full:bool -> string
member CustomAttributes : Expr list
member Type : Type
static member AddressOf : target:Expr -> Expr
static member AddressSet : target:Expr * value:Expr -> Expr
static member Application : functionExpr:Expr * argument:Expr -> Expr
static member Applications : functionExpr:Expr * arguments:Expr list list -> Expr
...
Full name: Microsoft.FSharp.Quotations.Expr
--------------------
type Expr<'T> =
inherit Expr
member Raw : Expr
Full name: Microsoft.FSharp.Quotations.Expr<_>
val aux : (Var -> Node list -> Expr -> Node list)
val v : Var
val acc : Node list
val e : Expr
Multiple items
active recognizer Var: Expr -> Var option
Full name: Microsoft.FSharp.Quotations.Patterns.( |Var|_| )
--------------------
type Var =
interface IComparable
new : name:string * typ:Type * ?isMutable:bool -> Var
member IsMutable : bool
member Name : string
member Type : Type
static member Global : name:string * typ:Type -> Var
Full name: Microsoft.FSharp.Quotations.Var
--------------------
new : name:string * typ:System.Type * ?isMutable:bool -> Var
val v' : Var
active recognizer PropertyGet: Expr -> (Expr option * System.Reflection.PropertyInfo * Expr list) option
Full name: Microsoft.FSharp.Quotations.Patterns.( |PropertyGet|_| )
union case Option.Some: Value: 'T -> Option<'T>
val o : Expr
val p : System.Reflection.PropertyInfo
active recognizer Value: Expr -> (obj * System.Type) option
Full name: Microsoft.FSharp.Quotations.Patterns.( |Value|_| )
val i : int
property System.Reflection.MemberInfo.Name: string
active recognizer Call: Expr -> (Expr option * System.Reflection.MethodInfo * Expr list) option
Full name: Microsoft.FSharp.Quotations.Patterns.( |Call|_| )
union case Option.None: Option<'T>
val m : System.Reflection.MethodInfo
property Expr.Type: System.Type
property System.Type.IsArray: bool
System.Type.GetElementType() : System.Type
active recognizer TupleGet: Expr -> (Expr * int) option
Full name: Microsoft.FSharp.Quotations.Patterns.( |TupleGet|_| )
val x : Expr
val invalidArg : argumentName:string -> message:string -> 'T
Full name: Microsoft.FSharp.Core.Operators.invalidArg
active recognizer Lambda: Expr -> (Var * Expr) option
Full name: Microsoft.FSharp.Quotations.Patterns.( |Lambda|_| )
val body : Expr
val private mkLensAux : path:Path -> Lens<'T,'F>
Full name: Script.Impl.mkLensAux
val path : Path
type Lens<'T,'F> =
{get: 'T -> 'F;
set: 'T -> 'F -> 'T;}
Full name: Script.Lens<_,_>
val wrap : (Lens<'a,'b> -> Lens<'T,'F>)
val l : Lens<'a,'b>
val unbox : value:obj -> 'T
Full name: Microsoft.FSharp.Core.Operators.unbox
val nest : (Path -> IShapeWriteMember<'T> -> Lens<'T,'F>)
val chain : Path
val m : IShapeWriteMember<'T>
type IShapeWriteMember<'Record> =
interface
inherit IShapeMember<'Record>
abstract member Accept : IWriteMemberVisitor<'Record,'R> -> 'R
end
Full name: TypeShape.Core.Core.IShapeWriteMember<_>
abstract member IShapeMember.Accept : IMemberVisitor<'DeclaringType,'R> -> 'R
abstract member IShapeWriteMember.Accept : IWriteMemberVisitor<'Record,'R> -> 'R
type IWriteMemberVisitor<'TRecord,'R> =
interface
abstract member Visit : ShapeWriteMember<'TRecord,'Field> -> 'R
end
Full name: TypeShape.Core.Core.IWriteMemberVisitor<_,_>
val m : ShapeWriteMember<'T,'F0>
type ShapeWriteMember<'DeclaringType,'MemberType> =
inherit ShapeMember<'DeclaringType,'MemberType>
interface IShapeWriteMember<'DeclaringType>
private new : label:string * memberInfo:MemberInfo * path:MemberInfo [] -> ShapeWriteMember<'DeclaringType,'MemberType>
member Inject : instance:'DeclaringType -> field:'MemberType -> 'DeclaringType
member InjectExpr : instance:Expr<'DeclaringType> -> field:Expr<'MemberType> -> Expr<'DeclaringType>
Full name: TypeShape.Core.Core.ShapeWriteMember<_,_>
val inner : Lens<'F0,'F>
val t : 'T
Lens.get: 'F0 -> 'F
member ShapeMember.Project : instance:'DeclaringType -> 'MemberType
val set : elements:seq<'T> -> Set<'T> (requires comparison)
Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.set
val f : 'F
member ShapeWriteMember.Inject : instance:'DeclaringType -> field:'MemberType -> 'DeclaringType
Lens.set: 'F0 -> 'F -> 'F0
val shapeof<'T> : TypeShape
Full name: TypeShape.Core.Core.shapeof
val id : x:'T -> 'T
Full name: Microsoft.FSharp.Core.Operators.id
val y : 'F
module Shape
from TypeShape.Core.Core
active recognizer FSharpList: TypeShape -> IShapeFSharpList option
Full name: TypeShape.Core.Core.Shape.( |FSharpList|_| )
val s : IShapeFSharpList
val rest : Node list
type IFSharpListVisitor<'R> =
interface
abstract member Visit : unit -> 'R
end
Full name: TypeShape.Core.Core.IFSharpListVisitor<_>
val inner : Lens<'t,'F>
val ts : 't list
Lens.get: 't -> 'F
Multiple items
module List
from Microsoft.FSharp.Collections
--------------------
type List<'T> =
| ( [] )
| ( :: ) of Head: 'T * Tail: 'T list
interface IEnumerable
interface IEnumerable<'T>
member GetSlice : startIndex:int option * endIndex:int option -> 'T list
member Head : 'T
member IsEmpty : bool
member Item : index:int -> 'T with get
member Length : int
member Tail : 'T list
static member Cons : head:'T * tail:'T list -> 'T list
static member Empty : 'T list
Full name: Microsoft.FSharp.Collections.List<_>
val mapi : mapping:(int -> 'T -> 'U) -> list:'T list -> 'U list
Full name: Microsoft.FSharp.Collections.List.mapi
val j : int
val t : 't
Lens.set: 't -> 'F -> 't
active recognizer FSharpOption: TypeShape -> IShapeFSharpOption option
Full name: TypeShape.Core.Core.Shape.( |FSharpOption|_| )
val s : IShapeFSharpOption
type IFSharpOptionVisitor<'R> =
interface
abstract member Visit : unit -> 'R
end
Full name: TypeShape.Core.Core.IFSharpOptionVisitor<_>
val ts : 't option
type 'T option = Option<'T>
Full name: Microsoft.FSharp.Core.option<_>
module Option
from Microsoft.FSharp.Core
val get : option:'T option -> 'T
Full name: Microsoft.FSharp.Core.Option.get
active recognizer Tuple: TypeShape -> IShapeTuple option
Full name: TypeShape.Core.Core.Shape.( |Tuple|_| )
type ShapeTuple<'Tuple> =
interface IShapeTuple
private new : unit -> ShapeTuple<'Tuple>
member CreateUninitialized : unit -> 'Tuple
member CreateUninitializedExpr : unit -> Expr<'Tuple>
member Elements : IShapeWriteMember<'Tuple> []
member IsStructTuple : bool
Full name: TypeShape.Core.Core.ShapeTuple<_>
val s : ShapeTuple<'T>
active recognizer Array: TypeShape -> IShapeArray option
Full name: TypeShape.Core.Core.Shape.( |Array|_| )
val s : IShapeArray
type IArrayVisitor<'R> =
interface
abstract member Visit : rank:int -> 'R
end
Full name: TypeShape.Core.Core.IArrayVisitor<_>
val ts : 't []
active recognizer FSharpRecord: TypeShape -> IShapeFSharpRecord option
Full name: TypeShape.Core.Core.Shape.( |FSharpRecord|_| )
type ShapeFSharpRecord<'Record> =
interface IShapeFSharpRecord
private new : unit -> ShapeFSharpRecord<'Record>
member CreateUninitialized : unit -> 'Record
member CreateUninitializedExpr : unit -> Expr<'Record>
member Fields : IShapeWriteMember<'Record> []
member IsStructRecord : bool
Full name: TypeShape.Core.Core.ShapeFSharpRecord<_>
val s : ShapeFSharpRecord<'T>
active recognizer FSharpRef: TypeShape -> IShapeFSharpRef option
Full name: TypeShape.Core.Core.Shape.( |FSharpRef|_| )
Multiple items
union case TypeShapeInfo.Array: element: System.Type * rank: int -> TypeShapeInfo
--------------------
module Array
from Microsoft.FSharp.Collections
val find : predicate:('T -> bool) -> array:'T [] -> 'T
Full name: Microsoft.FSharp.Collections.Array.find
val p : IShapeWriteMember<'T>
property IShapeMember.Label: string
val id : string
val failwithf : format:Printf.StringFormat<'T,'Result> -> 'T
Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.failwithf
val typeof<'T> : System.Type
Full name: Microsoft.FSharp.Core.Operators.typeof
val mkLens : expr:Quotations.Expr<(int -> int)> -> Lens<'T,'F>
Full name: Script.mkLens
val expr : Quotations.Expr<(int -> int)>
val path : Impl.Path
module Impl
from Script
val private extractPath : e:Quotations.Expr<('T -> 'F)> -> Impl.Path
Full name: Script.Impl.extractPath
val lens : Lens<'T,'F>
val private mkLensAux : path:Impl.Path -> Lens<'T,'F>
Full name: Script.Impl.mkLensAux
type Foo<'T> =
{a: 'T;
b: string;
c: bool;}
Full name: Script.Foo<_>
Foo.a: 'a
Foo.b: string
Foo.c: bool
type bool = System.Boolean
Full name: Microsoft.FSharp.Core.bool
val l1 : Lens<int,int>
Full name: Script.l1
val x : int
val l2 : Lens<Foo<int> ref,int>
Full name: Script.l2
Multiple items
val ref : value:'T -> 'T ref
Full name: Microsoft.FSharp.Core.Operators.ref
--------------------
type 'T ref = Ref<'T>
Full name: Microsoft.FSharp.Core.ref<_>
val l3 : Lens<Foo<Foo<int> list> [] list option,Foo<int>>
Full name: Script.l3
Lens.get: int -> int
Lens.get: Foo<int> ref -> int
Lens.get: Foo<Foo<int> list> [] list option -> Foo<int>
Lens.set: int -> int -> int
Lens.set: Foo<int> ref -> int -> Foo<int> ref
Lens.set: Foo<Foo<int> list> [] list option -> Foo<int> -> Foo<Foo<int> list> [] list option
Multiple items
namespace FSharp.Data
--------------------
namespace Microsoft.FSharp.Data
type Bar = CsvProvider<...>
Full name: Script.Bar
type CsvProvider
Full name: FSharp.Data.CsvProvider
<summary>Typed representation of a CSV file.</summary>
<param name='Sample'>Location of a CSV sample file or a string containing a sample CSV document.</param>
<param name='Separators'>Column delimiter(s). Defaults to `,`.</param>
<param name='InferRows'>Number of rows to use for inference. Defaults to `1000`. If this is zero, all rows are used.</param>
<param name='Schema'>Optional column types, in a comma separated list. Valid types are `int`, `int64`, `bool`, `float`, `decimal`, `date`, `guid`, `string`, `int?`, `int64?`, `bool?`, `float?`, `decimal?`, `date?`, `guid?`, `int option`, `int64 option`, `bool option`, `float option`, `decimal option`, `date option`, `guid option` and `string option`.
You can also specify a unit and the name of the column like this: `Name (type<unit>)`, or you can override only the name. If you don't want to specify all the columns, you can reference the columns by name like this: `ColumnName=type`.</param>
<param name='HasHeaders'>Whether the sample contains the names of the columns as its first line.</param>
<param name='IgnoreErrors'>Whether to ignore rows that have the wrong number of columns or which can't be parsed using the inferred or specified schema. Otherwise an exception is thrown when these rows are encountered.</param>
<param name='SkipRows'>SKips the first n rows of the CSV file.</param>
<param name='AssumeMissingValues'>When set to true, the type provider will assume all columns can have missing values, even if in the provided sample all values are present. Defaults to false.</param>
<param name='PreferOptionals'>When set to true, inference will prefer to use the option type instead of nullable types, `double.NaN` or `""` for missing values. Defaults to false.</param>
<param name='Quote'>The quotation mark (for surrounding values containing the delimiter). Defaults to `"`.</param>
<param name='MissingValues'>The set of strings recogized as missing values. Defaults to `NaN,NA,N/A,#N/A,:,-,TBA,TBD`.</param>
<param name='CacheRows'>Whether the rows should be caches so they can be iterated multiple times. Defaults to true. Disable for large datasets.</param>
<param name='Culture'>The culture used for parsing numbers and dates. Defaults to the invariant culture.</param>
<param name='Encoding'>The encoding used to read the sample. You can specify either the character set name or the codepage number. Defaults to UTF8 for files, and to ISO-8859-1 the for HTTP requests, unless `charset` is specified in the `Content-Type` response header.</param>
<param name='ResolutionFolder'>A directory that is used when resolving relative file references (at design time and in hosted execution).</param>
<param name='EmbeddedResource'>When specified, the type provider first attempts to load the sample from the specified resource
(e.g. 'MyCompany.MyAssembly, resource_name.csv'). This is useful when exposing types generated by the type provider.</param>
val l4 : Lens<CsvProvider<...>.Row list,string>
Full name: Script.l4
type Row =
inherit int * string * float
new : a: int * b: string * c: float -> Row
member A : int
member B : string
member C : float
Full name: FSharp.Data.CsvProvider,Schema="A (int), B (string), C (float)",HasHeaders="False".Row
val values : CsvProvider<...>.Row list
Full name: Script.values
CsvProvider<...>.Parse(text: string) : CsvProvider<...>
Parses the specified CSV string
module Seq
from Microsoft.FSharp.Collections
val toList : source:seq<'T> -> 'T list
Full name: Microsoft.FSharp.Collections.Seq.toList
Lens.get: CsvProvider<...>.Row list -> string
Lens.set: CsvProvider<...>.Row list -> string -> CsvProvider<...>.Row list
More information