From fd334fba7d9575ecb89151d2635747fa2fcc7782 Mon Sep 17 00:00:00 2001 From: Max Malook Date: Fri, 1 Jan 2016 22:18:39 +0100 Subject: [PATCH 1/2] add test for #82 --- tests/FSharp.Configuration.Tests/Lists.yaml | 12 ++++++++- .../YamlProvider.Tests.fs | 26 +++++++++++++++++++ 2 files changed, 37 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Configuration.Tests/Lists.yaml b/tests/FSharp.Configuration.Tests/Lists.yaml index b23fec67..69676906 100644 --- a/tests/FSharp.Configuration.Tests/Lists.yaml +++ b/tests/FSharp.Configuration.Tests/Lists.yaml @@ -39,4 +39,14 @@ Archive: ConnectionString: Server=localhost;Database=message_archive;Uid=xmpp;Pwd=password - Type: mssql Writeonly: false - ConnectionString: Data Source=server1;Initial Catalog=message_archive;Integrated Security=SSPI; \ No newline at end of file + ConnectionString: Data Source=server1;Initial Catalog=message_archive;Integrated Security=SSPI; + +Fix82: + id: "myApp" + constraints: + - + - "attribute" + - "OPERATOR" + - "value" + labels: + environment: "staging" \ No newline at end of file diff --git a/tests/FSharp.Configuration.Tests/YamlProvider.Tests.fs b/tests/FSharp.Configuration.Tests/YamlProvider.Tests.fs index abdab879..c2d7a456 100644 --- a/tests/FSharp.Configuration.Tests/YamlProvider.Tests.fs +++ b/tests/FSharp.Configuration.Tests/YamlProvider.Tests.fs @@ -280,6 +280,32 @@ items: settings.items.[2].descrip |> should equal "High Heeled \"Ruby\" Slippers" settings.items.[2].quantity |> should equal 1 +[] +let ``Can load nested lists``() = + let settings = Lists() + settings.LoadText """ +Fix82: + id: "myApp" + constraints: + - + - "attribute" + - "OPERATOR" + - "value" + - + - "field" + - "OP" + labels: + environment: "staging" +""" + settings.Fix82.constraints.Count |> should equal 2 + settings.Fix82.constraints.[0].Count |> should equal 3 + settings.Fix82.constraints.[0].[0] |> should equal "attribute" + settings.Fix82.constraints.[0].[1] |> should equal "OPERATOR" + settings.Fix82.constraints.[0].[2] |> should equal "value" + settings.Fix82.constraints.[1].Count |> should equal 2 + settings.Fix82.constraints.[1].[0] |> should equal "field" + settings.Fix82.constraints.[1].[1] |> should equal "OP" + [] [] let ``Check that list defaults are OK``() = From 6d449ea3f107034e395ecb537355c59039c2ba84 Mon Sep 17 00:00:00 2001 From: Max Malook Date: Fri, 1 Jan 2016 22:19:07 +0100 Subject: [PATCH 2/2] allow nested lists --- .../YamlConfigProvider.fs | 84 ++++++++++++++++++- 1 file changed, 82 insertions(+), 2 deletions(-) diff --git a/src/FSharp.Configuration/YamlConfigProvider.fs b/src/FSharp.Configuration/YamlConfigProvider.fs index 9c3efc0e..c532cf78 100644 --- a/src/FSharp.Configuration/YamlConfigProvider.fs +++ b/src/FSharp.Configuration/YamlConfigProvider.fs @@ -117,6 +117,32 @@ module private Parser = else None } |> function Some dlg -> [dlg] | None -> [] + and fillList (targetType: Type) (updaters: Node list) = + + let fieldType = + match updaters |> List.choose (function Scalar x -> Some x | _ -> None) + |> Seq.groupBy (fun n -> n.UnderlyingType) |> Seq.map fst |> Seq.toList with + | [] -> targetType + | [ty] -> typedefof>.MakeGenericType ty + | types -> failwithf "List cannot contain elements of heterohenius types (attempt to mix types: %A)." types + + let updaters = updaters |> List.choose (function + | Scalar x -> Some x.BoxedValue + | Map m -> + let mapItem = Activator.CreateInstance (fieldType.GetGenericArguments().[0]) + updateMap mapItem None m |> ignore + Some mapItem + | List l -> + let listItem = fillList (fieldType.GetGenericArguments().[0]) l + Some listItem) + + if targetType.IsAssignableFrom(fieldType) |> not then failwithf "Cannot assign %O to %O." fieldType.Name targetType.Name + + let list = Activator.CreateInstance fieldType + let addMethod = fieldType.GetMethod("Add", [|fieldType.GetGenericArguments().[0]|]) + updaters |> List.iter (fun x -> addMethod.Invoke(list, [| x |]) |> ignore) + list + and updateList (target: obj) name (updaters: Node list) = maybe { let! field = tryGetField target ("_" + name) @@ -134,7 +160,9 @@ module private Parser = let mapItem = Activator.CreateInstance (fieldType.GetGenericArguments().[0]) updateMap mapItem None m |> ignore Some mapItem - | _ -> None) + | List l -> + let listItem = fillList (fieldType.GetGenericArguments().[0]) l + Some listItem) if field.FieldType <> fieldType then failwithf "Cannot assign %O to %O." fieldType.Name field.FieldType.Name let isComparable (x: obj) = x :? Uri || x :? IComparable @@ -252,13 +280,65 @@ module private TypesFactory = Types = [field :> MemberInfo; prop :> MemberInfo] Init = fun me -> Expr.FieldSet(me, field, initValue) } + and transformListRaw readOnly name (children: Node list) = + let elements = + children + |> List.map (function + | Scalar x -> { MainType = Some x.UnderlyingType; Types = []; Init = fun _ -> x.ToExpr() } + | Map m -> transformMap readOnly None m + | List l -> transformListRaw readOnly (name + "_Items") l) + + let elements, elementType = + match elements |> Seq.groupBy (fun n -> n.MainType) |> Seq.map fst |> Seq.toList with + | [Some ty] -> elements, ty + | [None] -> + // Sequence of maps: https://github.com/fsprojects/FSharp.Configuration/issues/51 + // TODOL Construct the type from all the elements (instead of only the first entry) + let headChildren = match children |> Seq.head with Map m -> m | _ -> failwith "expected a sequence of maps." + + let childTypes, childInits = foldChildren readOnly headChildren + let eventField, event = generateChangedEvent() + + let mapTy = ProvidedTypeDefinition(name + "_Item_Type", Some typeof, HideObjectMethods=true, + IsErased=false, SuppressRelocation=false) + + let ctr = ProvidedConstructor([], InvokeCode = (fun [me] -> childInits me)) + mapTy.AddMembers (ctr :> MemberInfo :: childTypes) + mapTy.AddMember eventField + mapTy.AddMember event + let t = + { MainType = Some (mapTy :> _) + Types = [mapTy :> MemberInfo] + Init = fun _ -> Expr.NewObject(ctr, []) } + + [ t ], mapTy :> _ + | types -> failwithf "List cannot contain elements of heterogeneous types (attempt to mix types: %A)." + (types |> List.map (Option.map (fun x -> x.Name))) + + let propType = ProvidedTypeBuilder.MakeGenericType(typedefof>, [elementType]) + let ctrType = ProvidedTypeBuilder.MakeGenericType(typedefof>, [elementType]) + + let listCtr = + let meth = typeof.GetMethod("CreateResizeArray") + ProvidedTypeBuilder.MakeGenericMethod(meth, [elementType]) + let childTypes = elements |> List.collect (fun x -> x.Types) + let initValue me = + Expr.Coerce( + Expr.Call(listCtr, [Expr.Coerce(Expr.NewArray(elementType, elements |> List.map (fun x -> x.Init me)),ctrType)]), + propType) + + + { MainType = Some propType + Types = childTypes + Init = initValue } + and transformList readOnly name (children: Node list) = let elements = children |> List.map (function | Scalar x -> { MainType = Some x.UnderlyingType; Types = []; Init = fun _ -> x.ToExpr() } | Map m -> transformMap readOnly None m - | List _ -> failwith "Nested lists are not supported.") + | List l -> transformListRaw readOnly (name + "_Items") l) let elements, elementType = match elements |> Seq.groupBy (fun n -> n.MainType) |> Seq.map fst |> Seq.toList with