diff --git a/docs/tutorials/JsonAnonymizer.fsx b/docs/tutorials/JsonAnonymizer.fsx index 532431d64..0f76f40c1 100644 --- a/docs/tutorials/JsonAnonymizer.fsx +++ b/docs/tutorials/JsonAnonymizer.fsx @@ -68,18 +68,25 @@ type JsonAnonymizer(?propertiesToSkip, ?valuesToSkip) = let randomize (str:string) = String(str.ToCharArray() |> Array.map getRandomChar) + let isType testType typ = + match typ with + | Runtime.StructuralTypes.InferedType.Primitive (typ, _, _, _) -> typ = testType + | _ -> false + let rec anonymize json = match json with | JsonValue.String s when valuesToSkip.Contains s -> json | JsonValue.String s -> let typ = Runtime.StructuralInference.inferPrimitiveType - CultureInfo.InvariantCulture s - - ( if typ = typeof then Guid.NewGuid().ToString() - elif typ = typeof || - typ = typeof then s - elif typ = typeof then s + Runtime.StructuralInference.defaultUnitsOfMeasureProvider + Runtime.StructuralInference.InferenceMode'.ValuesOnly + CultureInfo.InvariantCulture s None + + ( if typ |> isType typeof then Guid.NewGuid().ToString() + elif typ |> isType typeof || + typ |> isType typeof then s + elif typ |> isType typeof then s else let prefix, s = if s.StartsWith "http://" then @@ -92,9 +99,11 @@ type JsonAnonymizer(?propertiesToSkip, ?valuesToSkip) = | JsonValue.Number d -> let typ = Runtime.StructuralInference.inferPrimitiveType - CultureInfo.InvariantCulture (d.ToString()) - if typ = typeof || - typ = typeof then json + Runtime.StructuralInference.defaultUnitsOfMeasureProvider + Runtime.StructuralInference.InferenceMode'.ValuesOnly + CultureInfo.InvariantCulture (d.ToString()) None + if typ |> isType typeof || + typ |> isType typeof then json else d.ToString() |> randomize |> Decimal.Parse |> JsonValue.Number | JsonValue.Float f -> f.ToString() diff --git a/src/CommonRuntime/StructuralInference.fs b/src/CommonRuntime/StructuralInference.fs index a75300c3e..cbd3941e8 100644 --- a/src/CommonRuntime/StructuralInference.fs +++ b/src/CommonRuntime/StructuralInference.fs @@ -8,6 +8,52 @@ open System.Globalization open FSharp.Data open FSharp.Data.Runtime open FSharp.Data.Runtime.StructuralTypes +open System.Text.RegularExpressions + +/// This is the public inference mode enum with backward compatibility. +type InferenceMode = + /// Used as a default value for backward compatibility with the legacy InferTypesFromValues boolean static parameter. + /// The actual behaviour will depend on whether InferTypesFromValues is set to true (default) or false. + | BackwardCompatible = 0 + /// Type everything as strings + /// (or the most basic type possible for the value when it's not string, e.g. for json numbers or booleans). + | NoInference = 1 + /// Infer types from values only. Inline schemas are disabled. + | ValuesOnly = 2 + /// Inline schemas types have the same weight as value infered types. + | ValuesAndInlineSchemasHints = 3 + /// Inline schemas types override value infered types. (Value infered types are ignored if an inline schema is present) + | ValuesAndInlineSchemasOverrides = 4 + +/// This is the internal DU representing all the valid cases we support, mapped from the public InferenceMode. +type InferenceMode' = + | NoInference + /// Backward compatible mode. + | ValuesOnly + | ValuesAndInlineSchemasHints + | ValuesAndInlineSchemasOverrides + /// Converts from the public api enum with backward compat to the internal representation with only valid cases. + /// If the user sets InferenceMode manually (to a value other than BackwardCompatible) + /// then the legacy InferTypesFromValues is ignored. + /// Otherwise (when set to BackwardCompatible), inference mode is set to a compatible value. + static member FromPublicApi(inferenceMode: InferenceMode, ?legacyInferTypesFromValues: bool) = + match inferenceMode with + | InferenceMode.BackwardCompatible -> + let legacyInferTypesFromValues = defaultArg legacyInferTypesFromValues true + + match legacyInferTypesFromValues with + | true -> InferenceMode'.ValuesOnly + | false -> InferenceMode'.NoInference + | InferenceMode.NoInference -> InferenceMode'.NoInference + | InferenceMode.ValuesOnly -> InferenceMode'.ValuesOnly + | InferenceMode.ValuesAndInlineSchemasHints -> InferenceMode'.ValuesAndInlineSchemasHints + | InferenceMode.ValuesAndInlineSchemasOverrides -> InferenceMode'.ValuesAndInlineSchemasOverrides + | _ -> failwithf "Unexpected inference mode value %A" inferenceMode + +let asOption = + function + | true, x -> Some x + | false, _ -> None /// module internal List = @@ -23,11 +69,6 @@ module internal List = let k1, k2 = set d1.Keys, set d2.Keys let keys = List.map fst vals1 @ (List.ofSeq (k2 - k1)) - let asOption = - function - | true, v -> Some v - | _ -> None - [ for k in keys -> k, asOption (d1.TryGetValue(k)), asOption (d2.TryGetValue(k)) ] // ------------------------------------------------------------------------------------------------ @@ -136,7 +177,12 @@ let private subtypePrimitives typ1 typ2 = /// Active pattern that calls `subtypePrimitives` on two primitive types let private (|SubtypePrimitives|_|) allowEmptyValues = function - | InferedType.Primitive (t1, u1, o1), InferedType.Primitive (t2, u2, o2) -> + // When a type should override the other, make sure we preserve optionality + // (so that null and inline schemas are always considered at the same level of importance) + | InferedType.Primitive (t, u, o1, true), InferedType.Primitive (_, _, o2, false) + | InferedType.Primitive (_, _, o2, false), InferedType.Primitive (t, u, o1, true) -> Some(t, u, o1 || o2, true) + | InferedType.Primitive (t1, u1, o1, x1), InferedType.Primitive (t2, u2, o2, x2) -> + // Re-annotate with the unit, if it is the same one match subtypePrimitives t1 t2 with | Some t -> @@ -149,7 +195,8 @@ let private (|SubtypePrimitives|_|) allowEmptyValues = && InferedType.CanHaveEmptyValues t ) - Some(t, unit, optional) + assert (x1 = x2) // The other cases should be handled above. + Some(t, unit, optional, x1) | _ -> None | _ -> None @@ -175,10 +222,17 @@ let rec subtypeInfered allowEmptyValues ot1 ot2 = InferedType.Record(n1, unionRecordTypes allowEmptyValues t1 t2, o1 || o2) | InferedType.Json (t1, o1), InferedType.Json (t2, o2) -> InferedType.Json(subtypeInfered allowEmptyValues t1 t2, o1 || o2) - | InferedType.Heterogeneous t1, InferedType.Heterogeneous t2 -> - InferedType.Heterogeneous(unionHeterogeneousTypes allowEmptyValues t1 t2) + | InferedType.Heterogeneous (t1, o1), InferedType.Heterogeneous (t2, o2) -> + InferedType.Heterogeneous( + let map, containsOptional = unionHeterogeneousTypes allowEmptyValues t1 t2 + map |> Map.ofList, containsOptional || o1 || o2 + ) | InferedType.Collection (o1, t1), InferedType.Collection (o2, t2) -> - InferedType.Collection(unionCollectionOrder o1 o2, unionCollectionTypes allowEmptyValues t1 t2) + InferedType.Collection( + unionCollectionOrder o1 o2, + unionCollectionTypes allowEmptyValues t1 t2 + |> Map.ofList + ) // Top type can be merged with anything else | t, InferedType.Top @@ -186,33 +240,91 @@ let rec subtypeInfered allowEmptyValues ot1 ot2 = // Merging with Null type will make a type optional if it's not already | t, InferedType.Null | InferedType.Null, t -> t.EnsuresHandlesMissingValues allowEmptyValues + // Heterogeneous can be merged with any type - | InferedType.Heterogeneous h, other - | other, InferedType.Heterogeneous h -> + | InferedType.Heterogeneous (h, o), other + | other, InferedType.Heterogeneous (h, o) -> // Add the other type as another option. We should never add // heterogeneous type as an option of other heterogeneous type. assert (typeTag other <> InferedTypeTag.Heterogeneous) - InferedType.Heterogeneous(unionHeterogeneousTypes allowEmptyValues h (Map.ofSeq [ typeTag other, other ])) + + let tagMerged, containsOptional = + unionHeterogeneousTypes allowEmptyValues h (Map.ofSeq [ typeTag other, other ]) + + let containsOptional = containsOptional || o + + // When other is a primitive infered from an inline schema in overriding mode, + // try to replace the heterogeneous type with the overriding primitive: + match other with + | InferedType.Primitive (_, _, _, true) -> + let primitiveOverrides, nonPrimitives = + let primitiveOverrides, nonPrimitives = ResizeArray(), ResizeArray() + + tagMerged + |> List.iter (fun (tag, typ) -> + match typ with + | InferedType.Primitive (_, _, _, true) -> primitiveOverrides.Add(tag, typ) + | InferedType.Primitive (_, _, _, false) -> () // We don't need to track normal primitives + | _ -> nonPrimitives.Add(tag, typ)) + + primitiveOverrides |> List.ofSeq, nonPrimitives |> List.ofSeq + + // For all the following cases, if there is at least one overriding primitive, + // normal primitives are discarded. + match primitiveOverrides, nonPrimitives with + // No overriding primitives. Just return the heterogeneous type. + | [], _ -> InferedType.Heterogeneous(tagMerged |> Map.ofList, containsOptional) + // If there is a single overriding primitive and no non-primitive, + // return only this overriding primitive (and take care to reestablish optionality if needed). + | [ (_, singlePrimitive) ], [] -> + match singlePrimitive with + | InferedType.Primitive (t, u, o, x) -> InferedType.Primitive(t, u, o || containsOptional, x) + | _ -> failwith "There should be only primitive types here." + // If there are non primitives, keep the heterogeneous type. + | [ singlePrimitive ], nonPrimitives -> + InferedType.Heterogeneous(singlePrimitive :: nonPrimitives |> Map.ofList, containsOptional) + // If there are more than one overriding primitive, also keep the heterogeneous type + | primitives, nonPrimitives -> + InferedType.Heterogeneous(primitives @ nonPrimitives |> Map.ofList, containsOptional) + + | _otherType -> InferedType.Heterogeneous(tagMerged |> Map.ofList, containsOptional) // Otherwise the types are incompatible so we build a new heterogeneous type | t1, t2 -> let h1, h2 = Map.ofSeq [ typeTag t1, t1 ], Map.ofSeq [ typeTag t2, t2 ] - InferedType.Heterogeneous(unionHeterogeneousTypes allowEmptyValues h1 h2) + + InferedType.Heterogeneous( + let map, containsOptional = unionHeterogeneousTypes allowEmptyValues h1 h2 + map |> Map.ofList, containsOptional + ) + +// debug: change the function to return `result`, +// and paste the following in a debug tracepoint before returning the result: +// {ot1f}\nAND\n{ot2f}\nGIVES\n{resultf}\n +//let ot1f, ot2f, resultf = sprintf "%A" ot1, sprintf "%A" ot2, sprintf "%A" result +//ot1f |> ignore +//ot2f |> ignore +//resultf |> ignore /// Given two heterogeneous types, get a single type that can represent all the /// types that the two heterogeneous types can. -/// Heterogeneous types already handle optionality on their own, so we drop -/// optionality from all its inner types and private unionHeterogeneousTypes allowEmptyValues cases1 cases2 = + let mutable containsOptional = false + List.pairBy (fun (KeyValue (k, _)) -> k) cases1 cases2 |> List.map (fun (tag, fst, snd) -> match tag, fst, snd with | tag, Some (KeyValue (_, t)), None - | tag, None, Some (KeyValue (_, t)) -> tag, t.DropOptionality() + | tag, None, Some (KeyValue (_, t)) -> + let typ, wasOptional = t.GetDropOptionality() + containsOptional <- containsOptional || wasOptional + tag, typ | tag, Some (KeyValue (_, t1)), Some (KeyValue (_, t2)) -> - tag, (subtypeInfered allowEmptyValues t1 t2).DropOptionality() - | _ -> failwith "unionHeterogeneousTypes: pairBy returned None, None") - |> Map.ofList + let typ, wasOptional = (subtypeInfered allowEmptyValues t1 t2).GetDropOptionality() + containsOptional <- containsOptional || wasOptional + tag, typ + | _ -> failwith "unionHeterogeneousTypes: pairBy returned None, None"), + containsOptional /// A collection can contain multiple types - in that case, we do keep /// the multiplicity for each different type tag to generate better types @@ -241,8 +353,7 @@ and private unionCollectionTypes allowEmptyValues cases1 cases2 = let t = subtypeInfered allowEmptyValues t1 t2 let t = if m <> Single then t.DropOptionality() else t tag, (m, t) - | _ -> failwith "unionHeterogeneousTypes: pairBy returned None, None") - |> Map.ofList + | _ -> failwith "unionCollectionTypes: pairBy returned None, None") and unionCollectionOrder order1 order2 = order1 @@ -281,11 +392,117 @@ let inferCollectionType allowEmptyValues types = InferedType.Collection(List.map fst groupedTypes, Map.ofList groupedTypes) +type IUnitsOfMeasureProvider = + abstract SI: str: string -> System.Type + abstract Product: measure1: System.Type * measure2: System.Type -> System.Type + abstract Inverse: denominator: System.Type -> System.Type + +let defaultUnitsOfMeasureProvider = + { new IUnitsOfMeasureProvider with + member x.SI(_) : Type = null + member x.Product(_, _) = failwith "Not implemented yet" + member x.Inverse(_) = failwith "Not implemented yet" } + +let private uomTransformations = + [ [ "²"; "^2" ], (fun (provider: IUnitsOfMeasureProvider) t -> provider.Product(t, t)) + [ "³"; "^3" ], (fun (provider: IUnitsOfMeasureProvider) t -> provider.Product(provider.Product(t, t), t)) + [ "^-1" ], (fun (provider: IUnitsOfMeasureProvider) t -> provider.Inverse(t)) ] + +let parseUnitOfMeasure (provider: IUnitsOfMeasureProvider) (str: string) = + let unit = + uomTransformations + |> List.collect (fun (suffixes, trans) -> suffixes |> List.map (fun suffix -> suffix, trans)) + |> List.tryPick (fun (suffix, trans) -> + if str.EndsWith suffix then + let baseUnitStr = str.[.. str.Length - suffix.Length - 1] + let baseUnit = provider.SI baseUnitStr + + if baseUnit = null then + None + else + baseUnit |> trans provider |> Some + else + None) + + match unit with + | Some _ -> unit + | None -> + let unit = provider.SI str + if unit = null then None else Some unit + +/// The inferred types may be set explicitly via inline schemas. +/// This table specifies the mapping from (the names that users can use) to (the types used). +let nameToType = + [ "int", (typeof, TypeWrapper.None) + "int64", (typeof, TypeWrapper.None) + "bool", (typeof, TypeWrapper.None) + "float", (typeof, TypeWrapper.None) + "decimal", (typeof, TypeWrapper.None) + "date", (typeof, TypeWrapper.None) + "datetimeoffset", (typeof, TypeWrapper.None) + "timespan", (typeof, TypeWrapper.None) + "guid", (typeof, TypeWrapper.None) + "string", (typeof, TypeWrapper.None) ] + |> dict + +// type is valid while it shouldn't, but well... +let private typeAndUnitRegex = + lazy Regex(@"^(?.+)(<|{)(?.+)(>|})$", RegexOptions.Compiled ||| RegexOptions.RightToLeft) + +/// Matches a value of the form "typeof" where the nested value is of the form "type" or just "type". +/// ({} instead of <> is allowed so it can be used in xml) +let private validInlineSchema = + lazy + Regex( + @"^typeof(<|{)" + + @"(?(?[^<>{}\s]+)|(?[^<>{}\s]+(<|{)[^<>{}\s]+(>|})))" + + @"(>|})$", + RegexOptions.Compiled + ) + +/// +/// Parses type specification in the schema for a single value. +/// This can be of the form: type|measure|type<measure> +/// type{measure} is also supported to ease definition in xml values. +/// +let parseTypeAndUnit unitsOfMeasureProvider (nameToType: IDictionary) str = + let m = typeAndUnitRegex.Value.Match(str) + + if m.Success then + // type case, both type and unit have to be valid + let typ = + m.Groups.["type"].Value.TrimEnd().ToLowerInvariant() + |> nameToType.TryGetValue + |> asOption + + match typ with + | None -> None, None + | Some typ -> + let unitName = m.Groups.["unit"].Value.Trim() + let unit = parseUnitOfMeasure unitsOfMeasureProvider unitName + + if unit.IsNone then + failwithf "Invalid unit of measure %s" unitName + else + Some typ, unit + else + // it is not a full type with unit, so it can be either type or a unit + let typ = + str.ToLowerInvariant() + |> nameToType.TryGetValue + |> asOption + + match typ with + | Some (typ, typWrapper) -> + // Just type + Some(typ, typWrapper), None + | None -> + // Just unit (or nothing) + None, parseUnitOfMeasure unitsOfMeasureProvider str + [] module private Helpers = - open System.Text.RegularExpressions - let wordRegex = lazy Regex("\\w+", RegexOptions.Compiled) let numberOfNumberGroups value = @@ -294,9 +511,18 @@ module private Helpers = |> Seq.choose (fun (x: Match) -> TextConversions.AsInteger CultureInfo.InvariantCulture x.Value) |> Seq.length -/// Infers the type of a simple string value +/// Infers the type of a string value /// Returns one of null|typeof|typeof|typeof|typeof|typeof|typeof|typeof|typeof|typeof|typeof|typeof -let inferPrimitiveType (cultureInfo: CultureInfo) (value: string) = +/// with the desiredUnit applied, +/// or a value parsed from an inline schema. +/// (For inline schemas, the unit parsed from the schema takes precedence over desiredUnit when present) +let inferPrimitiveType + (unitsOfMeasureProvider: IUnitsOfMeasureProvider) + (inferenceMode: InferenceMode') + (cultureInfo: CultureInfo) + (value: string) + (desiredUnit: Type option) + = // Helper for calling TextConversions.AsXyz functions let (|Parse|_|) func value = func cultureInfo value @@ -325,62 +551,69 @@ let inferPrimitiveType (cultureInfo: CultureInfo) (value: string) = || value.IndexOf(getAbbreviatedEraName era, StringComparison.OrdinalIgnoreCase) >= 0) - match value with - | "" -> null - | Parse TextConversions.AsInteger 0 -> typeof - | Parse TextConversions.AsInteger 1 -> typeof - | ParseNoCulture TextConversions.AsBoolean _ -> typeof - | Parse TextConversions.AsInteger _ -> typeof - | Parse TextConversions.AsInteger64 _ -> typeof - | Parse TextConversions.AsTimeSpan _ -> typeof - | Parse TextConversions.AsDateTimeOffset dateTimeOffset when not (isFakeDate dateTimeOffset.UtcDateTime value) -> - typeof - | Parse TextConversions.AsDateTime date when not (isFakeDate date value) -> typeof - | Parse TextConversions.AsDecimal _ -> typeof - | Parse (TextConversions.AsFloat [||] false) _ -> typeof - | Parse asGuid _ -> typeof - | _ -> typeof - -/// Infers the type of a simple string value -let getInferedTypeFromString cultureInfo value unit = - match inferPrimitiveType cultureInfo value with - | null -> InferedType.Null - | typ -> InferedType.Primitive(typ, unit, false) - -type IUnitsOfMeasureProvider = - abstract SI: str: string -> System.Type - abstract Product: measure1: System.Type * measure2: System.Type -> System.Type - abstract Inverse: denominator: System.Type -> System.Type - -let defaultUnitsOfMeasureProvider = - { new IUnitsOfMeasureProvider with - member x.SI(_) : Type = null - member x.Product(_, _) = failwith "Not implemented yet" - member x.Inverse(_) = failwith "Not implemented yet" } - -let private uomTransformations = - [ [ "²"; "^2" ], (fun (provider: IUnitsOfMeasureProvider) t -> provider.Product(t, t)) - [ "³"; "^3" ], (fun (provider: IUnitsOfMeasureProvider) t -> provider.Product(provider.Product(t, t), t)) - [ "^-1" ], (fun (provider: IUnitsOfMeasureProvider) t -> provider.Inverse(t)) ] - -let parseUnitOfMeasure (provider: IUnitsOfMeasureProvider) (str: string) = - let unit = - uomTransformations - |> List.collect (fun (suffixes, trans) -> suffixes |> List.map (fun suffix -> suffix, trans)) - |> List.tryPick (fun (suffix, trans) -> - if str.EndsWith suffix then - let baseUnitStr = str.[.. str.Length - suffix.Length - 1] - let baseUnit = provider.SI baseUnitStr + let matchValue value = + let makePrimitive typ = + Some(InferedType.Primitive(typ, desiredUnit, false, false)) + + match value with + | "" -> Some InferedType.Null + | Parse TextConversions.AsInteger 0 -> makePrimitive typeof + | Parse TextConversions.AsInteger 1 -> makePrimitive typeof + | ParseNoCulture TextConversions.AsBoolean _ -> makePrimitive typeof + | Parse TextConversions.AsInteger _ -> makePrimitive typeof + | Parse TextConversions.AsInteger64 _ -> makePrimitive typeof + | Parse TextConversions.AsTimeSpan _ -> makePrimitive typeof + | Parse TextConversions.AsDateTimeOffset dateTimeOffset when not (isFakeDate dateTimeOffset.UtcDateTime value) -> + makePrimitive typeof + | Parse TextConversions.AsDateTime date when not (isFakeDate date value) -> makePrimitive typeof + | Parse TextConversions.AsDecimal _ -> makePrimitive typeof + | Parse (TextConversions.AsFloat [||] false) _ -> makePrimitive typeof + | Parse asGuid _ -> makePrimitive typeof + | _ -> None - if baseUnit = null then - None - else - baseUnit |> trans provider |> Some - else - None) + /// Parses values looking like "typeof or typeof>" and returns the appropriate type. + let matchInlineSchema useInlineSchemasOverrides value = + match value with + | "" -> Some InferedType.Null + | nonEmptyValue -> + // Validates that it looks like an inline schema before trying to extract the type and unit: + let m = validInlineSchema.Value.Match(nonEmptyValue) + + match m.Success with + | false -> None + | true -> + let typ, unit = + parseTypeAndUnit unitsOfMeasureProvider nameToType m.Groups.["typeDefinition"].Value + + let unit = if unit.IsNone then desiredUnit else unit + + match typ, unit with + | None, _ -> None + | Some (typ, typeWrapper), unit -> + match typeWrapper with + | TypeWrapper.None -> Some(InferedType.Primitive(typ, unit, false, useInlineSchemasOverrides)) + // To keep it simple and prevent weird situations (and preserve backward compat), + // only structural inference can create optional types. + // Optional types in inline schemas are not allowed. + | TypeWrapper.Option -> failwith "Option types are not allowed in inline schemas." + | TypeWrapper.Nullable -> failwith "Nullable types are not allowed in inline schemas." + + let fallbackType = InferedType.Primitive(typeof, None, false, false) + + match inferenceMode with + | InferenceMode'.NoInference -> fallbackType + | InferenceMode'.ValuesOnly -> + matchValue value + |> Option.defaultValue fallbackType + | InferenceMode'.ValuesAndInlineSchemasHints -> + matchInlineSchema false value + |> Option.orElseWith (fun () -> matchValue value) + |> Option.defaultValue fallbackType + | InferenceMode'.ValuesAndInlineSchemasOverrides -> + matchInlineSchema true value + |> Option.orElseWith (fun () -> matchValue value) + |> Option.defaultValue fallbackType - match unit with - | Some _ -> unit - | None -> - let unit = provider.SI str - if unit = null then None else Some unit +/// Infers the type of a simple string value +let getInferedTypeFromString unitsOfMeasureProvider inferenceMode cultureInfo value unit = + inferPrimitiveType unitsOfMeasureProvider inferenceMode cultureInfo value unit diff --git a/src/CommonRuntime/StructuralTypes.fs b/src/CommonRuntime/StructuralTypes.fs index 62f25ca7d..11483deb1 100644 --- a/src/CommonRuntime/StructuralTypes.fs +++ b/src/CommonRuntime/StructuralTypes.fs @@ -62,11 +62,11 @@ type InferedTypeTag = /// to generate nicer types! [] type InferedType = - | Primitive of typ: Type * unit: option * optional: bool + | Primitive of typ: Type * unit: option * optional: bool * shouldOverrideOnMerge: bool | Record of name: string option * fields: InferedProperty list * optional: bool | Json of typ: InferedType * optional: bool | Collection of order: InferedTypeTag list * types: Map - | Heterogeneous of types: Map + | Heterogeneous of types: Map * containsOptional: bool | Null | Top @@ -86,16 +86,17 @@ type InferedType = member x.EnsuresHandlesMissingValues allowEmptyValues = match x with | Null - | Heterogeneous _ + | Heterogeneous(containsOptional = true) | Primitive(optional = true) | Record(optional = true) | Json(optional = true) -> x - | Primitive (typ, _, false) when + | Primitive (typ, _, false, _) when allowEmptyValues && InferedType.CanHaveEmptyValues typ -> x - | Primitive (typ, unit, false) -> Primitive(typ, unit, true) + | Heterogeneous (map, false) -> Heterogeneous(map, true) + | Primitive (typ, unit, false, overrideOnMerge) -> Primitive(typ, unit, true, overrideOnMerge) | Record (name, props, false) -> Record(name, props, true) | Json (typ, false) -> Json(typ, true) | Collection (order, types) -> @@ -106,12 +107,15 @@ type InferedType = Collection(order, typesR) | Top -> failwith "EnsuresHandlesMissingValues: unexpected InferedType.Top" - member x.DropOptionality() = + member x.GetDropOptionality() = match x with - | Primitive (typ, unit, true) -> Primitive(typ, unit, false) - | Record (name, props, true) -> Record(name, props, false) - | Json (typ, true) -> Json(typ, false) - | _ -> x + | Primitive (typ, unit, true, overrideOnMerge) -> Primitive(typ, unit, false, overrideOnMerge), true + | Record (name, props, true) -> Record(name, props, false), true + | Json (typ, true) -> Json(typ, false), true + | Heterogeneous (map, true) -> Heterogeneous(map, false), true + | _ -> x, false + + member x.DropOptionality() = x.GetDropOptionality() |> fst // We need to implement custom equality that returns 'true' when // values reference the same object (to support recursive types) @@ -121,11 +125,11 @@ type InferedType = if y :? InferedType then match x, y :?> InferedType with | a, b when Object.ReferenceEquals(a, b) -> true - | Primitive (t1, ot1, b1), Primitive (t2, ot2, b2) -> t1 = t2 && ot1 = ot2 && b1 = b2 + | Primitive (t1, ot1, b1, x1), Primitive (t2, ot2, b2, x2) -> t1 = t2 && ot1 = ot2 && b1 = b2 && x1 = x2 | Record (s1, pl1, b1), Record (s2, pl2, b2) -> s1 = s2 && pl1 = pl2 && b1 = b2 | Json (t1, o1), Json (t2, o2) -> t1 = t2 && o1 = o2 | Collection (o1, t1), Collection (o2, t2) -> o1 = o2 && t1 = t2 - | Heterogeneous (m1), Heterogeneous (m2) -> m1 = m2 + | Heterogeneous (m1, o1), Heterogeneous (m2, o2) -> m1 = m2 && o1 = o2 | Null, Null | Top, Top -> true | _ -> false diff --git a/src/Csv/CsvInference.fs b/src/Csv/CsvInference.fs index 201bb8f6c..afee7a315 100644 --- a/src/Csv/CsvInference.fs +++ b/src/Csv/CsvInference.fs @@ -10,46 +10,34 @@ open FSharp.Data.Runtime open FSharp.Data.Runtime.StructuralTypes open FSharp.Data.Runtime.StructuralInference -/// The schema may be set explicitly. This table specifies the mapping -/// from the names that users can use to the types used. -let private nameToType = - [ "int", (typeof, TypeWrapper.None) - "int64", (typeof, TypeWrapper.None) - "bool", (typeof, TypeWrapper.None) - "float", (typeof, TypeWrapper.None) - "decimal", (typeof, TypeWrapper.None) - "date", (typeof, TypeWrapper.None) - "datetimeoffset", (typeof, TypeWrapper.None) - "timespan", (typeof, TypeWrapper.None) - "guid", (typeof, TypeWrapper.None) - "string", (typeof, TypeWrapper.None) - "int?", (typeof, TypeWrapper.Nullable) - "int64?", (typeof, TypeWrapper.Nullable) - "bool?", (typeof, TypeWrapper.Nullable) - "float?", (typeof, TypeWrapper.Nullable) - "decimal?", (typeof, TypeWrapper.Nullable) - "date?", (typeof, TypeWrapper.Nullable) - "datetimeoffset?", (typeof, TypeWrapper.Nullable) - "timespan?", (typeof, TypeWrapper.Nullable) - "guid?", (typeof, TypeWrapper.Nullable) - "int option", (typeof, TypeWrapper.Option) - "int64 option", (typeof, TypeWrapper.Option) - "bool option", (typeof, TypeWrapper.Option) - "float option", (typeof, TypeWrapper.Option) - "decimal option", (typeof, TypeWrapper.Option) - "date option", (typeof, TypeWrapper.Option) - "datetimeoffset option", (typeof, TypeWrapper.Option) - "timespan option", (typeof, TypeWrapper.Option) - "guid option", (typeof, TypeWrapper.Option) - "string option", (typeof, TypeWrapper.Option) ] +/// This table specifies the mapping from (the names that users can use) to (the types used). +/// The table here for the CsvProvider extends the mapping used for inline schemas by adding nullable and optionals. +let private nameToTypeForCsv = + [ for KeyValue (k, v) in StructuralInference.nameToType -> k, v ] + @ [ "int?", (typeof, TypeWrapper.Nullable) + "int64?", (typeof, TypeWrapper.Nullable) + "bool?", (typeof, TypeWrapper.Nullable) + "float?", (typeof, TypeWrapper.Nullable) + "decimal?", (typeof, TypeWrapper.Nullable) + "date?", (typeof, TypeWrapper.Nullable) + "datetimeoffset?", (typeof, TypeWrapper.Nullable) + "timespan?", (typeof, TypeWrapper.Nullable) + "guid?", (typeof, TypeWrapper.Nullable) + "int option", (typeof, TypeWrapper.Option) + "int64 option", (typeof, TypeWrapper.Option) + "bool option", (typeof, TypeWrapper.Option) + "float option", (typeof, TypeWrapper.Option) + "decimal option", (typeof, TypeWrapper.Option) + "date option", (typeof, TypeWrapper.Option) + "datetimeoffset option", (typeof, TypeWrapper.Option) + "timespan option", (typeof, TypeWrapper.Option) + "guid option", (typeof, TypeWrapper.Option) + "string option", (typeof, TypeWrapper.Option) ] |> dict let private nameAndTypeRegex = lazy Regex(@"^(?.+)\((?.+)\)$", RegexOptions.Compiled ||| RegexOptions.RightToLeft) -let private typeAndUnitRegex = - lazy Regex(@"^(?.+)<(?.+)>$", RegexOptions.Compiled ||| RegexOptions.RightToLeft) - let private overrideByNameRegex = lazy Regex( @@ -65,56 +53,15 @@ type private SchemaParseResult = | FullByName of property: PrimitiveInferedProperty * originalName: string | Rename of name: string * originalName: string -let private asOption = - function - | true, x -> Some x - | false, _ -> None - -/// -/// Parses type specification in the schema for a single column. -/// This can be of the form: type|measure|type<measure> -/// -let private parseTypeAndUnit unitsOfMeasureProvider str = - let m = typeAndUnitRegex.Value.Match(str) - - if m.Success then - // type case, both type and unit have to be valid - let typ = - m.Groups.["type"].Value.TrimEnd().ToLowerInvariant() - |> nameToType.TryGetValue - |> asOption - - match typ with - | None -> None, None - | Some typ -> - let unitName = m.Groups.["unit"].Value.Trim() - let unit = StructuralInference.parseUnitOfMeasure unitsOfMeasureProvider unitName - - if unit.IsNone then - failwithf "Invalid unit of measure %s" unitName - else - Some typ, unit - else - // it is not a full type with unit, so it can be either type or a unit - let typ = - str.ToLowerInvariant() - |> nameToType.TryGetValue - |> asOption - - match typ with - | Some (typ, typWrapper) -> - // Just type - Some(typ, typWrapper), None - | None -> - // Just unit (or nothing) - None, StructuralInference.parseUnitOfMeasure unitsOfMeasureProvider str - /// Parse schema specification for column. This can either be a name /// with type or just type: name (typeInfo)|typeInfo. /// If forSchemaOverride is set to true, only Full or Name is returned /// (if we succeed we override the inferred schema, otherwise, we just /// override the header name) let private parseSchemaItem unitsOfMeasureProvider str forSchemaOverride = + let parseTypeAndUnit = + StructuralInference.parseTypeAndUnit unitsOfMeasureProvider nameToTypeForCsv + let name, typ, unit, isOverrideByName, originalName = let m = overrideByNameRegex.Value.Match str @@ -123,7 +70,7 @@ let private parseSchemaItem unitsOfMeasureProvider str forSchemaOverride = let originalName = m.Groups.["name"].Value.TrimEnd() let newName = m.Groups.["newName"].Value.Trim() let typeAndUnit = m.Groups.["type"].Value.Trim() - let typ, unit = parseTypeAndUnit unitsOfMeasureProvider typeAndUnit + let typ, unit = parseTypeAndUnit typeAndUnit if typ.IsNone && typeAndUnit <> "" then failwithf "Invalid type: %s" typeAndUnit @@ -136,11 +83,11 @@ let private parseSchemaItem unitsOfMeasureProvider str forSchemaOverride = // name (type|measure|type) let name = m.Groups.["name"].Value.TrimEnd() let typeAndUnit = m.Groups.["type"].Value.Trim() - let typ, unit = parseTypeAndUnit unitsOfMeasureProvider typeAndUnit + let typ, unit = parseTypeAndUnit typeAndUnit name, typ, unit, false, "" elif forSchemaOverride then // type|type - let typ, unit = parseTypeAndUnit unitsOfMeasureProvider str + let typ, unit = parseTypeAndUnit str match typ, unit with | None, _ -> str, None, None, false, "" @@ -162,18 +109,26 @@ let private parseSchemaItem unitsOfMeasureProvider str forSchemaOverride = | None, Some _ when forSchemaOverride -> SchemaParseResult.Name str | None, Some unit -> SchemaParseResult.NameAndUnit(name, unit) -let internal inferCellType preferOptionals missingValues cultureInfo unit (value: string) = +let internal inferCellType + unitsOfMeasureProvider + preferOptionals + missingValues + inferenceMode + cultureInfo + unit + (value: string) + = // Explicit missing values (NaN, NA, Empty string etc.) will be treated as float unless the preferOptionals is set to true if Array.exists (value.Trim() |> (=)) missingValues then if preferOptionals then InferedType.Null else - InferedType.Primitive(typeof, unit, false) + InferedType.Primitive(typeof, unit, false, false) // If there's only whitespace between commas, treat it as a missing value and not as a string elif String.IsNullOrWhiteSpace value then InferedType.Null else - getInferedTypeFromString cultureInfo value unit + StructuralInference.getInferedTypeFromString unitsOfMeasureProvider inferenceMode cultureInfo value unit let internal parseHeaders headers numberOfColumns schema unitsOfMeasureProvider = @@ -282,9 +237,11 @@ let internal inferType (rows: seq<_>) inferRows missingValues + inferenceMode cultureInfo assumeMissingValues preferOptionals + unitsOfMeasureProvider = // If we have no data, generate one empty row with empty strings, @@ -328,7 +285,15 @@ let internal inferType let typ = match schema with | Some _ -> InferedType.Null // this will be ignored, so just return anything - | None -> inferCellType preferOptionals missingValues cultureInfo unit value + | None -> + inferCellType + unitsOfMeasureProvider + preferOptionals + missingValues + inferenceMode + cultureInfo + unit + value { Name = name; Type = typ } ] @@ -377,7 +342,7 @@ let internal getFields preferOptionals inferedType schema = field.Name, field.Name match field.Type with - | InferedType.Primitive (typ, unit, optional) -> + | InferedType.Primitive (typ, unit, optional, _) -> // Transform the types as described above let typ, typWrapper = @@ -420,11 +385,23 @@ let internal inferColumnTypes rows inferRows missingValues + inferenceMode cultureInfo assumeMissingValues preferOptionals + unitsOfMeasureProvider = - inferType headerNamesAndUnits schema rows inferRows missingValues cultureInfo assumeMissingValues preferOptionals + inferType + headerNamesAndUnits + schema + rows + inferRows + missingValues + inferenceMode + cultureInfo + assumeMissingValues + preferOptionals + unitsOfMeasureProvider ||> getFields preferOptionals type CsvFile with @@ -442,14 +419,13 @@ type CsvFile with ( inferRows, missingValues, + inferenceMode, cultureInfo, schema, assumeMissingValues, preferOptionals, - [] ?unitsOfMeasureProvider + unitsOfMeasureProvider ) = - let unitsOfMeasureProvider = - defaultArg unitsOfMeasureProvider defaultUnitsOfMeasureProvider let headerNamesAndUnits, schema = parseHeaders x.Headers x.NumberOfColumns schema unitsOfMeasureProvider @@ -460,6 +436,8 @@ type CsvFile with (x.Rows |> Seq.map (fun row -> row.Columns)) inferRows missingValues + inferenceMode cultureInfo assumeMissingValues preferOptionals + unitsOfMeasureProvider diff --git a/src/Csv/CsvProvider.fs b/src/Csv/CsvProvider.fs index 6482608df..fa6a6ec0a 100644 --- a/src/Csv/CsvProvider.fs +++ b/src/Csv/CsvProvider.fs @@ -14,6 +14,7 @@ open FSharp.Data.Runtime open FSharp.Data.Runtime.CsvInference open ProviderImplementation open ProviderImplementation.QuotationBuilder +open FSharp.Data.Runtime.StructuralInference // -------------------------------------------------------------------------------------- @@ -52,6 +53,11 @@ type public CsvProvider(cfg: TypeProviderConfig) as this = let resolutionFolder = args.[14] :?> string let resource = args.[15] :?> string + // This provider already has a schema mechanism, so let's disable inline schemas. + let inferenceMode = InferenceMode'.ValuesOnly + + let unitsOfMeasureProvider = ProviderHelpers.unitsOfMeasureProvider + if sample = "" then if schema = "" then failwith "When the Sample parameter is not specified, the Schema parameter must be provided" @@ -101,11 +107,12 @@ type public CsvProvider(cfg: TypeProviderConfig) as this = sampleCsv.InferColumnTypes( inferRows, TextRuntime.GetMissingValues missingValuesStr, + inferenceMode, TextRuntime.GetCulture cultureStr, schema, assumeMissingValues, preferOptionals, - ProviderHelpers.unitsOfMeasureProvider + unitsOfMeasureProvider ) use _holder = IO.logTime "TypeGeneration" sample @@ -227,7 +234,7 @@ type public CsvProvider(cfg: TypeProviderConfig) as this = Location of a CSV sample file or a string containing a sample CSV document. Column delimiter(s). Defaults to ,. Number of rows to use for inference. Defaults to 1000. If this is zero, all rows are used. - 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. + Optional column types, in a comma separated list. Valid types are int, int64, bool, float, decimal, date, datetimeoffset, timespan, guid, string, int?, int64?, bool?, float?, decimal?, date?, datetimeoffset?, timespan?, guid?, int option, int64 option, bool option, float option, decimal option, date option, datetimeoffset option, timespan 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. Whether the sample contains the names of the columns as its first line. 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. diff --git a/src/Html/HtmlGenerator.fs b/src/Html/HtmlGenerator.fs index 964ac4661..e3e687dc2 100644 --- a/src/Html/HtmlGenerator.fs +++ b/src/Html/HtmlGenerator.fs @@ -1,4 +1,4 @@ -// -------------------------------------------------------------------------------------- +// -------------------------------------------------------------------------------------- // HTML type provider - generate code for accessing inferred elements // -------------------------------------------------------------------------------------- namespace ProviderImplementation @@ -132,7 +132,7 @@ module internal HtmlGenerator = let listItemType, conv = match columns with - | InferedType.Primitive (typ, _, optional) -> + | InferedType.Primitive (typ, _, optional, _) -> let typ, _, conv, _convBack = ConversionsGenerator.convertStringValue missingValuesStr @@ -194,7 +194,7 @@ module internal HtmlGenerator = let listItemType, conv = match columns with - | StructuralTypes.InferedType.Primitive (typ, _, optional) -> + | StructuralTypes.InferedType.Primitive (typ, _, optional, _) -> let typ, _, conv, _convBack = ConversionsGenerator.convertStringValue missingValuesStr diff --git a/src/Html/HtmlInference.fs b/src/Html/HtmlInference.fs index 9e7e341eb..8882a4736 100644 --- a/src/Html/HtmlInference.fs +++ b/src/Html/HtmlInference.fs @@ -1,4 +1,4 @@ -/// Structural inference for HTML tables +/// Structural inference for HTML tables module FSharp.Data.Runtime.HtmlInference open System @@ -11,7 +11,8 @@ type Parameters = { MissingValues: string[] CultureInfo: CultureInfo UnitsOfMeasureProvider: IUnitsOfMeasureProvider - PreferOptionals: bool } + PreferOptionals: bool + InferenceMode: InferenceMode' } let inferColumns parameters (headerNamesAndUnits: _[]) rows = @@ -25,9 +26,11 @@ let inferColumns parameters (headerNamesAndUnits: _[]) rows = rows inferRows parameters.MissingValues + parameters.InferenceMode parameters.CultureInfo assumeMissingValues parameters.PreferOptionals + parameters.UnitsOfMeasureProvider let inferHeaders parameters (rows: string[][]) = if rows.Length <= 2 then @@ -62,9 +65,14 @@ let inferListType parameters (values: string[]) = if parameters.PreferOptionals then InferedType.Null else - InferedType.Primitive(typeof, None, false) + InferedType.Primitive(typeof, None, false, false) else - getInferedTypeFromString parameters.CultureInfo value None + getInferedTypeFromString + parameters.UnitsOfMeasureProvider + parameters.InferenceMode + parameters.CultureInfo + value + None values |> Array.map inferedtype diff --git a/src/Html/HtmlProvider.fs b/src/Html/HtmlProvider.fs index 6363b83ef..432f24bf1 100644 --- a/src/Html/HtmlProvider.fs +++ b/src/Html/HtmlProvider.fs @@ -10,6 +10,7 @@ open ProviderImplementation.ProvidedTypes open FSharp.Data open FSharp.Data.Runtime open FSharp.Data.Runtime.BaseTypes +open FSharp.Data.Runtime.StructuralInference #nowarn "10001" @@ -40,6 +41,10 @@ type public HtmlProvider(cfg: TypeProviderConfig) as this = let resolutionFolder = args.[6] :?> string let resource = args.[7] :?> string + // Allowing inline schemas does not seem very valuable for this provider. + // Let's stick to the default values for now. + let inferenceMode = InferenceMode'.ValuesOnly + let getSpec _ value = let doc = @@ -53,7 +58,8 @@ type public HtmlProvider(cfg: TypeProviderConfig) as this = { MissingValues = TextRuntime.GetMissingValues missingValuesStr CultureInfo = TextRuntime.GetCulture cultureStr UnitsOfMeasureProvider = ProviderHelpers.unitsOfMeasureProvider - PreferOptionals = preferOptionals } + PreferOptionals = preferOptionals + InferenceMode = inferenceMode } doc |> HtmlRuntime.getHtmlObjects (Some inferenceParameters) includeLayoutTables @@ -93,7 +99,8 @@ type public HtmlProvider(cfg: TypeProviderConfig) as this = 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. A directory that is used when resolving relative file references (at design time and in hosted execution). When specified, the type provider first attempts to load the sample from the specified resource - (e.g. 'MyCompany.MyAssembly, resource_name.html'). This is useful when exposing types generated by the type provider.""" + (e.g. 'MyCompany.MyAssembly, resource_name.html'). This is useful when exposing types generated by the type provider. + """ do htmlProvTy.AddXmlDoc helpText do htmlProvTy.DefineStaticParameters(parameters, buildTypes) diff --git a/src/Json/JsonConversionsGenerator.fs b/src/Json/JsonConversionsGenerator.fs index 3805e702d..ab2ab2988 100644 --- a/src/Json/JsonConversionsGenerator.fs +++ b/src/Json/JsonConversionsGenerator.fs @@ -50,13 +50,12 @@ type JsonConversionCallingType = /// an expression of other type - the type is specified by `field` let convertJsonValue missingValuesStr cultureStr canPassAllConversionCallingTypes (field: PrimitiveInferedValue) = - assert (field.TypeWithMeasure = field.RuntimeType) let returnType = match field.TypeWrapper with - | TypeWrapper.None -> field.RuntimeType - | TypeWrapper.Option -> typedefof>.MakeGenericType field.RuntimeType - | TypeWrapper.Nullable -> typedefof>.MakeGenericType field.RuntimeType + | TypeWrapper.None -> field.TypeWithMeasure + | TypeWrapper.Option -> typedefof>.MakeGenericType field.TypeWithMeasure + | TypeWrapper.Nullable -> typedefof>.MakeGenericType field.TypeWithMeasure let wrapInLetIfNeeded (value: Expr) getBody = match value with diff --git a/src/Json/JsonGenerator.fs b/src/Json/JsonGenerator.fs index 225bf41ff..56159b02d 100644 --- a/src/Json/JsonGenerator.fs +++ b/src/Json/JsonGenerator.fs @@ -13,6 +13,7 @@ open FSharp.Data.Runtime.StructuralTypes open ProviderImplementation open ProviderImplementation.JsonConversionsGenerator open ProviderImplementation.ProvidedTypes +open FSharp.Data.Runtime.StructuralInference #nowarn "10001" @@ -27,17 +28,48 @@ type internal JsonGenerationContext = JsonRuntimeType: Type TypeCache: Dictionary PreferDictionaries: bool - GenerateConstructors: bool } - - static member Create(cultureStr, tpType, ?uniqueNiceName, ?typeCache, ?preferDictionaries) = + GenerateConstructors: bool + InferenceMode: InferenceMode' + UnitsOfMeasureProvider: IUnitsOfMeasureProvider } + + static member Create + ( + cultureStr, + tpType, + unitsOfMeasureProvider, + inferenceMode, + ?uniqueNiceName, + ?typeCache, + ?preferDictionaries + ) = let uniqueNiceName = defaultArg uniqueNiceName (NameUtils.uniqueGenerator NameUtils.nicePascalName) let typeCache = defaultArg typeCache (Dictionary()) let preferDictionaries = defaultArg preferDictionaries false - JsonGenerationContext.Create(cultureStr, tpType, uniqueNiceName, typeCache, preferDictionaries, true) - static member Create(cultureStr, tpType, uniqueNiceName, typeCache, preferDictionaries, generateConstructors) = + JsonGenerationContext.Create( + cultureStr, + tpType, + uniqueNiceName, + typeCache, + preferDictionaries, + true, + inferenceMode, + unitsOfMeasureProvider + ) + + static member Create + ( + cultureStr, + tpType, + uniqueNiceName, + typeCache, + preferDictionaries, + generateConstructors, + inferenceMode, + unitsOfMeasureProvider + ) = { CultureStr = cultureStr TypeProviderType = tpType UniqueNiceName = uniqueNiceName @@ -46,7 +78,9 @@ type internal JsonGenerationContext = JsonRuntimeType = typeof TypeCache = typeCache PreferDictionaries = preferDictionaries - GenerateConstructors = generateConstructors } + GenerateConstructors = generateConstructors + InferenceMode = inferenceMode + UnitsOfMeasureProvider = unitsOfMeasureProvider } member x.MakeOptionType(typ: Type) = typedefof>.MakeGenericType typ @@ -81,10 +115,10 @@ module JsonTypeBuilder = // normalize properties of the inferedType which don't affect code generation let rec normalize topLevel = function - | InferedType.Heterogeneous map -> + | InferedType.Heterogeneous (map, _) -> map |> Map.map (fun _ inferedType -> normalize false inferedType) - |> InferedType.Heterogeneous + |> (fun x -> InferedType.Heterogeneous(x, false)) | InferedType.Collection (order, types) -> InferedType.Collection( order, @@ -98,10 +132,12 @@ module JsonTypeBuilder = Type = normalize false inferedType }) // optional only affects the parent, so at top level always set to true regardless of the actual value InferedType.Record(None, props, optional || topLevel) - | InferedType.Primitive (typ, unit, optional) when typ = typeof || typ = typeof -> - InferedType.Primitive(typeof, unit, optional) - | InferedType.Primitive (typ, unit, optional) when typ = typeof -> - InferedType.Primitive(typeof, unit, optional) + | InferedType.Primitive (typ, unit, optional, shouldOverrideOnMerge) when + typ = typeof || typ = typeof + -> + InferedType.Primitive(typeof, unit, optional, shouldOverrideOnMerge) + | InferedType.Primitive (typ, unit, optional, shouldOverrideOnMerge) when typ = typeof -> + InferedType.Primitive(typeof, unit, optional, shouldOverrideOnMerge) | x -> x let inferedType = normalize true inferedType @@ -169,7 +205,7 @@ module JsonTypeBuilder = | InferedMultiplicity.OptionalSingle | InferedMultiplicity.Single -> match inferedType with - | InferedType.Primitive (typ, _, _) -> + | InferedType.Primitive (typ, _, _, _) -> if typ = typeof || typ = typeof || typ = typeof then @@ -297,7 +333,7 @@ module JsonTypeBuilder = match inferedType with - | InferedType.Primitive (inferedType, unit, optional) -> + | InferedType.Primitive (inferedType, unit, optional, _) -> let typ, conv, conversionCallingType = PrimitiveInferedValue.Create(inferedType, optional, unit) @@ -374,6 +410,8 @@ module JsonTypeBuilder = let infType = [ for prop in props -> StructuralInference.getInferedTypeFromString + ctx.UnitsOfMeasureProvider + ctx.InferenceMode (TextRuntime.GetCulture ctx.CultureStr) prop.Name None ] @@ -619,7 +657,7 @@ module JsonTypeBuilder = (result.ConvertedTypeErased ctx) (jDoc, cultureStr, tagCode, result.ConverterFunc ctx))) - | InferedType.Heterogeneous types -> + | InferedType.Heterogeneous (types, _) -> getOrCreateType ctx inferedType (fun () -> // Generate a choice type that always calls `TryGetValueByTypeTag` diff --git a/src/Json/JsonInference.fs b/src/Json/JsonInference.fs index d2d3303c6..f42e41da9 100644 --- a/src/Json/JsonInference.fs +++ b/src/Json/JsonInference.fs @@ -8,57 +8,65 @@ open System open FSharp.Data open FSharp.Data.Runtime open FSharp.Data.Runtime.StructuralTypes +open FSharp.Data.Runtime.StructuralInference /// Infer type of a JSON value - this is a simple function because most of the /// functionality is handled in `StructureInference` (most notably, by /// `inferCollectionType` and various functions to find common subtype), so /// here we just need to infer types of primitive JSON values. -let rec inferType inferTypesFromValues cultureInfo parentName json = +let rec inferType unitsOfMeasureProvider inferenceMode cultureInfo parentName json = let inline inRangeDecimal lo hi (v: decimal) : bool = (v >= decimal lo) && (v <= decimal hi) let inline inRangeFloat lo hi (v: float) : bool = (v >= float lo) && (v <= float hi) let inline isIntegerDecimal (v: decimal) : bool = Math.Round v = v let inline isIntegerFloat (v: float) : bool = Math.Round v = v + let shouldInferNonStringFromValue = + match inferenceMode with + | InferenceMode'.NoInference -> false + | InferenceMode'.ValuesOnly -> true + | InferenceMode'.ValuesAndInlineSchemasHints -> true + | InferenceMode'.ValuesAndInlineSchemasOverrides -> true + match json with // Null and primitives without subtyping hierarchies | JsonValue.Null -> InferedType.Null - | JsonValue.Boolean _ -> InferedType.Primitive(typeof, None, false) - | JsonValue.String s when inferTypesFromValues -> StructuralInference.getInferedTypeFromString cultureInfo s None - | JsonValue.String _ -> InferedType.Primitive(typeof, None, false) + | JsonValue.Boolean _ -> InferedType.Primitive(typeof, None, false, false) + | JsonValue.String s -> + StructuralInference.getInferedTypeFromString unitsOfMeasureProvider inferenceMode cultureInfo s None // For numbers, we test if it is integer and if it fits in smaller range - | JsonValue.Number 0M when inferTypesFromValues -> InferedType.Primitive(typeof, None, false) - | JsonValue.Number 1M when inferTypesFromValues -> InferedType.Primitive(typeof, None, false) + | JsonValue.Number 0M when shouldInferNonStringFromValue -> InferedType.Primitive(typeof, None, false, false) + | JsonValue.Number 1M when shouldInferNonStringFromValue -> InferedType.Primitive(typeof, None, false, false) | JsonValue.Number n when - inferTypesFromValues + shouldInferNonStringFromValue && inRangeDecimal Int32.MinValue Int32.MaxValue n && isIntegerDecimal n -> - InferedType.Primitive(typeof, None, false) + InferedType.Primitive(typeof, None, false, false) | JsonValue.Number n when - inferTypesFromValues + shouldInferNonStringFromValue && inRangeDecimal Int64.MinValue Int64.MaxValue n && isIntegerDecimal n -> - InferedType.Primitive(typeof, None, false) - | JsonValue.Number _ -> InferedType.Primitive(typeof, None, false) + InferedType.Primitive(typeof, None, false, false) + | JsonValue.Number _ -> InferedType.Primitive(typeof, None, false, false) | JsonValue.Float f when - inferTypesFromValues + shouldInferNonStringFromValue && inRangeFloat Int32.MinValue Int32.MaxValue f && isIntegerFloat f -> - InferedType.Primitive(typeof, None, false) + InferedType.Primitive(typeof, None, false, false) | JsonValue.Float f when - inferTypesFromValues + shouldInferNonStringFromValue && inRangeFloat Int64.MinValue Int64.MaxValue f && isIntegerFloat f -> - InferedType.Primitive(typeof, None, false) - | JsonValue.Float _ -> InferedType.Primitive(typeof, None, false) + InferedType.Primitive(typeof, None, false, false) + | JsonValue.Float _ -> InferedType.Primitive(typeof, None, false, false) // More interesting types | JsonValue.Array ar -> StructuralInference.inferCollectionType false - (Seq.map (inferType inferTypesFromValues cultureInfo (NameUtils.singularize parentName)) ar) + (Seq.map (inferType unitsOfMeasureProvider inferenceMode cultureInfo (NameUtils.singularize parentName)) ar) | JsonValue.Record properties -> let name = if String.IsNullOrEmpty parentName then @@ -68,7 +76,7 @@ let rec inferType inferTypesFromValues cultureInfo parentName json = let props = [ for propName, value in properties -> - let t = inferType inferTypesFromValues cultureInfo propName value + let t = inferType unitsOfMeasureProvider inferenceMode cultureInfo propName value { Name = propName; Type = t } ] InferedType.Record(name, props, false) diff --git a/src/Json/JsonProvider.fs b/src/Json/JsonProvider.fs index acfc8ea78..f233ad704 100644 --- a/src/Json/JsonProvider.fs +++ b/src/Json/JsonProvider.fs @@ -10,6 +10,7 @@ open FSharp.Data open FSharp.Data.Runtime open FSharp.Data.Runtime.BaseTypes open FSharp.Data.Runtime.StructuralTypes +open FSharp.Data.Runtime.StructuralInference // ---------------------------------------------------------------------------------------------- @@ -53,8 +54,13 @@ type public JsonProvider(cfg: TypeProviderConfig) as this = let resource = args.[6] :?> string let inferTypesFromValues = args.[7] :?> bool let preferDictionaries = args.[8] :?> bool + let inferenceMode = args.[9] :?> InferenceMode + + let inferenceMode = + InferenceMode'.FromPublicApi(inferenceMode, inferTypesFromValues) let cultureInfo = TextRuntime.GetCulture cultureStr + let unitsOfMeasureProvider = ProviderHelpers.unitsOfMeasureProvider let getSpec _ value = @@ -71,13 +77,20 @@ type public JsonProvider(cfg: TypeProviderConfig) as this = use _holder = IO.logTime "Inference" sample samples - |> Array.map (fun sampleJson -> JsonInference.inferType inferTypesFromValues cultureInfo "" sampleJson) + |> Array.map (fun sampleJson -> + JsonInference.inferType unitsOfMeasureProvider inferenceMode cultureInfo "" sampleJson) |> Array.fold (StructuralInference.subtypeInfered false) InferedType.Top use _holder = IO.logTime "TypeGeneration" sample let ctx = - JsonGenerationContext.Create(cultureStr, tpType, ?preferDictionaries = Some preferDictionaries) + JsonGenerationContext.Create( + cultureStr, + tpType, + unitsOfMeasureProvider, + inferenceMode, + ?preferDictionaries = Some preferDictionaries + ) let result = JsonTypeBuilder.generateJsonType ctx false false rootName inferedType @@ -103,7 +116,12 @@ type public JsonProvider(cfg: TypeProviderConfig) as this = ProvidedStaticParameter("ResolutionFolder", typeof, parameterDefaultValue = "") ProvidedStaticParameter("EmbeddedResource", typeof, parameterDefaultValue = "") ProvidedStaticParameter("InferTypesFromValues", typeof, parameterDefaultValue = true) - ProvidedStaticParameter("PreferDictionaries", typeof, parameterDefaultValue = false) ] + ProvidedStaticParameter("PreferDictionaries", typeof, parameterDefaultValue = false) + ProvidedStaticParameter( + "InferenceMode", + typeof, + parameterDefaultValue = InferenceMode.BackwardCompatible + ) ] let helpText = """Typed representation of a JSON document. @@ -115,9 +133,17 @@ type public JsonProvider(cfg: TypeProviderConfig) as this = A directory that is used when resolving relative file references (at design time and in hosted execution). When specified, the type provider first attempts to load the sample from the specified resource (e.g. 'MyCompany.MyAssembly, resource_name.json'). This is useful when exposing types generated by the type provider. - If true, turns on additional type inference from values. + + This parameter is deprecated. Please use InferenceMode instead. + If true, turns on additional type inference from values. (e.g. type inference infers string values such as "123" as ints and values constrained to 0 and 1 as booleans.) - If true, json records are interpreted as dictionaries when the names of all the fields are infered (by type inference rules) into the same non-string primitive type.""" + If true, json records are interpreted as dictionaries when the names of all the fields are inferred (by type inference rules) into the same non-string primitive type. + Possible values: + | NoInference -> Inference is disabled. All values are inferred as the most basic type permitted for the value (i.e. string or number or bool). + | ValuesOnly -> Types of values are inferred from the Sample. Inline schema support is disabled. This is the default. + | ValuesAndInlineSchemasHints -> Types of values are inferred from both values and inline schemas. Inline schemas are special string values that can define a type and/or unit of measure. Supported syntax: typeof<type> or typeof{type} or typeof<type<measure>> or typeof{type{measure}}. Valid measures are the default SI units, and valid types are int, int64, bool, float, decimal, date, datetimeoffset, timespan, guid and string. + | ValuesAndInlineSchemasOverrides -> Same as ValuesAndInlineSchemasHints, but value inferred types are ignored when an inline schema is present. + """ do jsonProvTy.AddXmlDoc helpText do jsonProvTy.DefineStaticParameters(parameters, buildTypes) diff --git a/src/Xml/XmlGenerator.fs b/src/Xml/XmlGenerator.fs index 78155cd54..ce771052e 100644 --- a/src/Xml/XmlGenerator.fs +++ b/src/Xml/XmlGenerator.fs @@ -1,4 +1,4 @@ -// -------------------------------------------------------------------------------------- +// -------------------------------------------------------------------------------------- // XML type provider - generate code for accessing inferred elements // -------------------------------------------------------------------------------------- namespace ProviderImplementation @@ -13,6 +13,7 @@ open FSharp.Data.Runtime.StructuralTypes open ProviderImplementation open ProviderImplementation.ProvidedTypes open ProviderImplementation.QuotationBuilder +open FSharp.Data.Runtime.StructuralInference // -------------------------------------------------------------------------------------- @@ -21,17 +22,21 @@ open ProviderImplementation.QuotationBuilder /// Context that is used to generate the XML types. type internal XmlGenerationContext = { CultureStr: string + UnitsOfMeasureProvider: IUnitsOfMeasureProvider + InferenceMode: InferenceMode' ProvidedType: ProvidedTypeDefinition // to nameclash type names UniqueNiceName: string -> string UnifyGlobally: bool XmlTypeCache: Dictionary JsonTypeCache: Dictionary } - static member Create(cultureStr, tpType, unifyGlobally) = + static member Create(unitsOfMeasureProvider, inferenceMode, cultureStr, tpType, unifyGlobally) = let uniqueNiceName = NameUtils.uniqueGenerator NameUtils.nicePascalName uniqueNiceName "XElement" |> ignore { CultureStr = cultureStr + UnitsOfMeasureProvider = unitsOfMeasureProvider + InferenceMode = inferenceMode ProvidedType = tpType UniqueNiceName = uniqueNiceName UnifyGlobally = unifyGlobally @@ -75,7 +80,7 @@ module internal XmlTypeBuilder = match inferedProp with | { Type = (InferedType.Primitive _ | InferedType.Json _) as typ } -> Some([ typ ], []) | { Type = InferedType.Collection (order, types) } -> Some([], inOrder order types) - | { Type = InferedType.Heterogeneous cases } -> + | { Type = InferedType.Heterogeneous (cases, _) } -> let collections, others = Map.toList cases |> List.partition (fst >> (=) InferedTypeTag.Collection) @@ -89,12 +94,12 @@ module internal XmlTypeBuilder = | { Type = InferedType.Top } -> Some([], []) | _ -> None - /// Succeeds when type is a heterogeneous type containing recors + /// Succeeds when type is a heterogeneous type containing records /// If the type is heterogeneous, but contains other things, exception /// is thrown (this is unexpected, because XML elements are always records) let (|HeterogeneousRecords|_|) inferedType = match inferedType with - | InferedType.Heterogeneous cases -> + | InferedType.Heterogeneous (cases, _) -> let records = cases |> List.ofSeq @@ -122,7 +127,7 @@ module internal XmlTypeBuilder = (StructuralInference.typeTag primitive).NiceName match primitive with - | InferedType.Primitive (typ, unit, optional) -> + | InferedType.Primitive (typ, unit, optional, _) -> let optional = optional || forceOptional let optionalJustBecauseThereAreMultiple = primitives.Length > 1 && not optional @@ -141,7 +146,14 @@ module internal XmlTypeBuilder = let cultureStr = ctx.CultureStr let ctx = - JsonGenerationContext.Create(cultureStr, ctx.ProvidedType, ctx.UniqueNiceName, ctx.JsonTypeCache) + JsonGenerationContext.Create( + cultureStr, + ctx.ProvidedType, + ctx.UnitsOfMeasureProvider, + ctx.InferenceMode, + ctx.UniqueNiceName, + ctx.JsonTypeCache + ) let result = JsonTypeBuilder.generateJsonType ctx false true "" typ @@ -323,7 +335,7 @@ module internal XmlTypeBuilder = createMember typ conv match attr.Type with - | InferedType.Heterogeneous types -> + | InferedType.Heterogeneous (types, _) -> // If the attribute has multiple possible type (e.g. "bool|int") then we generate // a choice type that is erased to 'option' (for simplicity, assuming that @@ -344,7 +356,7 @@ module internal XmlTypeBuilder = failwithf "generateXmlType: Type shouldn't be optional: %A" typ match typ with - | InferedType.Primitive (primTyp, unit, false) -> + | InferedType.Primitive (primTyp, unit, false, _) -> let typ, conv = ctx.ConvertValue @@ -384,7 +396,7 @@ module internal XmlTypeBuilder = createMember choiceTy (fun x -> x :> Expr) - | InferedType.Primitive (typ, unit, optional) -> createPrimitiveMember typ unit optional + | InferedType.Primitive (typ, unit, optional, _) -> createPrimitiveMember typ unit optional | InferedType.Null -> createPrimitiveMember typeof None false | _ -> failwithf "generateXmlType: Expected Primitive or Choice type, got %A" attr.Type ] diff --git a/src/Xml/XmlInference.fs b/src/Xml/XmlInference.fs index 16cbd4964..6fb83c285 100644 --- a/src/Xml/XmlInference.fs +++ b/src/Xml/XmlInference.fs @@ -1,4 +1,4 @@ -// -------------------------------------------------------------------------------------- +// -------------------------------------------------------------------------------------- // Implements type inference for XML // -------------------------------------------------------------------------------------- @@ -19,50 +19,51 @@ open FSharp.Data.Runtime.StructuralTypes /// Generates record fields for all attributes -let private getAttributes inferTypesFromValues cultureInfo (element: XElement) = +let private getAttributes unitsOfMeasureProvider inferenceMode cultureInfo (element: XElement) = [ for attr in element.Attributes() do if attr.Name.Namespace.NamespaceName <> "http://www.w3.org/2000/xmlns/" && attr.Name.ToString() <> "xmlns" then yield { Name = attr.Name.ToString() - Type = - if inferTypesFromValues then - getInferedTypeFromString cultureInfo attr.Value None - else - InferedType.Primitive(typeof, None, false) } ] + Type = getInferedTypeFromString unitsOfMeasureProvider inferenceMode cultureInfo attr.Value None } ] -let getInferedTypeFromValue inferTypesFromValues cultureInfo (element: XElement) = - if inferTypesFromValues then - let value = element.Value - let typ = getInferedTypeFromString cultureInfo value None +let getInferedTypeFromValue unitsOfMeasureProvider inferenceMode cultureInfo (element: XElement) = + let typ = + getInferedTypeFromString unitsOfMeasureProvider inferenceMode cultureInfo (element.Value) None + match inferenceMode with + // Embedded json is not parsed when InferenceMode is NoInference + | InferenceMode'.NoInference -> typ + | _ -> match typ with - | InferedType.Primitive (t, _, optional) when + | InferedType.Primitive (t, _, optional, _) when t = typeof - && let v = value.TrimStart() in + && let v = (element.Value).TrimStart() in v.StartsWith "{" || v.StartsWith "[" -> try - match JsonValue.Parse value with + match JsonValue.Parse(element.Value) with | (JsonValue.Record _ | JsonValue.Array _) as json -> let jsonType = json - |> JsonInference.inferType true cultureInfo element.Name.LocalName + |> JsonInference.inferType + unitsOfMeasureProvider + inferenceMode + cultureInfo + element.Name.LocalName InferedType.Json(jsonType, optional) | _ -> typ with _ -> typ | _ -> typ - else - InferedType.Primitive(typeof, None, false) /// Infers type for the element, unifying nodes of the same name /// across the entire document (we first get information based /// on just attributes and then use a fixed point) -let inferGlobalType inferTypesFromValues cultureInfo allowEmptyValues (elements: XElement[]) = +let inferGlobalType unitsOfMeasureProvider inferenceMode cultureInfo allowEmptyValues (elements: XElement[]) = // Initial state contains types with attributes but all // children are ignored (bodies are based on just body values) @@ -82,7 +83,7 @@ let inferGlobalType inferTypesFromValues cultureInfo allowEmptyValues (elements: // Get attributes for all `name` named elements let attributes = elements - |> Seq.map (getAttributes inferTypesFromValues cultureInfo) + |> Seq.map (getAttributes unitsOfMeasureProvider inferenceMode cultureInfo) |> Seq.reduce (unionRecordTypes allowEmptyValues) // Get type of body based on primitive values only @@ -92,7 +93,7 @@ let inferGlobalType inferTypesFromValues cultureInfo allowEmptyValues (elements: not e.HasElements && not (String.IsNullOrEmpty(e.Value)) then - yield getInferedTypeFromValue inferTypesFromValues cultureInfo e |] + yield getInferedTypeFromValue unitsOfMeasureProvider inferenceMode cultureInfo e |] |> Array.fold (subtypeInfered allowEmptyValues) InferedType.Top let body = { Name = ""; Type = bodyType } @@ -137,10 +138,10 @@ let inferGlobalType inferTypesFromValues cultureInfo allowEmptyValues (elements: /// Get information about type locally (the type of children is infered /// recursively, so same elements in different positions have different types) -let rec inferLocalType inferTypesFromValues cultureInfo allowEmptyValues (element: XElement) = +let rec inferLocalType unitsOfMeasureProvider inferenceMode cultureInfo allowEmptyValues (element: XElement) = let props = [ // Generate record fields for attributes - yield! getAttributes inferTypesFromValues cultureInfo element + yield! getAttributes unitsOfMeasureProvider inferenceMode cultureInfo element // If it has children, add collection content let children = element.Elements() @@ -149,13 +150,17 @@ let rec inferLocalType inferTypesFromValues cultureInfo allowEmptyValues (elemen let collection = inferCollectionType allowEmptyValues - (Seq.map (inferLocalType inferTypesFromValues cultureInfo allowEmptyValues) children) + (Seq.map + (inferLocalType unitsOfMeasureProvider inferenceMode cultureInfo allowEmptyValues) + children) yield { Name = ""; Type = collection } // If it has value, add primitive content elif not (String.IsNullOrEmpty element.Value) then - let primitive = getInferedTypeFromValue inferTypesFromValues cultureInfo element + let primitive = + getInferedTypeFromValue unitsOfMeasureProvider inferenceMode cultureInfo element + yield { Name = ""; Type = primitive } ] InferedType.Record(Some(element.Name.ToString()), props, false) @@ -163,8 +168,8 @@ let rec inferLocalType inferTypesFromValues cultureInfo allowEmptyValues (elemen /// A type is infered either using `inferLocalType` which only looks /// at immediate children or using `inferGlobalType` which unifies nodes /// of the same name in the entire document -let inferType inferTypesFromValues cultureInfo allowEmptyValues globalInference (elements: XElement[]) = +let inferType unitsOfMeasureProvider inferenceMode cultureInfo allowEmptyValues globalInference (elements: XElement[]) = if globalInference then - inferGlobalType inferTypesFromValues cultureInfo allowEmptyValues elements + inferGlobalType unitsOfMeasureProvider inferenceMode cultureInfo allowEmptyValues elements else - Array.map (inferLocalType inferTypesFromValues cultureInfo allowEmptyValues) elements + Array.map (inferLocalType unitsOfMeasureProvider inferenceMode cultureInfo allowEmptyValues) elements diff --git a/src/Xml/XmlProvider.fs b/src/Xml/XmlProvider.fs index 95cac5b02..54e06884d 100644 --- a/src/Xml/XmlProvider.fs +++ b/src/Xml/XmlProvider.fs @@ -10,6 +10,7 @@ open ProviderImplementation.ProviderHelpers open FSharp.Data.Runtime open FSharp.Data.Runtime.BaseTypes open FSharp.Data.Runtime.StructuralTypes +open FSharp.Data.Runtime.StructuralInference // ---------------------------------------------------------------------------------------------- @@ -46,6 +47,10 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = let resource = args.[6] :?> string let inferTypesFromValues = args.[7] :?> bool let schema = args.[8] :?> string + let inferenceMode = args.[9] :?> InferenceMode + + let inferenceMode = + InferenceMode'.FromPublicApi(inferenceMode, inferTypesFromValues) if schema <> "" then if sample <> "" then @@ -54,6 +59,8 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = if sampleIsList then failwith "When the Schema parameter is used, the SampleIsList parameter must be set to false" + let unitsOfMeasureProvider = ProviderHelpers.unitsOfMeasureProvider + let getSpec _ value = if schema <> "" then @@ -73,7 +80,13 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = use _holder = IO.logTime "TypeGeneration" sample let ctx = - XmlGenerationContext.Create(cultureStr, tpType, globalInference || schema <> "") + XmlGenerationContext.Create( + unitsOfMeasureProvider, + inferenceMode, + cultureStr, + tpType, + globalInference || schema <> "" + ) let result = XmlTypeBuilder.generateXmlType ctx inferedType @@ -103,7 +116,8 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = samples |> XmlInference.inferType - inferTypesFromValues + unitsOfMeasureProvider + inferenceMode (TextRuntime.GetCulture cultureStr) false globalInference @@ -112,7 +126,13 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = use _holder = IO.logTime "TypeGeneration" sample let ctx = - XmlGenerationContext.Create(cultureStr, tpType, globalInference || schema <> "") + XmlGenerationContext.Create( + unitsOfMeasureProvider, + inferenceMode, + cultureStr, + tpType, + globalInference || schema <> "" + ) let result = XmlTypeBuilder.generateXmlType ctx inferedType @@ -151,7 +171,12 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = ProvidedStaticParameter("ResolutionFolder", typeof, parameterDefaultValue = "") ProvidedStaticParameter("EmbeddedResource", typeof, parameterDefaultValue = "") ProvidedStaticParameter("InferTypesFromValues", typeof, parameterDefaultValue = true) - ProvidedStaticParameter("Schema", typeof, parameterDefaultValue = "") ] + ProvidedStaticParameter("Schema", typeof, parameterDefaultValue = "") + ProvidedStaticParameter( + "InferenceMode", + typeof, + parameterDefaultValue = InferenceMode.BackwardCompatible + ) ] let helpText = """Typed representation of a XML file. @@ -163,9 +188,18 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = A directory that is used when resolving relative file references (at design time and in hosted execution). When specified, the type provider first attempts to load the sample from the specified resource (e.g. 'MyCompany.MyAssembly, resource_name.xml'). This is useful when exposing types generated by the type provider. - If true, turns on additional type inference from values. + + This parameter is deprecated. Please use InferenceMode instead. + If true, turns on additional type inference from values. (e.g. type inference infers string values such as "123" as ints and values constrained to 0 and 1 as booleans. The XmlProvider also infers string values as JSON.) - Location of a schema file or a string containing xsd.""" + Location of a schema file or a string containing xsd. + Possible values: + | NoInference -> Inference is disabled. All values are inferred as the most basic type permitted for the value (usually string). + | ValuesOnly -> Types of values are inferred from the Sample. Inline schema support is disabled. This is the default. + | ValuesAndInlineSchemasHints -> Types of values are inferred from both values and inline schemas. Inline schemas are special string values that can define a type and/or unit of measure. Supported syntax: typeof<type> or typeof{type} or typeof<type<measure>> or typeof{type{measure}}. Valid measures are the default SI units, and valid types are int, int64, bool, float, decimal, date, datetimeoffset, timespan, guid and string. + | ValuesAndInlineSchemasOverrides -> Same as ValuesAndInlineSchemasHints, but value inferred types are ignored when an inline schema is present. + Note inline schemas are not used from Xsd documents. + """ do xmlProvTy.AddXmlDoc helpText diff --git a/src/Xml/XsdInference.fs b/src/Xml/XsdInference.fs index 5126b1e42..5f073db5e 100644 --- a/src/Xml/XsdInference.fs +++ b/src/Xml/XsdInference.fs @@ -255,7 +255,7 @@ module XsdInference = let nil = { InferedProperty.Name = "{http://www.w3.org/2001/XMLSchema-instance}nil" - Type = InferedType.Primitive(typeof, None, true) } + Type = InferedType.Primitive(typeof, None, true, false) } type InferenceContext = System.Collections.Generic.Dictionary @@ -268,7 +268,7 @@ module XsdInference = else match elm.Type with | SimpleType typeCode -> - let ty = InferedType.Primitive(getType typeCode, None, elm.IsNillable) + let ty = InferedType.Primitive(getType typeCode, None, elm.IsNillable, false) let prop = { InferedProperty.Name = ""; Type = ty } let props = if elm.IsNillable then [ prop; nil ] else [ prop ] InferedType.Record(name, props, optional = false) @@ -292,13 +292,13 @@ module XsdInference = cty.Attributes |> List.map (fun (name, typeCode, optional) -> { Name = formatName name - Type = InferedType.Primitive(getType typeCode, None, optional) }) + Type = InferedType.Primitive(getType typeCode, None, optional, false) }) match cty.Contents with | SimpleContent typeCode -> let body = { InferedProperty.Name = "" - Type = InferedType.Primitive(getType typeCode, None, false) } + Type = InferedType.Primitive(getType typeCode, None, false, false) } body :: attrs | ComplexContent xsdParticle -> @@ -371,4 +371,4 @@ module XsdInference = elms |> List.map (fun elm -> InferedTypeTag.Record(getElementName elm), inferElementType ctx elm) |> Map.ofList - |> InferedType.Heterogeneous + |> (fun x -> InferedType.Heterogeneous(x, false)) diff --git a/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs b/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs index b0155a858..72a589f9a 100644 --- a/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs +++ b/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs @@ -16,14 +16,15 @@ let SimpleCollection typ = InferedType.Collection([ typeTag typ], Map.ofSeq [typeTag typ, (InferedMultiplicity.Multiple, typ)]) let culture = TextRuntime.GetCulture "" +let inferenceMode = InferenceMode'.ValuesOnly +let unitsOfMeasureProvider = ProviderHelpers.unitsOfMeasureProvider let inferType (csv:CsvFile) inferRows missingValues cultureInfo schema assumeMissingValues preferOptionals = - let headerNamesAndUnits, schema = parseHeaders csv.Headers csv.NumberOfColumns schema ProviderHelpers.unitsOfMeasureProvider - inferType headerNamesAndUnits schema (csv.Rows |> Seq.map (fun x -> x.Columns)) inferRows missingValues cultureInfo assumeMissingValues preferOptionals + let headerNamesAndUnits, schema = parseHeaders csv.Headers csv.NumberOfColumns schema unitsOfMeasureProvider + inferType headerNamesAndUnits schema (csv.Rows |> Seq.map (fun x -> x.Columns)) inferRows missingValues inferenceMode cultureInfo assumeMissingValues preferOptionals unitsOfMeasureProvider let toRecord fields = InferedType.Record(None, fields, false) -let inferTypesFromValues = true [] let ``List.pairBy helper function works``() = @@ -45,15 +46,15 @@ let ``List.pairBy helper function preserves order``() = [] let ``Finds common subtype of numeric types (decimal)``() = let source = JsonValue.Parse """[ 10, 10.23 ]""" - let expected = SimpleCollection(InferedType.Primitive(typeof, None, false)) - let actual = JsonInference.inferType inferTypesFromValues culture "" source + let expected = SimpleCollection(InferedType.Primitive(typeof, None, false, false)) + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Finds common subtype of numeric types (int64)``() = let source = JsonValue.Parse """[ 10, 2147483648 ]""" - let expected = SimpleCollection(InferedType.Primitive(typeof, None, false)) - let actual = JsonInference.inferType inferTypesFromValues culture "" source + let expected = SimpleCollection(InferedType.Primitive(typeof, None, false, false)) + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] @@ -62,9 +63,9 @@ let ``Infers heterogeneous type of InferedType.Primitives``() = let expected = InferedType.Collection ([ InferedTypeTag.Number; InferedTypeTag.Boolean ], - [ InferedTypeTag.Number, (Single, InferedType.Primitive(typeof, None, false)) - InferedTypeTag.Boolean, (Single, InferedType.Primitive(typeof, None, false)) ] |> Map.ofList) - let actual = JsonInference.inferType inferTypesFromValues culture "" source + [ InferedTypeTag.Number, (Single, InferedType.Primitive(typeof, None, false, false)) + InferedTypeTag.Boolean, (Single, InferedType.Primitive(typeof, None, false, false)) ] |> Map.ofList) + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] @@ -74,16 +75,16 @@ let ``Infers heterogeneous type of InferedType.Primitives and nulls``() = InferedType.Collection ([ InferedTypeTag.Number; InferedTypeTag.Boolean; InferedTypeTag.Null ], [ InferedTypeTag.Null, (Single, InferedType.Null) - InferedTypeTag.Number, (Single, InferedType.Primitive(typeof, None, false)) - InferedTypeTag.Boolean, (Single, InferedType.Primitive(typeof, None, false)) ] |> Map.ofList) - let actual = JsonInference.inferType inferTypesFromValues culture "" source + InferedTypeTag.Number, (Single, InferedType.Primitive(typeof, None, false, false)) + InferedTypeTag.Boolean, (Single, InferedType.Primitive(typeof, None, false, false)) ] |> Map.ofList) + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Finds common subtype of numeric types (float)``() = let source = JsonValue.Parse """[ 10, 10.23, 79228162514264337593543950336 ]""" - let expected = SimpleCollection(InferedType.Primitive(typeof, None, false)) - let actual = JsonInference.inferType inferTypesFromValues culture "" source + let expected = SimpleCollection(InferedType.Primitive(typeof, None, false, false)) + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] @@ -92,95 +93,95 @@ let ``Infers heterogeneous type of InferedType.Primitives and records``() = let expected = InferedType.Collection ([ InferedTypeTag.Record None; InferedTypeTag.Number ], - [ InferedTypeTag.Number, (Multiple, InferedType.Primitive(typeof, None, false)) + [ InferedTypeTag.Number, (Multiple, InferedType.Primitive(typeof, None, false, false)) InferedTypeTag.Record None, - (Single, toRecord [ { Name="a"; Type=InferedType.Primitive(typeof, None, false) } ]) ] |> Map.ofList) - let actual = JsonInference.inferType inferTypesFromValues culture "" source + (Single, toRecord [ { Name="a"; Type=InferedType.Primitive(typeof, None, false, false) } ]) ] |> Map.ofList) + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Merges types in a collection of collections``() = let source = JsonValue.Parse """[ [{"a":true,"c":0},{"b":1,"c":0}], [{"b":1.1,"c":0}] ]""" let expected = - [ { Name = "a"; Type = InferedType.Primitive(typeof, None, true) } - { Name = "c"; Type = InferedType.Primitive(typeof, None, false) } - { Name = "b"; Type = InferedType.Primitive(typeof, None, true) } ] + [ { Name = "a"; Type = InferedType.Primitive(typeof, None, true, false) } + { Name = "c"; Type = InferedType.Primitive(typeof, None, false, false) } + { Name = "b"; Type = InferedType.Primitive(typeof, None, true, false) } ] |> toRecord |> SimpleCollection |> SimpleCollection - let actual = JsonInference.inferType inferTypesFromValues culture "" source + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Unions properties of records in a collection``() = let source = JsonValue.Parse """[ {"a":1, "b":""}, {"a":1.2, "c":true} ]""" let expected = - [ { Name = "a"; Type = InferedType.Primitive(typeof, None, false) } + [ { Name = "a"; Type = InferedType.Primitive(typeof, None, false, false) } { Name = "b"; Type = InferedType.Null } - { Name = "c"; Type = InferedType.Primitive(typeof, None, true) } ] + { Name = "c"; Type = InferedType.Primitive(typeof, None, true, false) } ] |> toRecord |> SimpleCollection - let actual = JsonInference.inferType inferTypesFromValues culture "" source + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Null should make string optional``() = let source = JsonValue.Parse """[ {"a":null}, {"a":"b"} ]""" let expected = - [ { Name = "a"; Type = InferedType.Primitive(typeof, None, true) } ] + [ { Name = "a"; Type = InferedType.Primitive(typeof, None, true, false) } ] |> toRecord |> SimpleCollection - let actual = JsonInference.inferType inferTypesFromValues culture "" source + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Null is not a valid value of DateTime``() = let actual = - subtypeInfered false InferedType.Null (InferedType.Primitive(typeof, None, false)) - let expected = InferedType.Primitive(typeof, None, true) + subtypeInfered false InferedType.Null (InferedType.Primitive(typeof, None, false, false)) + let expected = InferedType.Primitive(typeof, None, true, false) actual |> should equal expected [] let ``Infers mixed fields of a a record as heterogeneous type with nulls (1.)``() = let source = JsonValue.Parse """[ {"a":null}, {"a":123} ]""" let expected = - [ { Name = "a"; Type = InferedType.Primitive(typeof, None, true) } ] + [ { Name = "a"; Type = InferedType.Primitive(typeof, None, true, false) } ] |> toRecord |> SimpleCollection - let actual = JsonInference.inferType inferTypesFromValues culture "" source + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Null makes a record optional``() = let source = JsonValue.Parse """[ {"a":null}, {"a":{"b": 1}} ]""" let expected = - [ { Name = "a"; Type = InferedType.Record(Some "a", [{ Name = "b"; Type = InferedType.Primitive(typeof, None, false) }], true) } ] + [ { Name = "a"; Type = InferedType.Record(Some "a", [{ Name = "b"; Type = InferedType.Primitive(typeof, None, false, false) }], true) } ] |> toRecord |> SimpleCollection - let actual = JsonInference.inferType inferTypesFromValues culture "" source + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Infers mixed fields of a record as heterogeneous type``() = let source = JsonValue.Parse """[ {"a":"hi"}, {"a":2} , {"a":2147483648} ]""" let cases = - Map.ofSeq [ InferedTypeTag.String, InferedType.Primitive(typeof, None, false) - InferedTypeTag.Number, InferedType.Primitive(typeof, None, false) ] + Map.ofSeq [ InferedTypeTag.String, InferedType.Primitive(typeof, None, false, false) + InferedTypeTag.Number, InferedType.Primitive(typeof, None, false, false) ] let expected = - [ { Name = "a"; Type = InferedType.Heterogeneous cases }] + [ { Name = "a"; Type = InferedType.Heterogeneous (cases, false) }] |> toRecord |> SimpleCollection - let actual = JsonInference.inferType inferTypesFromValues culture "" source + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Infers mixed fields of a record as heterogeneous type with nulls (2.)``() = let source = JsonValue.Parse """[ {"a":null}, {"a":2} , {"a":3} ]""" let expected = - [ { Name = "a"; Type = InferedType.Primitive(typeof, None, true) }] + [ { Name = "a"; Type = InferedType.Primitive(typeof, None, true, false) }] |> toRecord |> SimpleCollection - let actual = JsonInference.inferType inferTypesFromValues culture "" source + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] @@ -191,17 +192,17 @@ let ``Inference of multiple nulls works``() = InferedType.Collection ([ InferedTypeTag.Number; InferedTypeTag.Collection ], [ InferedTypeTag.Collection, (Single, SimpleCollection(toRecord [prop])) - InferedTypeTag.Number, (Single, InferedType.Primitive(typeof, None, false)) ] |> Map.ofList) - let actual = JsonInference.inferType inferTypesFromValues culture "" source + InferedTypeTag.Number, (Single, InferedType.Primitive(typeof, None, false, false)) ] |> Map.ofList) + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Inference of DateTime``() = let source = CsvFile.Parse("date,int,float\n2012-12-19,2,3.0\n2012-12-12,4,5.0\n2012-12-1,6,10.0") let actual, _ = inferType source Int32.MaxValue [||] culture "" false false - let propDate = { Name = "date"; Type = InferedType.Primitive(typeof, None, false) } - let propInt = { Name = "int"; Type = InferedType.Primitive(typeof, None, false) } - let propFloat = { Name = "float"; Type = InferedType.Primitive(typeof, None, false) } + let propDate = { Name = "date"; Type = InferedType.Primitive(typeof, None, false, false) } + let propInt = { Name = "int"; Type = InferedType.Primitive(typeof, None, false, false) } + let propFloat = { Name = "float"; Type = InferedType.Primitive(typeof, None, false, false) } let expected = toRecord [ propDate ; propInt ; propFloat ] actual |> should equal expected @@ -209,8 +210,8 @@ let ``Inference of DateTime``() = let ``Inference of DateTime with timestamp``() = let source = CsvFile.Parse("date,timestamp\n2012-12-19,2012-12-19 12:00\n2012-12-12,2012-12-12 00:00\n2012-12-1,2012-12-1 07:00") let actual, _ = inferType source Int32.MaxValue [||] culture "" false false - let propDate = { Name = "date"; Type = InferedType.Primitive(typeof, None, false) } - let propTimestamp = { Name = "timestamp"; Type = InferedType.Primitive(typeof, None, false) } + let propDate = { Name = "date"; Type = InferedType.Primitive(typeof, None, false, false) } + let propTimestamp = { Name = "timestamp"; Type = InferedType.Primitive(typeof, None, false, false) } let expected = toRecord [ propDate ; propTimestamp ] actual |> should equal expected @@ -218,8 +219,8 @@ let ``Inference of DateTime with timestamp``() = let ``Inference of DateTime with timestamp non default separator``() = let source = CsvFile.Parse("date;timestamp\n2012-12-19;2012-12-19 12:00\n2012-12-12;2012-12-12 00:00\n2012-12-1;2012-12-1 07:00", ";") let actual, _ = inferType source Int32.MaxValue [||] culture "" false false - let propDate = { Name = "date"; Type = InferedType.Primitive(typeof, None, false) } - let propTimestamp = { Name = "timestamp"; Type = InferedType.Primitive(typeof, None, false) } + let propDate = { Name = "date"; Type = InferedType.Primitive(typeof, None, false, false) } + let propTimestamp = { Name = "timestamp"; Type = InferedType.Primitive(typeof, None, false, false) } let expected = toRecord [ propDate ; propTimestamp ] actual |> should equal expected @@ -227,8 +228,8 @@ let ``Inference of DateTime with timestamp non default separator``() = let ``Inference of float with #N/A values and non default separator``() = let source = CsvFile.Parse("float;integer\n2.0;2\n#N/A;3\n", ";") let actual, _ = inferType source Int32.MaxValue [|"#N/A"|] culture "" false false - let propFloat = { Name = "float"; Type = InferedType.Primitive(typeof, None, false) } - let propInteger = { Name = "integer"; Type = InferedType.Primitive(typeof, None, false) } + let propFloat = { Name = "float"; Type = InferedType.Primitive(typeof, None, false, false) } + let propInteger = { Name = "integer"; Type = InferedType.Primitive(typeof, None, false, false) } let expected = toRecord [ propFloat ; propInteger ] actual |> should equal expected @@ -239,16 +240,16 @@ let ``Inference of numbers with empty values``() = 2.0,#N/A,,1,1,1,,2010-01-10,yes, ,,2.0,NA,1,foo,2.0,,,2147483648""") let actual, typeOverrides = inferType source Int32.MaxValue [|"#N/A"; "NA"; "foo"|] culture "" false false - let propFloat1 = { Name = "float1"; Type = InferedType.Primitive(typeof, None, true) } - let propFloat2 = { Name = "float2"; Type = InferedType.Primitive(typeof, None, false) } - let propFloat3 = { Name = "float3"; Type = InferedType.Primitive(typeof, None, true) } - let propFloat4 = { Name = "float4"; Type = InferedType.Primitive(typeof, None, false) } - let propInt = { Name = "int"; Type = InferedType.Primitive(typeof, None, true) } - let propFloat5 = { Name = "float5"; Type = InferedType.Primitive(typeof, None, false) } - let propFloat6 = { Name = "float6"; Type = InferedType.Primitive(typeof, None, true) } - let propDate = { Name = "date"; Type = InferedType.Primitive(typeof, None, true) } - let propBool = { Name = "bool"; Type = InferedType.Primitive(typeof, None, true) } - let propInt64 = { Name = "int64"; Type = InferedType.Primitive(typeof, None, true) } + let propFloat1 = { Name = "float1"; Type = InferedType.Primitive(typeof, None, true, false) } + let propFloat2 = { Name = "float2"; Type = InferedType.Primitive(typeof, None, false, false) } + let propFloat3 = { Name = "float3"; Type = InferedType.Primitive(typeof, None, true, false) } + let propFloat4 = { Name = "float4"; Type = InferedType.Primitive(typeof, None, false, false) } + let propInt = { Name = "int"; Type = InferedType.Primitive(typeof, None, true, false) } + let propFloat5 = { Name = "float5"; Type = InferedType.Primitive(typeof, None, false, false) } + let propFloat6 = { Name = "float6"; Type = InferedType.Primitive(typeof, None, true, false) } + let propDate = { Name = "date"; Type = InferedType.Primitive(typeof, None, true, false) } + let propBool = { Name = "bool"; Type = InferedType.Primitive(typeof, None, true, false) } + let propInt64 = { Name = "int64"; Type = InferedType.Primitive(typeof, None, true, false) } let expected = toRecord [ propFloat1; propFloat2; propFloat3; propFloat4; propInt; propFloat5; propFloat6; propDate; propBool; propInt64 ] actual |> should equal expected @@ -363,22 +364,22 @@ let ``Doesn't infer 12-002 as a date``() = let expected = InferedType.Collection ([ InferedTypeTag.String; InferedTypeTag.Number], - [ InferedTypeTag.String, (Multiple, InferedType.Primitive(typeof, None, false)) - InferedTypeTag.Number, (Single, InferedType.Primitive(typeof, None, false)) ] |> Map.ofList) - let actual = JsonInference.inferType inferTypesFromValues culture "" source + [ InferedTypeTag.String, (Multiple, InferedType.Primitive(typeof, None, false, false)) + InferedTypeTag.Number, (Single, InferedType.Primitive(typeof, None, false, false)) ] |> Map.ofList) + let actual = JsonInference.inferType unitsOfMeasureProvider inferenceMode culture "" source actual |> should equal expected [] let ``Doesn't infer ad3mar as a date``() = - StructuralInference.inferPrimitiveType CultureInfo.InvariantCulture "ad3mar" - |> should equal typeof + StructuralInference.inferPrimitiveType unitsOfMeasureProvider inferenceMode CultureInfo.InvariantCulture "ad3mar" None + |> should equal (InferedType.Primitive(typeof, None, false, false)) [] let ``Inference with % suffix``() = let source = CsvFile.Parse("float,integer\n2.0%,2%\n4.0%,3%\n") let actual, _ = inferType source Int32.MaxValue [||] culture "" false false - let propFloat = { Name = "float"; Type = InferedType.Primitive(typeof, None, false) } - let propInteger = { Name = "integer"; Type = InferedType.Primitive(typeof, None, false) } + let propFloat = { Name = "float"; Type = InferedType.Primitive(typeof, None, false, false) } + let propInteger = { Name = "integer"; Type = InferedType.Primitive(typeof, None, false, false) } let expected = toRecord [ propFloat ; propInteger ] actual |> should equal expected @@ -387,8 +388,8 @@ let ``Inference with % suffix``() = let ``Inference with $ prefix``() = let source = CsvFile.Parse("float,integer\n$2.0,$2\n$4.0,$3\n") let actual, _ = inferType source Int32.MaxValue [||] culture "" false false - let propFloat = { Name = "float"; Type = InferedType.Primitive(typeof, None, false) } - let propInteger = { Name = "integer"; Type = InferedType.Primitive(typeof, None, false) } + let propFloat = { Name = "float"; Type = InferedType.Primitive(typeof, None, false, false) } + let propInteger = { Name = "integer"; Type = InferedType.Primitive(typeof, None, false, false) } let expected = toRecord [ propFloat ; propInteger ] actual |> should equal expected @@ -401,7 +402,7 @@ let getInferedTypeFromSamples samples = let culture = System.Globalization.CultureInfo.InvariantCulture samples |> Array.map XElement.Parse - |> XmlInference.inferType true culture false false + |> XmlInference.inferType unitsOfMeasureProvider inferenceMode culture false false |> Seq.fold (subtypeInfered false) InferedType.Top diff --git a/tests/FSharp.Data.DesignTime.Tests/SignatureTestCases.config b/tests/FSharp.Data.DesignTime.Tests/SignatureTestCases.config index cb4260fed..63a6c5092 100644 --- a/tests/FSharp.Data.DesignTime.Tests/SignatureTestCases.config +++ b/tests/FSharp.Data.DesignTime.Tests/SignatureTestCases.config @@ -9,55 +9,187 @@ Csv,Titanic.csv,,passengerid = int ; Pclass -> Class; Parch -> ParentsOrChildren Csv,tendulkarHistoryWithGameNumber.csv,,,true,false,false,,, Csv,cp932.csv,,,true,false,false,NaN (非数値),ja-JP,932 Csv,TimeSpans.csv,,,true,false,false,,, -Xml,Writers.xml,false,false,,true, -Xml,HtmlBody.xml,false,true,,true, -Xml,HtmlBody.xml,false,false,,true, -Xml,http://tomasp.net/blog/rss.aspx,false,true,,true, -Xml,http://tomasp.net/blog/rss.aspx,false,false,,true, -Xml,projects.xml,false,false,,true, -Xml,Philosophy.xml,false,false,,true, -Xml,IrelandStations.xml,true,false,,true, -Xml,AnyFeed.xml,true,false,,true, -Xml,search.atom.xml,true,false,,true, -Xml,search.atom.xml,false,false,,true, -Xml,optionals1.xml,true,false,,true, -Xml,optionals2.xml,true,false,,true, -Xml,optionals3.xml,true,false,,true, -Xml,emptyValue.xml,false,false,,true, -Xml,heterogeneous.xml,false,false,,true, -Xml,missingInnerValue.xml,true,false,,true, -Xml,missingInnerValue.xml,true,true,,true, -Xml,JsonInXml.xml,true,false,,true, -Xml,TypeInference.xml,false,false,,true, -Xml,TypeInference.xml,false,false,,false, -Xml,SampleAzureServiceManagement.xml,false,false,,true, -Xml,TimeSpans.xml,false,false,,true, -Xml,,false,false,,false,po.xsd -Xml,,false,false,,false,homonim.xsd -Xml,,false,false,,false,IncludeFromWeb.xsd -Json,WorldBank.json,false,WorldBank,,true,false,false -Json,TwitterStream.json,true,,,true,false -Json,TwitterSample.json,true,,,true,false -Json,OptionValues.json,false,,,true,false -Json,SimpleArray.json,false,,,true,false -Json,DoubleNested.json,false,,,true,false -Json,Nested.json,false,,,true,false -Json,Simple.json,false,,,true,false -Json,WikiData.json,false,,,true,false -Json,Empty.json,false,,,true,false -Json,projects.json,false,,,true,false -Json,Dates.json,false,,,true,false -Json,GitHub.json,false,,,true,false -Json,topics.json,true,Topic,,true,false -Json,Vindinium.json,false,,,true,false -Json,contacts.json,false,,,true,false -Json,optionals.json,false,,,true,false -Json,reddit.json,false,,,true,false -Json,TypeInference.json,false,,,true,false -Json,TypeInference.json,false,,,false,false -Json,TimeSpans.json,false,,,true,false -Json,DictionaryInference.json,false,,,true,false -Json,DictionaryInference.json,false,,,true,true +Xml,Writers.xml,false,false,,true,,BackwardCompatible +Xml,Writers.xml,false,false,,true,,ValuesOnly +Xml,Writers.xml,false,false,,true,,ValuesAndInlineSchemasHints +Xml,Writers.xml,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,HtmlBody.xml,false,true,,true,,BackwardCompatible +Xml,HtmlBody.xml,false,true,,true,,ValuesOnly +Xml,HtmlBody.xml,false,true,,true,,ValuesAndInlineSchemasHints +Xml,HtmlBody.xml,false,true,,true,,ValuesAndInlineSchemasOverrides +Xml,HtmlBody.xml,false,false,,true,,BackwardCompatible +Xml,HtmlBody.xml,false,false,,true,,ValuesOnly +Xml,HtmlBody.xml,false,false,,true,,ValuesAndInlineSchemasHints +Xml,HtmlBody.xml,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,http://tomasp.net/blog/rss.aspx,false,true,,true,,BackwardCompatible +Xml,http://tomasp.net/blog/rss.aspx,false,true,,true,,ValuesOnly +Xml,http://tomasp.net/blog/rss.aspx,false,true,,true,,ValuesAndInlineSchemasHints +Xml,http://tomasp.net/blog/rss.aspx,false,true,,true,,ValuesAndInlineSchemasOverrides +Xml,http://tomasp.net/blog/rss.aspx,false,false,,true,,BackwardCompatible +Xml,http://tomasp.net/blog/rss.aspx,false,false,,true,,ValuesOnly +Xml,http://tomasp.net/blog/rss.aspx,false,false,,true,,ValuesAndInlineSchemasHints +Xml,http://tomasp.net/blog/rss.aspx,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,projects.xml,false,false,,true,,BackwardCompatible +Xml,projects.xml,false,false,,true,,ValuesOnly +Xml,projects.xml,false,false,,true,,ValuesAndInlineSchemasHints +Xml,projects.xml,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,Philosophy.xml,false,false,,true,,BackwardCompatible +Xml,Philosophy.xml,false,false,,true,,ValuesOnly +Xml,Philosophy.xml,false,false,,true,,ValuesAndInlineSchemasHints +Xml,Philosophy.xml,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,IrelandStations.xml,true,false,,true,,BackwardCompatible +Xml,IrelandStations.xml,true,false,,true,,ValuesOnly +Xml,IrelandStations.xml,true,false,,true,,ValuesAndInlineSchemasHints +Xml,IrelandStations.xml,true,false,,true,,ValuesAndInlineSchemasOverrides +Xml,AnyFeed.xml,true,false,,true,,BackwardCompatible +Xml,AnyFeed.xml,true,false,,true,,ValuesOnly +Xml,AnyFeed.xml,true,false,,true,,ValuesAndInlineSchemasHints +Xml,AnyFeed.xml,true,false,,true,,ValuesAndInlineSchemasOverrides +Xml,search.atom.xml,true,false,,true,,BackwardCompatible +Xml,search.atom.xml,true,false,,true,,ValuesOnly +Xml,search.atom.xml,true,false,,true,,ValuesAndInlineSchemasHints +Xml,search.atom.xml,true,false,,true,,ValuesAndInlineSchemasOverrides +Xml,search.atom.xml,false,false,,true,,BackwardCompatible +Xml,search.atom.xml,false,false,,true,,ValuesOnly +Xml,search.atom.xml,false,false,,true,,ValuesAndInlineSchemasHints +Xml,search.atom.xml,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,optionals1.xml,true,false,,true,,BackwardCompatible +Xml,optionals1.xml,true,false,,true,,ValuesOnly +Xml,optionals1.xml,true,false,,true,,ValuesAndInlineSchemasHints +Xml,optionals1.xml,true,false,,true,,ValuesAndInlineSchemasOverrides +Xml,optionals2.xml,true,false,,true,,BackwardCompatible +Xml,optionals2.xml,true,false,,true,,ValuesOnly +Xml,optionals2.xml,true,false,,true,,ValuesAndInlineSchemasHints +Xml,optionals2.xml,true,false,,true,,ValuesAndInlineSchemasOverrides +Xml,optionals3.xml,true,false,,true,,BackwardCompatible +Xml,optionals3.xml,true,false,,true,,ValuesOnly +Xml,optionals3.xml,true,false,,true,,ValuesAndInlineSchemasHints +Xml,optionals3.xml,true,false,,true,,ValuesAndInlineSchemasOverrides +Xml,emptyValue.xml,false,false,,true,,BackwardCompatible +Xml,emptyValue.xml,false,false,,true,,ValuesOnly +Xml,emptyValue.xml,false,false,,true,,ValuesAndInlineSchemasHints +Xml,emptyValue.xml,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,heterogeneous.xml,false,false,,true,,BackwardCompatible +Xml,heterogeneous.xml,false,false,,true,,ValuesOnly +Xml,heterogeneous.xml,false,false,,true,,ValuesAndInlineSchemasHints +Xml,heterogeneous.xml,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,missingInnerValue.xml,true,false,,true,,BackwardCompatible +Xml,missingInnerValue.xml,true,false,,true,,ValuesOnly +Xml,missingInnerValue.xml,true,false,,true,,ValuesAndInlineSchemasHints +Xml,missingInnerValue.xml,true,false,,true,,ValuesAndInlineSchemasOverrides +Xml,missingInnerValue.xml,true,true,,true,,BackwardCompatible +Xml,missingInnerValue.xml,true,true,,true,,ValuesOnly +Xml,missingInnerValue.xml,true,true,,true,,ValuesAndInlineSchemasHints +Xml,missingInnerValue.xml,true,true,,true,,ValuesAndInlineSchemasOverrides +Xml,JsonInXml.xml,true,false,,true,,BackwardCompatible +Xml,JsonInXml.xml,true,false,,true,,ValuesOnly +Xml,JsonInXml.xml,true,false,,true,,ValuesAndInlineSchemasHints +Xml,JsonInXml.xml,true,false,,true,,ValuesAndInlineSchemasOverrides +Xml,TypeInference.xml,false,false,,true,,BackwardCompatible +Xml,TypeInference.xml,false,false,,true,,ValuesOnly +Xml,TypeInference.xml,false,false,,true,,ValuesAndInlineSchemasHints +Xml,TypeInference.xml,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,TypeInference.xml,false,false,,false,,BackwardCompatible +Xml,SampleAzureServiceManagement.xml,false,false,,true,,BackwardCompatible +Xml,SampleAzureServiceManagement.xml,false,false,,true,,ValuesOnly +Xml,SampleAzureServiceManagement.xml,false,false,,true,,ValuesAndInlineSchemasHints +Xml,SampleAzureServiceManagement.xml,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,TimeSpans.xml,false,false,,true,,BackwardCompatible +Xml,TimeSpans.xml,false,false,,true,,ValuesOnly +Xml,TimeSpans.xml,false,false,,true,,ValuesAndInlineSchemasHints +Xml,TimeSpans.xml,false,false,,true,,ValuesAndInlineSchemasOverrides +Xml,,false,false,,false,po.xsd,BackwardCompatible +Xml,,false,false,,false,homonim.xsd,BackwardCompatible +Xml,,false,false,,false,IncludeFromWeb.xsd,BackwardCompatible +Json,WorldBank.json,false,WorldBank,,true,false,BackwardCompatible +Json,WorldBank.json,false,WorldBank,,true,false,ValuesOnly +Json,WorldBank.json,false,WorldBank,,true,false,ValuesAndInlineSchemasHints +Json,WorldBank.json,false,WorldBank,,true,false,ValuesAndInlineSchemasOverrides +Json,TwitterStream.json,true,,,true,false,BackwardCompatible +Json,TwitterStream.json,true,,,true,false,ValuesOnly +Json,TwitterStream.json,true,,,true,false,ValuesAndInlineSchemasHints +Json,TwitterStream.json,true,,,true,false,ValuesAndInlineSchemasOverrides +Json,TwitterSample.json,true,,,true,false,BackwardCompatible +Json,TwitterSample.json,true,,,true,false,ValuesOnly +Json,TwitterSample.json,true,,,true,false,ValuesAndInlineSchemasHints +Json,TwitterSample.json,true,,,true,false,ValuesAndInlineSchemasOverrides +Json,OptionValues.json,false,,,true,false,BackwardCompatible +Json,OptionValues.json,false,,,true,false,ValuesOnly +Json,OptionValues.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,OptionValues.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,SimpleArray.json,false,,,true,false,BackwardCompatible +Json,SimpleArray.json,false,,,true,false,ValuesOnly +Json,SimpleArray.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,SimpleArray.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,DoubleNested.json,false,,,true,false,BackwardCompatible +Json,DoubleNested.json,false,,,true,false,ValuesOnly +Json,DoubleNested.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,DoubleNested.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,Nested.json,false,,,true,false,BackwardCompatible +Json,Nested.json,false,,,true,false,ValuesOnly +Json,Nested.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,Nested.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,Simple.json,false,,,true,false,BackwardCompatible +Json,Simple.json,false,,,true,false,ValuesOnly +Json,Simple.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,Simple.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,WikiData.json,false,,,true,false,BackwardCompatible +Json,WikiData.json,false,,,true,false,ValuesOnly +Json,WikiData.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,WikiData.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,Empty.json,false,,,true,false,BackwardCompatible +Json,Empty.json,false,,,true,false,ValuesOnly +Json,Empty.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,Empty.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,projects.json,false,,,true,false,BackwardCompatible +Json,projects.json,false,,,true,false,ValuesOnly +Json,projects.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,projects.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,Dates.json,false,,,true,false,BackwardCompatible +Json,Dates.json,false,,,true,false,ValuesOnly +Json,Dates.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,Dates.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,GitHub.json,false,,,true,false,BackwardCompatible +Json,GitHub.json,false,,,true,false,ValuesOnly +Json,GitHub.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,GitHub.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,topics.json,true,Topic,,true,false,BackwardCompatible +Json,topics.json,true,Topic,,true,false,ValuesOnly +Json,topics.json,true,Topic,,true,false,ValuesAndInlineSchemasHints +Json,topics.json,true,Topic,,true,false,ValuesAndInlineSchemasOverrides +Json,Vindinium.json,false,,,true,false,BackwardCompatible +Json,Vindinium.json,false,,,true,false,ValuesOnly +Json,Vindinium.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,Vindinium.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,contacts.json,false,,,true,false,BackwardCompatible +Json,contacts.json,false,,,true,false,ValuesOnly +Json,contacts.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,contacts.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,optionals.json,false,,,true,false,BackwardCompatible +Json,optionals.json,false,,,true,false,ValuesOnly +Json,optionals.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,optionals.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,reddit.json,false,,,true,false,BackwardCompatible +Json,reddit.json,false,,,true,false,ValuesOnly +Json,reddit.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,reddit.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,TypeInference.json,false,,,true,false,BackwardCompatible +Json,TypeInference.json,false,,,true,false,ValuesOnly +Json,TypeInference.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,TypeInference.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,TypeInference.json,false,,,false,false,BackwardCompatible +Json,TimeSpans.json,false,,,true,false,BackwardCompatible +Json,TimeSpans.json,false,,,true,false,ValuesOnly +Json,TimeSpans.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,TimeSpans.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,DictionaryInference.json,false,,,true,false,BackwardCompatible +Json,DictionaryInference.json,false,,,true,false,ValuesOnly +Json,DictionaryInference.json,false,,,true,false,ValuesAndInlineSchemasHints +Json,DictionaryInference.json,false,,,true,false,ValuesAndInlineSchemasOverrides +Json,DictionaryInference.json,false,,,true,true,BackwardCompatible +Json,DictionaryInference.json,false,,,true,true,ValuesOnly +Json,DictionaryInference.json,false,,,true,true,ValuesAndInlineSchemasHints +Json,DictionaryInference.json,false,,,true,true,ValuesAndInlineSchemasOverrides Html,MarketDepth.htm,false,false, Html,MarketDepth.htm,true,false, Html,SimpleHtmlTablesWithTr.html,false,false, diff --git a/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs b/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs index 485ff887f..422e0fdde 100644 --- a/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs +++ b/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs @@ -6,6 +6,7 @@ open ProviderImplementation open ProviderImplementation.ProvidedTypes open ProviderImplementation.ProvidedTypesTesting open FSharp.Data.Runtime +open FSharp.Data.Runtime.StructuralInference type CsvProviderArgs = { Sample : string @@ -34,7 +35,8 @@ type XmlProviderArgs = ResolutionFolder : string EmbeddedResource : string InferTypesFromValues : bool - Schema : string } + Schema : string + InferenceMode: InferenceMode } type JsonProviderArgs = { Sample : string @@ -45,7 +47,8 @@ type JsonProviderArgs = ResolutionFolder : string EmbeddedResource : string InferTypesFromValues : bool - PreferDictionaries : bool } + PreferDictionaries : bool + InferenceMode: InferenceMode } type HtmlProviderArgs = { Sample : string @@ -101,7 +104,8 @@ type TypeProviderInstantiation = box x.ResolutionFolder box x.EmbeddedResource box x.InferTypesFromValues - box x.Schema |] + box x.Schema + box x.InferenceMode |] | Json x -> (fun cfg -> new JsonProvider(cfg) :> TypeProviderForNamespaces), [| box x.Sample @@ -112,7 +116,8 @@ type TypeProviderInstantiation = box x.ResolutionFolder box x.EmbeddedResource box x.InferTypesFromValues - box x.PreferDictionaries |] + box x.PreferDictionaries + box x.InferenceMode |] | Html x -> (fun cfg -> new HtmlProvider(cfg) :> TypeProviderForNamespaces), [| box x.Sample @@ -150,7 +155,8 @@ type TypeProviderInstantiation = x.Global.ToString() x.Culture x.InferTypesFromValues.ToString() - x.Schema ] + x.Schema + x.InferenceMode.ToString() ] | Json x -> ["Json" x.Sample @@ -158,17 +164,18 @@ type TypeProviderInstantiation = x.RootName x.Culture x.InferTypesFromValues.ToString() - x.PreferDictionaries.ToString() ] + x.PreferDictionaries.ToString() + x.InferenceMode.ToString() ] | Html x -> ["Html" x.Sample x.PreferOptionals.ToString() x.IncludeLayoutTables.ToString() - x.Culture] + x.Culture ] | WorldBank x -> ["WorldBank" x.Sources - x.Asynchronous.ToString()] + x.Asynchronous.ToString() ] |> String.concat "," member x.ExpectedPath outputFolder = @@ -217,7 +224,8 @@ type TypeProviderInstantiation = ResolutionFolder = "" EmbeddedResource = "" InferTypesFromValues = args.[5] |> bool.Parse - Schema = args.[6] } + Schema = args.[6] + InferenceMode = args.[7] |> InferenceMode.Parse } | "Json" -> Json { Sample = args.[1] SampleIsList = args.[2] |> bool.Parse @@ -227,7 +235,8 @@ type TypeProviderInstantiation = ResolutionFolder = "" EmbeddedResource = "" InferTypesFromValues = args.[5] |> bool.Parse - PreferDictionaries = args.[6] |> bool.Parse } + PreferDictionaries = args.[6] |> bool.Parse + InferenceMode = args.[7] |> InferenceMode.Parse } | "Html" -> Html { Sample = args.[1] PreferOptionals = args.[2] |> bool.Parse diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..3c334c01c --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,62 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Dates.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Dates.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : birthdate:System.DateTime -> anniversary:System.DateTimeOffset -> noTimeZone:System.DateTime -> utcTime:System.DateTimeOffset -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("birthdate", + (birthdate :> obj)) + ("anniversary", + (anniversary :> obj)) + ("NoTimeZone", + (noTimeZone :> obj)) + ("UtcTime", + (utcTime :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Anniversary: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "anniversary") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + member Birthdate: System.DateTime with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "birthdate") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTime("", value.JsonOpt), value.JsonOpt) + + member NoTimeZone: System.DateTime with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "NoTimeZone") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTime("", value.JsonOpt), value.JsonOpt) + + member UtcTime: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "UtcTime") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..3c334c01c --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,62 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Dates.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Dates.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : birthdate:System.DateTime -> anniversary:System.DateTimeOffset -> noTimeZone:System.DateTime -> utcTime:System.DateTimeOffset -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("birthdate", + (birthdate :> obj)) + ("anniversary", + (anniversary :> obj)) + ("NoTimeZone", + (noTimeZone :> obj)) + ("UtcTime", + (utcTime :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Anniversary: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "anniversary") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + member Birthdate: System.DateTime with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "birthdate") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTime("", value.JsonOpt), value.JsonOpt) + + member NoTimeZone: System.DateTime with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "NoTimeZone") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTime("", value.JsonOpt), value.JsonOpt) + + member UtcTime: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "UtcTime") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..3c334c01c --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Dates.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,62 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Dates.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Dates.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : birthdate:System.DateTime -> anniversary:System.DateTimeOffset -> noTimeZone:System.DateTime -> utcTime:System.DateTimeOffset -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("birthdate", + (birthdate :> obj)) + ("anniversary", + (anniversary :> obj)) + ("NoTimeZone", + (noTimeZone :> obj)) + ("UtcTime", + (utcTime :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Anniversary: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "anniversary") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + member Birthdate: System.DateTime with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "birthdate") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTime("", value.JsonOpt), value.JsonOpt) + + member NoTimeZone: System.DateTime with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "NoTimeZone") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTime("", value.JsonOpt), value.JsonOpt) + + member UtcTime: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "UtcTime") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..9b488861b --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,96 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : rec:JsonProvider+Rec -> rec2:JsonProvider+Rec2 -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("rec", + (rec :> obj)) + ("rec2", + (rec2 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Rec: JsonProvider+Rec with get + JsonRuntime.GetPropertyPacked(this, "rec") + + member Rec2: JsonProvider+Rec2 with get + JsonRuntime.GetPropertyPacked(this, "rec2") + + +class JsonProvider+Rec : FDR.BaseTypes.IJsonDocument + new : 0:int -> 1:int option -> JsonProvider+Rec + JsonRuntime.CreateRecord([| ("0", + (0 :> obj)) + ("1", + (1 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Rec + JsonDocument.Create(jsonValue, "") + + member 0: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "0") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member 1: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "1")) + + +class JsonProvider+Rec2 : FDR.BaseTypes.IJsonDocument + new : 0:JsonProvider+0 option -> 1:JsonProvider+0 -> JsonProvider+Rec2 + JsonRuntime.CreateRecord([| ("0", + (0 :> obj)) + ("1", + (1 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Rec2 + JsonDocument.Create(jsonValue, "") + + member 0: JsonProvider+0 option with get + JsonRuntime.TryGetPropertyPacked(this, "0") + + member 1: JsonProvider+0 with get + JsonRuntime.GetPropertyPacked(this, "1") + + +class JsonProvider+0 : FDR.BaseTypes.IJsonDocument + new : a:int -> JsonProvider+0 + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+0 + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..9b488861b --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,96 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : rec:JsonProvider+Rec -> rec2:JsonProvider+Rec2 -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("rec", + (rec :> obj)) + ("rec2", + (rec2 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Rec: JsonProvider+Rec with get + JsonRuntime.GetPropertyPacked(this, "rec") + + member Rec2: JsonProvider+Rec2 with get + JsonRuntime.GetPropertyPacked(this, "rec2") + + +class JsonProvider+Rec : FDR.BaseTypes.IJsonDocument + new : 0:int -> 1:int option -> JsonProvider+Rec + JsonRuntime.CreateRecord([| ("0", + (0 :> obj)) + ("1", + (1 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Rec + JsonDocument.Create(jsonValue, "") + + member 0: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "0") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member 1: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "1")) + + +class JsonProvider+Rec2 : FDR.BaseTypes.IJsonDocument + new : 0:JsonProvider+0 option -> 1:JsonProvider+0 -> JsonProvider+Rec2 + JsonRuntime.CreateRecord([| ("0", + (0 :> obj)) + ("1", + (1 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Rec2 + JsonDocument.Create(jsonValue, "") + + member 0: JsonProvider+0 option with get + JsonRuntime.TryGetPropertyPacked(this, "0") + + member 1: JsonProvider+0 with get + JsonRuntime.GetPropertyPacked(this, "1") + + +class JsonProvider+0 : FDR.BaseTypes.IJsonDocument + new : a:int -> JsonProvider+0 + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+0 + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..9b488861b --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,96 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : rec:JsonProvider+Rec -> rec2:JsonProvider+Rec2 -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("rec", + (rec :> obj)) + ("rec2", + (rec2 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Rec: JsonProvider+Rec with get + JsonRuntime.GetPropertyPacked(this, "rec") + + member Rec2: JsonProvider+Rec2 with get + JsonRuntime.GetPropertyPacked(this, "rec2") + + +class JsonProvider+Rec : FDR.BaseTypes.IJsonDocument + new : 0:int -> 1:int option -> JsonProvider+Rec + JsonRuntime.CreateRecord([| ("0", + (0 :> obj)) + ("1", + (1 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Rec + JsonDocument.Create(jsonValue, "") + + member 0: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "0") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member 1: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "1")) + + +class JsonProvider+Rec2 : FDR.BaseTypes.IJsonDocument + new : 0:JsonProvider+0 option -> 1:JsonProvider+0 -> JsonProvider+Rec2 + JsonRuntime.CreateRecord([| ("0", + (0 :> obj)) + ("1", + (1 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Rec2 + JsonDocument.Create(jsonValue, "") + + member 0: JsonProvider+0 option with get + JsonRuntime.TryGetPropertyPacked(this, "0") + + member 1: JsonProvider+0 with get + JsonRuntime.GetPropertyPacked(this, "1") + + +class JsonProvider+0 : FDR.BaseTypes.IJsonDocument + new : a:int -> JsonProvider+0 + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+0 + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..c27719b9d --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,125 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : rec:JsonProvider+Rec -> rec2:JsonProvider+Rec2 -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("rec", + (rec :> obj)) + ("rec2", + (rec2 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Rec: JsonProvider+Rec with get + JsonRuntime.GetPropertyPacked(this, "rec") + + member Rec2: JsonProvider+Rec2 with get + JsonRuntime.GetPropertyPacked(this, "rec2") + + +class JsonProvider+Rec : FDR.BaseTypes.IJsonDocument + new : items:bool * int seq -> JsonProvider+Rec + JsonRuntime.CreateRecordFromDictionary(items, "", new Func<_,_>(fun (t:bool) -> TextRuntime.ConvertBooleanBack(Some t, false))) + + new : jsonValue:JsonValue -> JsonProvider+Rec + JsonDocument.Create(jsonValue, "") + + member ContainsKey: key:bool -> bool + JsonRuntime.InferedDictionaryContainsKey(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), key) + + member Count: int with get + JsonRuntime.GetRecordProperties(this).Length + + member IsEmpty: bool with get + (Operators.op_Equality JsonRuntime.GetRecordProperties(this).Length 0) + + member Item: int with get + JsonRuntime.GetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue)), key) + + member Items: bool * int seq with get + JsonRuntime.ConvertRecordToDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Keys: bool[] with get + JsonRuntime.GetKeysFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member TryFind: key:bool -> int option + JsonRuntime.TryGetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue)), key) + + member Values: int[] with get + JsonRuntime.GetValuesFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Rec2 : FDR.BaseTypes.IJsonDocument + new : items:bool * JsonProvider+Rec2Value seq -> JsonProvider+Rec2 + JsonRuntime.CreateRecordFromDictionary(items, "", new Func<_,_>(fun (t:bool) -> TextRuntime.ConvertBooleanBack(Some t, false))) + + new : jsonValue:JsonValue -> JsonProvider+Rec2 + JsonDocument.Create(jsonValue, "") + + member ContainsKey: key:bool -> bool + JsonRuntime.InferedDictionaryContainsKey(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), key) + + member Count: int with get + JsonRuntime.GetRecordProperties(this).Length + + member IsEmpty: bool with get + (Operators.op_Equality JsonRuntime.GetRecordProperties(this).Length 0) + + member Item: JsonProvider+Rec2Value with get + JsonRuntime.GetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(id)), key) + + member Items: bool * JsonProvider+Rec2Value seq with get + JsonRuntime.ConvertRecordToDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(id))) + + member Keys: bool[] with get + JsonRuntime.GetKeysFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member TryFind: key:bool -> JsonProvider+Rec2Value option + JsonRuntime.TryGetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(id)), key) + + member Values: JsonProvider+JsonProvider+Rec2Value[] with get + JsonRuntime.GetValuesFromInferedDictionary(this, new Func<_,_>(id))) + + +class JsonProvider+Rec2Value : FDR.BaseTypes.IJsonDocument + new : a:int -> JsonProvider+Rec2Value + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Rec2Value + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..c27719b9d --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,125 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : rec:JsonProvider+Rec -> rec2:JsonProvider+Rec2 -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("rec", + (rec :> obj)) + ("rec2", + (rec2 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Rec: JsonProvider+Rec with get + JsonRuntime.GetPropertyPacked(this, "rec") + + member Rec2: JsonProvider+Rec2 with get + JsonRuntime.GetPropertyPacked(this, "rec2") + + +class JsonProvider+Rec : FDR.BaseTypes.IJsonDocument + new : items:bool * int seq -> JsonProvider+Rec + JsonRuntime.CreateRecordFromDictionary(items, "", new Func<_,_>(fun (t:bool) -> TextRuntime.ConvertBooleanBack(Some t, false))) + + new : jsonValue:JsonValue -> JsonProvider+Rec + JsonDocument.Create(jsonValue, "") + + member ContainsKey: key:bool -> bool + JsonRuntime.InferedDictionaryContainsKey(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), key) + + member Count: int with get + JsonRuntime.GetRecordProperties(this).Length + + member IsEmpty: bool with get + (Operators.op_Equality JsonRuntime.GetRecordProperties(this).Length 0) + + member Item: int with get + JsonRuntime.GetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue)), key) + + member Items: bool * int seq with get + JsonRuntime.ConvertRecordToDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Keys: bool[] with get + JsonRuntime.GetKeysFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member TryFind: key:bool -> int option + JsonRuntime.TryGetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue)), key) + + member Values: int[] with get + JsonRuntime.GetValuesFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Rec2 : FDR.BaseTypes.IJsonDocument + new : items:bool * JsonProvider+Rec2Value seq -> JsonProvider+Rec2 + JsonRuntime.CreateRecordFromDictionary(items, "", new Func<_,_>(fun (t:bool) -> TextRuntime.ConvertBooleanBack(Some t, false))) + + new : jsonValue:JsonValue -> JsonProvider+Rec2 + JsonDocument.Create(jsonValue, "") + + member ContainsKey: key:bool -> bool + JsonRuntime.InferedDictionaryContainsKey(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), key) + + member Count: int with get + JsonRuntime.GetRecordProperties(this).Length + + member IsEmpty: bool with get + (Operators.op_Equality JsonRuntime.GetRecordProperties(this).Length 0) + + member Item: JsonProvider+Rec2Value with get + JsonRuntime.GetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(id)), key) + + member Items: bool * JsonProvider+Rec2Value seq with get + JsonRuntime.ConvertRecordToDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(id))) + + member Keys: bool[] with get + JsonRuntime.GetKeysFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member TryFind: key:bool -> JsonProvider+Rec2Value option + JsonRuntime.TryGetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(id)), key) + + member Values: JsonProvider+JsonProvider+Rec2Value[] with get + JsonRuntime.GetValuesFromInferedDictionary(this, new Func<_,_>(id))) + + +class JsonProvider+Rec2Value : FDR.BaseTypes.IJsonDocument + new : a:int -> JsonProvider+Rec2Value + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Rec2Value + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,ValuesOnly.expected new file mode 100644 index 000000000..c27719b9d --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DictionaryInference.json,False,,,True,True,ValuesOnly.expected @@ -0,0 +1,125 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DictionaryInference.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : rec:JsonProvider+Rec -> rec2:JsonProvider+Rec2 -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("rec", + (rec :> obj)) + ("rec2", + (rec2 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Rec: JsonProvider+Rec with get + JsonRuntime.GetPropertyPacked(this, "rec") + + member Rec2: JsonProvider+Rec2 with get + JsonRuntime.GetPropertyPacked(this, "rec2") + + +class JsonProvider+Rec : FDR.BaseTypes.IJsonDocument + new : items:bool * int seq -> JsonProvider+Rec + JsonRuntime.CreateRecordFromDictionary(items, "", new Func<_,_>(fun (t:bool) -> TextRuntime.ConvertBooleanBack(Some t, false))) + + new : jsonValue:JsonValue -> JsonProvider+Rec + JsonDocument.Create(jsonValue, "") + + member ContainsKey: key:bool -> bool + JsonRuntime.InferedDictionaryContainsKey(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), key) + + member Count: int with get + JsonRuntime.GetRecordProperties(this).Length + + member IsEmpty: bool with get + (Operators.op_Equality JsonRuntime.GetRecordProperties(this).Length 0) + + member Item: int with get + JsonRuntime.GetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue)), key) + + member Items: bool * int seq with get + JsonRuntime.ConvertRecordToDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Keys: bool[] with get + JsonRuntime.GetKeysFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member TryFind: key:bool -> int option + JsonRuntime.TryGetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue)), key) + + member Values: int[] with get + JsonRuntime.GetValuesFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Rec2 : FDR.BaseTypes.IJsonDocument + new : items:bool * JsonProvider+Rec2Value seq -> JsonProvider+Rec2 + JsonRuntime.CreateRecordFromDictionary(items, "", new Func<_,_>(fun (t:bool) -> TextRuntime.ConvertBooleanBack(Some t, false))) + + new : jsonValue:JsonValue -> JsonProvider+Rec2 + JsonDocument.Create(jsonValue, "") + + member ContainsKey: key:bool -> bool + JsonRuntime.InferedDictionaryContainsKey(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), key) + + member Count: int with get + JsonRuntime.GetRecordProperties(this).Length + + member IsEmpty: bool with get + (Operators.op_Equality JsonRuntime.GetRecordProperties(this).Length 0) + + member Item: JsonProvider+Rec2Value with get + JsonRuntime.GetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(id)), key) + + member Items: bool * JsonProvider+Rec2Value seq with get + JsonRuntime.ConvertRecordToDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(id))) + + member Keys: bool[] with get + JsonRuntime.GetKeysFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member TryFind: key:bool -> JsonProvider+Rec2Value option + JsonRuntime.TryGetValueByKeyFromInferedDictionary(this, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue)), new Func<_,_>(id)), key) + + member Values: JsonProvider+JsonProvider+Rec2Value[] with get + JsonRuntime.GetValuesFromInferedDictionary(this, new Func<_,_>(id))) + + +class JsonProvider+Rec2Value : FDR.BaseTypes.IJsonDocument + new : a:int -> JsonProvider+Rec2Value + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Rec2Value + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..d3194e87e --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,74 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DoubleNested.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DoubleNested.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : main:JsonProvider+Main -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("main", + (main :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Main: JsonProvider+Main with get + JsonRuntime.GetPropertyPacked(this, "main") + + +class JsonProvider+Main : FDR.BaseTypes.IJsonDocument + new : title:string -> nested:JsonProvider+Nested -> JsonProvider+Main + JsonRuntime.CreateRecord([| ("title", + (title :> obj)) + ("nested", + (nested :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Main + JsonDocument.Create(jsonValue, "") + + member Nested: JsonProvider+Nested with get + JsonRuntime.GetPropertyPacked(this, "nested") + + member Title: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "title") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Nested : FDR.BaseTypes.IJsonDocument + new : nestedTitle:string -> JsonProvider+Nested + JsonRuntime.CreateRecord([| ("nestedTitle", + (nestedTitle :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Nested + JsonDocument.Create(jsonValue, "") + + member NestedTitle: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "nestedTitle") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..d3194e87e --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,74 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DoubleNested.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DoubleNested.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : main:JsonProvider+Main -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("main", + (main :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Main: JsonProvider+Main with get + JsonRuntime.GetPropertyPacked(this, "main") + + +class JsonProvider+Main : FDR.BaseTypes.IJsonDocument + new : title:string -> nested:JsonProvider+Nested -> JsonProvider+Main + JsonRuntime.CreateRecord([| ("title", + (title :> obj)) + ("nested", + (nested :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Main + JsonDocument.Create(jsonValue, "") + + member Nested: JsonProvider+Nested with get + JsonRuntime.GetPropertyPacked(this, "nested") + + member Title: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "title") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Nested : FDR.BaseTypes.IJsonDocument + new : nestedTitle:string -> JsonProvider+Nested + JsonRuntime.CreateRecord([| ("nestedTitle", + (nestedTitle :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Nested + JsonDocument.Create(jsonValue, "") + + member NestedTitle: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "nestedTitle") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..d3194e87e --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,DoubleNested.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,74 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DoubleNested.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "DoubleNested.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : main:JsonProvider+Main -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("main", + (main :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Main: JsonProvider+Main with get + JsonRuntime.GetPropertyPacked(this, "main") + + +class JsonProvider+Main : FDR.BaseTypes.IJsonDocument + new : title:string -> nested:JsonProvider+Nested -> JsonProvider+Main + JsonRuntime.CreateRecord([| ("title", + (title :> obj)) + ("nested", + (nested :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Main + JsonDocument.Create(jsonValue, "") + + member Nested: JsonProvider+Nested with get + JsonRuntime.GetPropertyPacked(this, "nested") + + member Title: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "title") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Nested : FDR.BaseTypes.IJsonDocument + new : nestedTitle:string -> JsonProvider+Nested + JsonRuntime.CreateRecord([| ("nestedTitle", + (nestedTitle :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Nested + JsonDocument.Create(jsonValue, "") + + member NestedTitle: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "nestedTitle") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..4a04b2274 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,39 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Empty.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Empty.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : () -> JsonProvider+Root + JsonRuntime.CreateRecord([| |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..4a04b2274 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,39 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Empty.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Empty.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : () -> JsonProvider+Root + JsonRuntime.CreateRecord([| |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..4a04b2274 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Empty.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,39 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Empty.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Empty.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : () -> JsonProvider+Root + JsonRuntime.CreateRecord([| |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..9284c6787 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,314 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "GitHub.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "GitHub.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : url:string -> labelsUrl:string -> commentsUrl:string -> eventsUrl:string -> htmlUrl:string -> id:int -> number:int -> title:string -> user:JsonProvider+User -> labels:JsonProvider+JsonProvider+Label[] -> state:string -> assignee:JsonValue -> milestone:JsonValue -> comments:int -> createdAt:System.DateTimeOffset -> updatedAt:System.DateTimeOffset -> closedAt:JsonValue -> pullRequest:JsonProvider+PullRequest -> body:string option -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("url", + (url :> obj)) + ("labels_url", + (labelsUrl :> obj)) + ("comments_url", + (commentsUrl :> obj)) + ("events_url", + (eventsUrl :> obj)) + ("html_url", + (htmlUrl :> obj)) + ("id", + (id :> obj)) + ("number", + (number :> obj)) + ("title", + (title :> obj)) + ("user", + (user :> obj)) + ("labels", + (labels :> obj)) + ("state", + (state :> obj)) + ("assignee", + (assignee :> obj)) + ("milestone", + (milestone :> obj)) + ("comments", + (comments :> obj)) + ("created_at", + (createdAt :> obj)) + ("updated_at", + (updatedAt :> obj)) + ("closed_at", + (closedAt :> obj)) + ("pull_request", + (pullRequest :> obj)) + ("body", + (body :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Assignee: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "assignee") + + member Body: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "body")) + + member ClosedAt: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "closed_at") + + member Comments: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "comments") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member CommentsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "comments_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member CreatedAt: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + member EventsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "events_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member HtmlUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "html_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Labels: JsonProvider+JsonProvider+Label[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "labels"), new Func<_,_>(id))) + + member LabelsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "labels_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Milestone: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "milestone") + + member Number: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "number") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member PullRequest: JsonProvider+PullRequest with get + JsonRuntime.GetPropertyPacked(this, "pull_request") + + member State: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "state") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Title: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "title") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member UpdatedAt: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "updated_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member User: JsonProvider+User with get + JsonRuntime.GetPropertyPacked(this, "user") + + +class JsonProvider+Label : FDR.BaseTypes.IJsonDocument + new : url:string -> name:string -> color:JsonProvider+FloatOrString -> JsonProvider+Label + JsonRuntime.CreateRecord([| ("url", + (url :> obj)) + ("name", + (name :> obj)) + ("color", + (color :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Label + JsonDocument.Create(jsonValue, "") + + member Color: JsonProvider+FloatOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "color") + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+PullRequest : FDR.BaseTypes.IJsonDocument + new : htmlUrl:string option -> diffUrl:string option -> patchUrl:string option -> JsonProvider+PullRequest + JsonRuntime.CreateRecord([| ("html_url", + (htmlUrl :> obj)) + ("diff_url", + (diffUrl :> obj)) + ("patch_url", + (patchUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+PullRequest + JsonDocument.Create(jsonValue, "") + + member DiffUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "diff_url")) + + member HtmlUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "html_url")) + + member PatchUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "patch_url")) + + +class JsonProvider+User : FDR.BaseTypes.IJsonDocument + new : login:string -> id:int -> avatarUrl:string -> gravatarId:System.Guid -> url:string -> htmlUrl:string -> followersUrl:string -> followingUrl:string -> gistsUrl:string -> starredUrl:string -> subscriptionsUrl:string -> organizationsUrl:string -> reposUrl:string -> eventsUrl:string -> receivedEventsUrl:string -> type:string -> JsonProvider+User + JsonRuntime.CreateRecord([| ("login", + (login :> obj)) + ("id", + (id :> obj)) + ("avatar_url", + (avatarUrl :> obj)) + ("gravatar_id", + (gravatarId :> obj)) + ("url", + (url :> obj)) + ("html_url", + (htmlUrl :> obj)) + ("followers_url", + (followersUrl :> obj)) + ("following_url", + (followingUrl :> obj)) + ("gists_url", + (gistsUrl :> obj)) + ("starred_url", + (starredUrl :> obj)) + ("subscriptions_url", + (subscriptionsUrl :> obj)) + ("organizations_url", + (organizationsUrl :> obj)) + ("repos_url", + (reposUrl :> obj)) + ("events_url", + (eventsUrl :> obj)) + ("received_events_url", + (receivedEventsUrl :> obj)) + ("type", + (type :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User + JsonDocument.Create(jsonValue, "") + + member AvatarUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "avatar_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member EventsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "events_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FollowersUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FollowingUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "following_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member GistsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gists_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member GravatarId: System.Guid with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gravatar_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertGuid(value.JsonOpt), value.JsonOpt) + + member HtmlUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "html_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Login: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "login") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member OrganizationsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "organizations_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ReceivedEventsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "received_events_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ReposUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "repos_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StarredUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "starred_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SubscriptionsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "subscriptions_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+FloatOrString : FDR.BaseTypes.IJsonDocument + new : number:float -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+FloatOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+FloatOrString + JsonDocument.Create(jsonValue, "") + + member Number: float option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertFloat("", "", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..9284c6787 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,314 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "GitHub.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "GitHub.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : url:string -> labelsUrl:string -> commentsUrl:string -> eventsUrl:string -> htmlUrl:string -> id:int -> number:int -> title:string -> user:JsonProvider+User -> labels:JsonProvider+JsonProvider+Label[] -> state:string -> assignee:JsonValue -> milestone:JsonValue -> comments:int -> createdAt:System.DateTimeOffset -> updatedAt:System.DateTimeOffset -> closedAt:JsonValue -> pullRequest:JsonProvider+PullRequest -> body:string option -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("url", + (url :> obj)) + ("labels_url", + (labelsUrl :> obj)) + ("comments_url", + (commentsUrl :> obj)) + ("events_url", + (eventsUrl :> obj)) + ("html_url", + (htmlUrl :> obj)) + ("id", + (id :> obj)) + ("number", + (number :> obj)) + ("title", + (title :> obj)) + ("user", + (user :> obj)) + ("labels", + (labels :> obj)) + ("state", + (state :> obj)) + ("assignee", + (assignee :> obj)) + ("milestone", + (milestone :> obj)) + ("comments", + (comments :> obj)) + ("created_at", + (createdAt :> obj)) + ("updated_at", + (updatedAt :> obj)) + ("closed_at", + (closedAt :> obj)) + ("pull_request", + (pullRequest :> obj)) + ("body", + (body :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Assignee: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "assignee") + + member Body: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "body")) + + member ClosedAt: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "closed_at") + + member Comments: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "comments") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member CommentsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "comments_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member CreatedAt: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + member EventsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "events_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member HtmlUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "html_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Labels: JsonProvider+JsonProvider+Label[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "labels"), new Func<_,_>(id))) + + member LabelsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "labels_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Milestone: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "milestone") + + member Number: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "number") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member PullRequest: JsonProvider+PullRequest with get + JsonRuntime.GetPropertyPacked(this, "pull_request") + + member State: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "state") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Title: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "title") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member UpdatedAt: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "updated_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member User: JsonProvider+User with get + JsonRuntime.GetPropertyPacked(this, "user") + + +class JsonProvider+Label : FDR.BaseTypes.IJsonDocument + new : url:string -> name:string -> color:JsonProvider+FloatOrString -> JsonProvider+Label + JsonRuntime.CreateRecord([| ("url", + (url :> obj)) + ("name", + (name :> obj)) + ("color", + (color :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Label + JsonDocument.Create(jsonValue, "") + + member Color: JsonProvider+FloatOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "color") + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+PullRequest : FDR.BaseTypes.IJsonDocument + new : htmlUrl:string option -> diffUrl:string option -> patchUrl:string option -> JsonProvider+PullRequest + JsonRuntime.CreateRecord([| ("html_url", + (htmlUrl :> obj)) + ("diff_url", + (diffUrl :> obj)) + ("patch_url", + (patchUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+PullRequest + JsonDocument.Create(jsonValue, "") + + member DiffUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "diff_url")) + + member HtmlUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "html_url")) + + member PatchUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "patch_url")) + + +class JsonProvider+User : FDR.BaseTypes.IJsonDocument + new : login:string -> id:int -> avatarUrl:string -> gravatarId:System.Guid -> url:string -> htmlUrl:string -> followersUrl:string -> followingUrl:string -> gistsUrl:string -> starredUrl:string -> subscriptionsUrl:string -> organizationsUrl:string -> reposUrl:string -> eventsUrl:string -> receivedEventsUrl:string -> type:string -> JsonProvider+User + JsonRuntime.CreateRecord([| ("login", + (login :> obj)) + ("id", + (id :> obj)) + ("avatar_url", + (avatarUrl :> obj)) + ("gravatar_id", + (gravatarId :> obj)) + ("url", + (url :> obj)) + ("html_url", + (htmlUrl :> obj)) + ("followers_url", + (followersUrl :> obj)) + ("following_url", + (followingUrl :> obj)) + ("gists_url", + (gistsUrl :> obj)) + ("starred_url", + (starredUrl :> obj)) + ("subscriptions_url", + (subscriptionsUrl :> obj)) + ("organizations_url", + (organizationsUrl :> obj)) + ("repos_url", + (reposUrl :> obj)) + ("events_url", + (eventsUrl :> obj)) + ("received_events_url", + (receivedEventsUrl :> obj)) + ("type", + (type :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User + JsonDocument.Create(jsonValue, "") + + member AvatarUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "avatar_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member EventsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "events_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FollowersUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FollowingUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "following_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member GistsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gists_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member GravatarId: System.Guid with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gravatar_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertGuid(value.JsonOpt), value.JsonOpt) + + member HtmlUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "html_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Login: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "login") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member OrganizationsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "organizations_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ReceivedEventsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "received_events_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ReposUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "repos_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StarredUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "starred_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SubscriptionsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "subscriptions_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+FloatOrString : FDR.BaseTypes.IJsonDocument + new : number:float -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+FloatOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+FloatOrString + JsonDocument.Create(jsonValue, "") + + member Number: float option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertFloat("", "", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..9284c6787 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,GitHub.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,314 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "GitHub.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "GitHub.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : url:string -> labelsUrl:string -> commentsUrl:string -> eventsUrl:string -> htmlUrl:string -> id:int -> number:int -> title:string -> user:JsonProvider+User -> labels:JsonProvider+JsonProvider+Label[] -> state:string -> assignee:JsonValue -> milestone:JsonValue -> comments:int -> createdAt:System.DateTimeOffset -> updatedAt:System.DateTimeOffset -> closedAt:JsonValue -> pullRequest:JsonProvider+PullRequest -> body:string option -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("url", + (url :> obj)) + ("labels_url", + (labelsUrl :> obj)) + ("comments_url", + (commentsUrl :> obj)) + ("events_url", + (eventsUrl :> obj)) + ("html_url", + (htmlUrl :> obj)) + ("id", + (id :> obj)) + ("number", + (number :> obj)) + ("title", + (title :> obj)) + ("user", + (user :> obj)) + ("labels", + (labels :> obj)) + ("state", + (state :> obj)) + ("assignee", + (assignee :> obj)) + ("milestone", + (milestone :> obj)) + ("comments", + (comments :> obj)) + ("created_at", + (createdAt :> obj)) + ("updated_at", + (updatedAt :> obj)) + ("closed_at", + (closedAt :> obj)) + ("pull_request", + (pullRequest :> obj)) + ("body", + (body :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Assignee: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "assignee") + + member Body: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "body")) + + member ClosedAt: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "closed_at") + + member Comments: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "comments") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member CommentsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "comments_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member CreatedAt: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + member EventsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "events_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member HtmlUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "html_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Labels: JsonProvider+JsonProvider+Label[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "labels"), new Func<_,_>(id))) + + member LabelsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "labels_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Milestone: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "milestone") + + member Number: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "number") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member PullRequest: JsonProvider+PullRequest with get + JsonRuntime.GetPropertyPacked(this, "pull_request") + + member State: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "state") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Title: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "title") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member UpdatedAt: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "updated_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member User: JsonProvider+User with get + JsonRuntime.GetPropertyPacked(this, "user") + + +class JsonProvider+Label : FDR.BaseTypes.IJsonDocument + new : url:string -> name:string -> color:JsonProvider+FloatOrString -> JsonProvider+Label + JsonRuntime.CreateRecord([| ("url", + (url :> obj)) + ("name", + (name :> obj)) + ("color", + (color :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Label + JsonDocument.Create(jsonValue, "") + + member Color: JsonProvider+FloatOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "color") + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+PullRequest : FDR.BaseTypes.IJsonDocument + new : htmlUrl:string option -> diffUrl:string option -> patchUrl:string option -> JsonProvider+PullRequest + JsonRuntime.CreateRecord([| ("html_url", + (htmlUrl :> obj)) + ("diff_url", + (diffUrl :> obj)) + ("patch_url", + (patchUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+PullRequest + JsonDocument.Create(jsonValue, "") + + member DiffUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "diff_url")) + + member HtmlUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "html_url")) + + member PatchUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "patch_url")) + + +class JsonProvider+User : FDR.BaseTypes.IJsonDocument + new : login:string -> id:int -> avatarUrl:string -> gravatarId:System.Guid -> url:string -> htmlUrl:string -> followersUrl:string -> followingUrl:string -> gistsUrl:string -> starredUrl:string -> subscriptionsUrl:string -> organizationsUrl:string -> reposUrl:string -> eventsUrl:string -> receivedEventsUrl:string -> type:string -> JsonProvider+User + JsonRuntime.CreateRecord([| ("login", + (login :> obj)) + ("id", + (id :> obj)) + ("avatar_url", + (avatarUrl :> obj)) + ("gravatar_id", + (gravatarId :> obj)) + ("url", + (url :> obj)) + ("html_url", + (htmlUrl :> obj)) + ("followers_url", + (followersUrl :> obj)) + ("following_url", + (followingUrl :> obj)) + ("gists_url", + (gistsUrl :> obj)) + ("starred_url", + (starredUrl :> obj)) + ("subscriptions_url", + (subscriptionsUrl :> obj)) + ("organizations_url", + (organizationsUrl :> obj)) + ("repos_url", + (reposUrl :> obj)) + ("events_url", + (eventsUrl :> obj)) + ("received_events_url", + (receivedEventsUrl :> obj)) + ("type", + (type :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User + JsonDocument.Create(jsonValue, "") + + member AvatarUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "avatar_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member EventsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "events_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FollowersUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FollowingUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "following_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member GistsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gists_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member GravatarId: System.Guid with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gravatar_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertGuid(value.JsonOpt), value.JsonOpt) + + member HtmlUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "html_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Login: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "login") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member OrganizationsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "organizations_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ReceivedEventsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "received_events_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ReposUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "repos_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StarredUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "starred_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SubscriptionsUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "subscriptions_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+FloatOrString : FDR.BaseTypes.IJsonDocument + new : number:float -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+FloatOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+FloatOrString + JsonDocument.Create(jsonValue, "") + + member Number: float option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertFloat("", "", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..ba9682e13 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,74 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Nested.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Nested.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : main:JsonProvider+Main -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("main", + (main :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Main: JsonProvider+Main with get + JsonRuntime.GetPropertyPacked(this, "main") + + +class JsonProvider+Main : FDR.BaseTypes.IJsonDocument + new : firstName:string -> lastName:string -> age:int -> isCool:bool -> JsonProvider+Main + JsonRuntime.CreateRecord([| ("firstName", + (firstName :> obj)) + ("lastName", + (lastName :> obj)) + ("age", + (age :> obj)) + ("isCool", + (isCool :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Main + JsonDocument.Create(jsonValue, "") + + member Age: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "age") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FirstName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "firstName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member IsCool: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "isCool") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member LastName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lastName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..ba9682e13 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,74 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Nested.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Nested.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : main:JsonProvider+Main -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("main", + (main :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Main: JsonProvider+Main with get + JsonRuntime.GetPropertyPacked(this, "main") + + +class JsonProvider+Main : FDR.BaseTypes.IJsonDocument + new : firstName:string -> lastName:string -> age:int -> isCool:bool -> JsonProvider+Main + JsonRuntime.CreateRecord([| ("firstName", + (firstName :> obj)) + ("lastName", + (lastName :> obj)) + ("age", + (age :> obj)) + ("isCool", + (isCool :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Main + JsonDocument.Create(jsonValue, "") + + member Age: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "age") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FirstName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "firstName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member IsCool: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "isCool") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member LastName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lastName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..ba9682e13 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Nested.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,74 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Nested.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Nested.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : main:JsonProvider+Main -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("main", + (main :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Main: JsonProvider+Main with get + JsonRuntime.GetPropertyPacked(this, "main") + + +class JsonProvider+Main : FDR.BaseTypes.IJsonDocument + new : firstName:string -> lastName:string -> age:int -> isCool:bool -> JsonProvider+Main + JsonRuntime.CreateRecord([| ("firstName", + (firstName :> obj)) + ("lastName", + (lastName :> obj)) + ("age", + (age :> obj)) + ("isCool", + (isCool :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Main + JsonDocument.Create(jsonValue, "") + + member Age: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "age") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FirstName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "firstName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member IsCool: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "isCool") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member LastName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lastName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..59af19e98 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,61 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "OptionValues.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "OptionValues.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : authors:JsonProvider+JsonProvider+Author[] -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("authors", + (authors :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Authors: JsonProvider+JsonProvider+Author[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "authors"), new Func<_,_>(id))) + + +class JsonProvider+Author : FDR.BaseTypes.IJsonDocument + new : name:string -> age:int option -> JsonProvider+Author + JsonRuntime.CreateRecord([| ("name", + (name :> obj)) + ("age", + (age :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Author + JsonDocument.Create(jsonValue, "") + + member Age: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "age")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..59af19e98 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,61 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "OptionValues.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "OptionValues.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : authors:JsonProvider+JsonProvider+Author[] -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("authors", + (authors :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Authors: JsonProvider+JsonProvider+Author[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "authors"), new Func<_,_>(id))) + + +class JsonProvider+Author : FDR.BaseTypes.IJsonDocument + new : name:string -> age:int option -> JsonProvider+Author + JsonRuntime.CreateRecord([| ("name", + (name :> obj)) + ("age", + (age :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Author + JsonDocument.Create(jsonValue, "") + + member Age: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "age")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..59af19e98 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,OptionValues.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,61 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "OptionValues.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "OptionValues.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : authors:JsonProvider+JsonProvider+Author[] -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("authors", + (authors :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Authors: JsonProvider+JsonProvider+Author[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "authors"), new Func<_,_>(id))) + + +class JsonProvider+Author : FDR.BaseTypes.IJsonDocument + new : name:string -> age:int option -> JsonProvider+Author + JsonRuntime.CreateRecord([| ("name", + (name :> obj)) + ("age", + (age :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Author + JsonDocument.Create(jsonValue, "") + + member Age: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "age")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..057e7cc97 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,62 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Simple.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Simple.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : firstName:string -> lastName:string -> age:int -> isCool:bool -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("firstName", + (firstName :> obj)) + ("lastName", + (lastName :> obj)) + ("age", + (age :> obj)) + ("isCool", + (isCool :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Age: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "age") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FirstName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "firstName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member IsCool: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "isCool") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member LastName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lastName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..057e7cc97 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,62 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Simple.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Simple.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : firstName:string -> lastName:string -> age:int -> isCool:bool -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("firstName", + (firstName :> obj)) + ("lastName", + (lastName :> obj)) + ("age", + (age :> obj)) + ("isCool", + (isCool :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Age: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "age") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FirstName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "firstName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member IsCool: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "isCool") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member LastName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lastName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..057e7cc97 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Simple.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,62 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Simple.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Simple.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : firstName:string -> lastName:string -> age:int -> isCool:bool -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("firstName", + (firstName :> obj)) + ("lastName", + (lastName :> obj)) + ("age", + (age :> obj)) + ("isCool", + (isCool :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Age: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "age") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FirstName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "firstName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member IsCool: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "isCool") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member LastName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lastName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..663d8fd85 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,56 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "SimpleArray.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "SimpleArray.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : items:JsonProvider+JsonProvider+Item[] -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("items", + (items :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Items: JsonProvider+JsonProvider+Item[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "items"), new Func<_,_>(id))) + + +class JsonProvider+Item : FDR.BaseTypes.IJsonDocument + new : id:string -> JsonProvider+Item + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Item + JsonDocument.Create(jsonValue, "") + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..663d8fd85 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,56 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "SimpleArray.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "SimpleArray.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : items:JsonProvider+JsonProvider+Item[] -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("items", + (items :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Items: JsonProvider+JsonProvider+Item[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "items"), new Func<_,_>(id))) + + +class JsonProvider+Item : FDR.BaseTypes.IJsonDocument + new : id:string -> JsonProvider+Item + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Item + JsonDocument.Create(jsonValue, "") + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..663d8fd85 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,SimpleArray.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,56 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "SimpleArray.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "SimpleArray.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : items:JsonProvider+JsonProvider+Item[] -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("items", + (items :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Items: JsonProvider+JsonProvider+Item[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "items"), new Func<_,_>(id))) + + +class JsonProvider+Item : FDR.BaseTypes.IJsonDocument + new : id:string -> JsonProvider+Item + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Item + JsonDocument.Create(jsonValue, "") + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..e6634fb14 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,68 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TimeSpans.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TimeSpans.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : positiveWithDayWithFraction:System.TimeSpan -> positiveWithoutDayWithoutFraction:System.TimeSpan -> negativeWithDayWithFraction:System.TimeSpan -> timespanOneTickGreaterThanMaxValue:string -> timespanOneTickLessThanMinValue:string -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("positiveWithDayWithFraction", + (positiveWithDayWithFraction :> obj)) + ("positiveWithoutDayWithoutFraction", + (positiveWithoutDayWithoutFraction :> obj)) + ("negativeWithDayWithFraction", + (negativeWithDayWithFraction :> obj)) + ("timespanOneTickGreaterThanMaxValue", + (timespanOneTickGreaterThanMaxValue :> obj)) + ("timespanOneTickLessThanMinValue", + (timespanOneTickLessThanMinValue :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member NegativeWithDayWithFraction: System.TimeSpan with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "negativeWithDayWithFraction") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertTimeSpan("", value.JsonOpt), value.JsonOpt) + + member PositiveWithDayWithFraction: System.TimeSpan with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "positiveWithDayWithFraction") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertTimeSpan("", value.JsonOpt), value.JsonOpt) + + member PositiveWithoutDayWithoutFraction: System.TimeSpan with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "positiveWithoutDayWithoutFraction") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertTimeSpan("", value.JsonOpt), value.JsonOpt) + + member TimespanOneTickGreaterThanMaxValue: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "timespanOneTickGreaterThanMaxValue") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member TimespanOneTickLessThanMinValue: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "timespanOneTickLessThanMinValue") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..e6634fb14 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,68 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TimeSpans.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TimeSpans.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : positiveWithDayWithFraction:System.TimeSpan -> positiveWithoutDayWithoutFraction:System.TimeSpan -> negativeWithDayWithFraction:System.TimeSpan -> timespanOneTickGreaterThanMaxValue:string -> timespanOneTickLessThanMinValue:string -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("positiveWithDayWithFraction", + (positiveWithDayWithFraction :> obj)) + ("positiveWithoutDayWithoutFraction", + (positiveWithoutDayWithoutFraction :> obj)) + ("negativeWithDayWithFraction", + (negativeWithDayWithFraction :> obj)) + ("timespanOneTickGreaterThanMaxValue", + (timespanOneTickGreaterThanMaxValue :> obj)) + ("timespanOneTickLessThanMinValue", + (timespanOneTickLessThanMinValue :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member NegativeWithDayWithFraction: System.TimeSpan with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "negativeWithDayWithFraction") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertTimeSpan("", value.JsonOpt), value.JsonOpt) + + member PositiveWithDayWithFraction: System.TimeSpan with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "positiveWithDayWithFraction") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertTimeSpan("", value.JsonOpt), value.JsonOpt) + + member PositiveWithoutDayWithoutFraction: System.TimeSpan with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "positiveWithoutDayWithoutFraction") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertTimeSpan("", value.JsonOpt), value.JsonOpt) + + member TimespanOneTickGreaterThanMaxValue: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "timespanOneTickGreaterThanMaxValue") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member TimespanOneTickLessThanMinValue: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "timespanOneTickLessThanMinValue") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..e6634fb14 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TimeSpans.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,68 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TimeSpans.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TimeSpans.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : positiveWithDayWithFraction:System.TimeSpan -> positiveWithoutDayWithoutFraction:System.TimeSpan -> negativeWithDayWithFraction:System.TimeSpan -> timespanOneTickGreaterThanMaxValue:string -> timespanOneTickLessThanMinValue:string -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("positiveWithDayWithFraction", + (positiveWithDayWithFraction :> obj)) + ("positiveWithoutDayWithoutFraction", + (positiveWithoutDayWithoutFraction :> obj)) + ("negativeWithDayWithFraction", + (negativeWithDayWithFraction :> obj)) + ("timespanOneTickGreaterThanMaxValue", + (timespanOneTickGreaterThanMaxValue :> obj)) + ("timespanOneTickLessThanMinValue", + (timespanOneTickLessThanMinValue :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member NegativeWithDayWithFraction: System.TimeSpan with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "negativeWithDayWithFraction") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertTimeSpan("", value.JsonOpt), value.JsonOpt) + + member PositiveWithDayWithFraction: System.TimeSpan with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "positiveWithDayWithFraction") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertTimeSpan("", value.JsonOpt), value.JsonOpt) + + member PositiveWithoutDayWithoutFraction: System.TimeSpan with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "positiveWithoutDayWithoutFraction") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertTimeSpan("", value.JsonOpt), value.JsonOpt) + + member TimespanOneTickGreaterThanMaxValue: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "timespanOneTickGreaterThanMaxValue") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member TimespanOneTickLessThanMinValue: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "timespanOneTickLessThanMinValue") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..ba4150a8d --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,1166 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterSample.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterSample.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : createdAt:string option -> id:int64 option -> idStr:int64 option -> text:string option -> source:string option -> truncated:bool option -> inReplyToStatusId:int64 option -> inReplyToStatusIdStr:int64 option -> inReplyToUserId:int option -> inReplyToUserIdStr:int option -> inReplyToScreenName:string option -> user:JsonProvider+User option -> geo:JsonValue -> coordinates:JsonValue -> place:JsonProvider+Place option -> contributors:JsonValue -> retweetedStatus:JsonProvider+RetweetedStatus option -> retweetCount:int option -> favoriteCount:int option -> entities:JsonProvider+Entities2 option -> favorited:bool option -> retweeted:bool option -> filterLevel:string option -> possiblySensitive:bool option -> lang:string option -> delete:JsonProvider+Delete option -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("created_at", + (createdAt :> obj)) + ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("text", + (text :> obj)) + ("source", + (source :> obj)) + ("truncated", + (truncated :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("user", + (user :> obj)) + ("geo", + (geo :> obj)) + ("coordinates", + (coordinates :> obj)) + ("place", + (place :> obj)) + ("contributors", + (contributors :> obj)) + ("retweeted_status", + (retweetedStatus :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("favorite_count", + (favoriteCount :> obj)) + ("entities", + (entities :> obj)) + ("favorited", + (favorited :> obj)) + ("retweeted", + (retweeted :> obj)) + ("filter_level", + (filterLevel :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) + ("lang", + (lang :> obj)) + ("delete", + (delete :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "coordinates") + + member CreatedAt: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "created_at")) + + member Delete: JsonProvider+Delete option with get + JsonRuntime.TryGetPropertyPacked(this, "delete") + + member Entities: JsonProvider+Entities2 option with get + JsonRuntime.TryGetPropertyPacked(this, "entities") + + member FavoriteCount: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "favorite_count")) + + member Favorited: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "favorited")) + + member FilterLevel: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "filter_level")) + + member Geo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "geo") + + member Id: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id")) + + member IdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id_str")) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id")) + + member InReplyToStatusIdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id_str")) + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Lang: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "lang")) + + member Place: JsonProvider+Place option with get + JsonRuntime.TryGetPropertyPacked(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member RetweetCount: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "retweet_count")) + + member Retweeted: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "retweeted")) + + member RetweetedStatus: JsonProvider+RetweetedStatus option with get + JsonRuntime.TryGetPropertyPacked(this, "retweeted_status") + + member Source: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "source")) + + member Text: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "text")) + + member Truncated: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "truncated")) + + member User: JsonProvider+User option with get + JsonRuntime.TryGetPropertyPacked(this, "user") + + +class JsonProvider+Delete : FDR.BaseTypes.IJsonDocument + new : status:JsonProvider+Status -> JsonProvider+Delete + JsonRuntime.CreateRecord([| ("status", + (status :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Delete + JsonDocument.Create(jsonValue, "") + + member Status: JsonProvider+Status with get + JsonRuntime.GetPropertyPacked(this, "status") + + +class JsonProvider+Entities2 : FDR.BaseTypes.IJsonDocument + new : hashtags:JsonProvider+JsonProvider+Hashtag[] -> symbols:JsonValue[] -> urls:JsonProvider+JsonProvider+Url[] -> userMentions:JsonProvider+JsonProvider+UserMention[] -> JsonProvider+Entities2 + JsonRuntime.CreateRecord([| ("hashtags", + (hashtags :> obj)) + ("symbols", + (symbols :> obj)) + ("urls", + (urls :> obj)) + ("user_mentions", + (userMentions :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities2 + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Symbols: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "symbols"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+Place : FDR.BaseTypes.IJsonDocument + new : id:string -> url:string -> placeType:string -> name:string -> fullName:string -> countryCode:string -> country:string -> boundingBox:JsonProvider+BoundingBox -> attributes:JsonProvider+Attributes -> JsonProvider+Place + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("url", + (url :> obj)) + ("place_type", + (placeType :> obj)) + ("name", + (name :> obj)) + ("full_name", + (fullName :> obj)) + ("country_code", + (countryCode :> obj)) + ("country", + (country :> obj)) + ("bounding_box", + (boundingBox :> obj)) + ("attributes", + (attributes :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Place + JsonDocument.Create(jsonValue, "") + + member Attributes: JsonProvider+Attributes with get + JsonRuntime.GetPropertyPacked(this, "attributes") + + member BoundingBox: JsonProvider+BoundingBox with get + JsonRuntime.GetPropertyPacked(this, "bounding_box") + + member Country: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member CountryCode: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country_code") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FullName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "full_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PlaceType: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "place_type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+RetweetedStatus : FDR.BaseTypes.IJsonDocument + new : createdAt:string -> id:int64 -> idStr:int64 -> text:string -> source:string -> truncated:bool -> inReplyToStatusId:JsonValue -> inReplyToStatusIdStr:JsonValue -> inReplyToUserId:int option -> inReplyToUserIdStr:int option -> inReplyToScreenName:string option -> user:JsonProvider+User2 -> geo:JsonValue -> coordinates:JsonValue -> place:JsonValue -> contributors:JsonValue -> retweetCount:int -> favoriteCount:int -> entities:JsonProvider+Entities -> favorited:bool -> retweeted:bool -> lang:string -> possiblySensitive:bool option -> JsonProvider+RetweetedStatus + JsonRuntime.CreateRecord([| ("created_at", + (createdAt :> obj)) + ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("text", + (text :> obj)) + ("source", + (source :> obj)) + ("truncated", + (truncated :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("user", + (user :> obj)) + ("geo", + (geo :> obj)) + ("coordinates", + (coordinates :> obj)) + ("place", + (place :> obj)) + ("contributors", + (contributors :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("favorite_count", + (favoriteCount :> obj)) + ("entities", + (entities :> obj)) + ("favorited", + (favorited :> obj)) + ("retweeted", + (retweeted :> obj)) + ("lang", + (lang :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+RetweetedStatus + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "coordinates") + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Entities: JsonProvider+Entities with get + JsonRuntime.GetPropertyPacked(this, "entities") + + member FavoriteCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favorite_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Favorited: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favorited") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Geo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "geo") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "in_reply_to_status_id") + + member InReplyToStatusIdStr: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "in_reply_to_status_id_str") + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Place: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member RetweetCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweet_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Retweeted: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweeted") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Source: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Truncated: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "truncated") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member User: JsonProvider+User2 with get + JsonRuntime.GetPropertyPacked(this, "user") + + +class JsonProvider+User : FDR.BaseTypes.IJsonDocument + new : id:int -> idStr:int -> name:string -> screenName:string -> location:string option -> url:string option -> description:string -> protected:bool -> followersCount:int -> friendsCount:int -> listedCount:int -> createdAt:string -> favouritesCount:int -> utcOffset:int option -> timeZone:string option -> geoEnabled:bool -> verified:bool -> statusesCount:int -> lang:string -> contributorsEnabled:bool -> isTranslator:bool -> profileBackgroundColor:JsonProvider+IntOrString -> profileBackgroundImageUrl:string -> profileBackgroundImageUrlHttps:string -> profileBackgroundTile:bool -> profileImageUrl:string -> profileImageUrlHttps:string -> profileBannerUrl:string option -> profileLinkColor:JsonProvider+IntOrString -> profileSidebarBorderColor:JsonProvider+IntOrString -> profileSidebarFillColor:JsonProvider+IntOrString -> profileTextColor:JsonProvider+IntOrString -> profileUseBackgroundImage:bool -> defaultProfile:bool -> defaultProfileImage:bool -> following:JsonValue -> followRequestSent:JsonValue -> notifications:JsonValue -> JsonProvider+User + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("name", + (name :> obj)) + ("screen_name", + (screenName :> obj)) + ("location", + (location :> obj)) + ("url", + (url :> obj)) + ("description", + (description :> obj)) + ("protected", + (protected :> obj)) + ("followers_count", + (followersCount :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("listed_count", + (listedCount :> obj)) + ("created_at", + (createdAt :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("time_zone", + (timeZone :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("verified", + (verified :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("lang", + (lang :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("following", + (following :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("notifications", + (notifications :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "description") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_link_color") + + member ProfileSidebarBorderColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Attributes : FDR.BaseTypes.IJsonDocument + new : () -> JsonProvider+Attributes + JsonRuntime.CreateRecord([| |], "") + + new : jsonValue:JsonValue -> JsonProvider+Attributes + JsonDocument.Create(jsonValue, "") + + +class JsonProvider+BoundingBox : FDR.BaseTypes.IJsonDocument + new : type:string -> coordinates:decimal[][][] -> JsonProvider+BoundingBox + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("coordinates", + (coordinates :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+BoundingBox + JsonDocument.Create(jsonValue, "") + + member Coordinates: decimal[][][] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "coordinates"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDecimal("", Some t.JsonValue), Some t.JsonValue))))))) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Entities : FDR.BaseTypes.IJsonDocument + new : hashtags:JsonProvider+JsonProvider+Hashtag[] -> symbols:JsonValue[] -> urls:JsonProvider+JsonProvider+Url[] -> userMentions:JsonProvider+JsonProvider+UserMention[] -> media:JsonProvider+JsonProvider+Media[] -> JsonProvider+Entities + JsonRuntime.CreateRecord([| ("hashtags", + (hashtags :> obj)) + ("symbols", + (symbols :> obj)) + ("urls", + (urls :> obj)) + ("user_mentions", + (userMentions :> obj)) + ("media", + (media :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Media: JsonProvider+JsonProvider+Media[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "media"), new Func<_,_>(id))) + + member Symbols: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "symbols"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+Hashtag : FDR.BaseTypes.IJsonDocument + new : text:string -> indices:int[] -> JsonProvider+Hashtag + JsonRuntime.CreateRecord([| ("text", + (text :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Hashtag + JsonDocument.Create(jsonValue, "") + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+IntOrString : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+IntOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+IntOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrString + JsonDocument.Create(jsonValue, "") + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Status : FDR.BaseTypes.IJsonDocument + new : id:int64 -> userId:int -> idStr:int64 -> userIdStr:int -> JsonProvider+Status + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("user_id", + (userId :> obj)) + ("id_str", + (idStr :> obj)) + ("user_id_str", + (userIdStr :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Status + JsonDocument.Create(jsonValue, "") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member UserId: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member UserIdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Url : FDR.BaseTypes.IJsonDocument + new : url:string -> expandedUrl:string -> displayUrl:string -> indices:int[] -> JsonProvider+Url + JsonRuntime.CreateRecord([| ("url", + (url :> obj)) + ("expanded_url", + (expandedUrl :> obj)) + ("display_url", + (displayUrl :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Url + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+User2 : FDR.BaseTypes.IJsonDocument + new : id:int -> idStr:int -> name:string -> screenName:string -> location:string option -> url:string option -> description:string -> protected:bool -> followersCount:int -> friendsCount:int -> listedCount:int -> createdAt:string -> favouritesCount:int -> utcOffset:int option -> timeZone:string option -> geoEnabled:bool -> verified:bool -> statusesCount:int -> lang:string -> contributorsEnabled:bool -> isTranslator:bool -> profileBackgroundColor:JsonProvider+IntOrString -> profileBackgroundImageUrl:string -> profileBackgroundImageUrlHttps:string -> profileBackgroundTile:bool -> profileImageUrl:string -> profileImageUrlHttps:string -> profileBannerUrl:string option -> profileLinkColor:string -> profileSidebarBorderColor:JsonProvider+IntOrString -> profileSidebarFillColor:JsonProvider+IntOrString -> profileTextColor:JsonProvider+IntOrString -> profileUseBackgroundImage:bool -> defaultProfile:bool -> defaultProfileImage:bool -> following:JsonValue -> followRequestSent:JsonValue -> notifications:JsonValue -> JsonProvider+User2 + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("name", + (name :> obj)) + ("screen_name", + (screenName :> obj)) + ("location", + (location :> obj)) + ("url", + (url :> obj)) + ("description", + (description :> obj)) + ("protected", + (protected :> obj)) + ("followers_count", + (followersCount :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("listed_count", + (listedCount :> obj)) + ("created_at", + (createdAt :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("time_zone", + (timeZone :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("verified", + (verified :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("lang", + (lang :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("following", + (following :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("notifications", + (notifications :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User2 + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "description") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_link_color") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileSidebarBorderColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+UserMention : FDR.BaseTypes.IJsonDocument + new : screenName:string -> name:string -> id:int -> idStr:int -> indices:int[] -> JsonProvider+UserMention + JsonRuntime.CreateRecord([| ("screen_name", + (screenName :> obj)) + ("name", + (name :> obj)) + ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+UserMention + JsonDocument.Create(jsonValue, "") + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Media : FDR.BaseTypes.IJsonDocument + new : id:int64 -> idStr:int64 -> indices:int[] -> mediaUrl:string -> mediaUrlHttps:string -> url:string -> displayUrl:string -> expandedUrl:string -> type:string -> sizes:JsonProvider+Sizes -> sourceStatusId:int64 -> sourceStatusIdStr:int64 -> JsonProvider+Media + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("indices", + (indices :> obj)) + ("media_url", + (mediaUrl :> obj)) + ("media_url_https", + (mediaUrlHttps :> obj)) + ("url", + (url :> obj)) + ("display_url", + (displayUrl :> obj)) + ("expanded_url", + (expandedUrl :> obj)) + ("type", + (type :> obj)) + ("sizes", + (sizes :> obj)) + ("source_status_id", + (sourceStatusId :> obj)) + ("source_status_id_str", + (sourceStatusIdStr :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Media + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member MediaUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member MediaUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Sizes: JsonProvider+Sizes with get + JsonRuntime.GetPropertyPacked(this, "sizes") + + member SourceStatusId: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source_status_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member SourceStatusIdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source_status_id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Sizes : FDR.BaseTypes.IJsonDocument + new : small:JsonProvider+Small -> thumb:JsonProvider+Small -> large:JsonProvider+Small -> medium:JsonProvider+Small -> JsonProvider+Sizes + JsonRuntime.CreateRecord([| ("small", + (small :> obj)) + ("thumb", + (thumb :> obj)) + ("large", + (large :> obj)) + ("medium", + (medium :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Sizes + JsonDocument.Create(jsonValue, "") + + member Large: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "large") + + member Medium: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "medium") + + member Small: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "small") + + member Thumb: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "thumb") + + +class JsonProvider+Small : FDR.BaseTypes.IJsonDocument + new : w:int -> h:int -> resize:string -> JsonProvider+Small + JsonRuntime.CreateRecord([| ("w", + (w :> obj)) + ("h", + (h :> obj)) + ("resize", + (resize :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Small + JsonDocument.Create(jsonValue, "") + + member H: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "h") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Resize: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "resize") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member W: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "w") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..ba4150a8d --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,1166 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterSample.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterSample.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : createdAt:string option -> id:int64 option -> idStr:int64 option -> text:string option -> source:string option -> truncated:bool option -> inReplyToStatusId:int64 option -> inReplyToStatusIdStr:int64 option -> inReplyToUserId:int option -> inReplyToUserIdStr:int option -> inReplyToScreenName:string option -> user:JsonProvider+User option -> geo:JsonValue -> coordinates:JsonValue -> place:JsonProvider+Place option -> contributors:JsonValue -> retweetedStatus:JsonProvider+RetweetedStatus option -> retweetCount:int option -> favoriteCount:int option -> entities:JsonProvider+Entities2 option -> favorited:bool option -> retweeted:bool option -> filterLevel:string option -> possiblySensitive:bool option -> lang:string option -> delete:JsonProvider+Delete option -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("created_at", + (createdAt :> obj)) + ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("text", + (text :> obj)) + ("source", + (source :> obj)) + ("truncated", + (truncated :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("user", + (user :> obj)) + ("geo", + (geo :> obj)) + ("coordinates", + (coordinates :> obj)) + ("place", + (place :> obj)) + ("contributors", + (contributors :> obj)) + ("retweeted_status", + (retweetedStatus :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("favorite_count", + (favoriteCount :> obj)) + ("entities", + (entities :> obj)) + ("favorited", + (favorited :> obj)) + ("retweeted", + (retweeted :> obj)) + ("filter_level", + (filterLevel :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) + ("lang", + (lang :> obj)) + ("delete", + (delete :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "coordinates") + + member CreatedAt: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "created_at")) + + member Delete: JsonProvider+Delete option with get + JsonRuntime.TryGetPropertyPacked(this, "delete") + + member Entities: JsonProvider+Entities2 option with get + JsonRuntime.TryGetPropertyPacked(this, "entities") + + member FavoriteCount: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "favorite_count")) + + member Favorited: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "favorited")) + + member FilterLevel: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "filter_level")) + + member Geo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "geo") + + member Id: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id")) + + member IdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id_str")) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id")) + + member InReplyToStatusIdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id_str")) + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Lang: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "lang")) + + member Place: JsonProvider+Place option with get + JsonRuntime.TryGetPropertyPacked(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member RetweetCount: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "retweet_count")) + + member Retweeted: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "retweeted")) + + member RetweetedStatus: JsonProvider+RetweetedStatus option with get + JsonRuntime.TryGetPropertyPacked(this, "retweeted_status") + + member Source: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "source")) + + member Text: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "text")) + + member Truncated: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "truncated")) + + member User: JsonProvider+User option with get + JsonRuntime.TryGetPropertyPacked(this, "user") + + +class JsonProvider+Delete : FDR.BaseTypes.IJsonDocument + new : status:JsonProvider+Status -> JsonProvider+Delete + JsonRuntime.CreateRecord([| ("status", + (status :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Delete + JsonDocument.Create(jsonValue, "") + + member Status: JsonProvider+Status with get + JsonRuntime.GetPropertyPacked(this, "status") + + +class JsonProvider+Entities2 : FDR.BaseTypes.IJsonDocument + new : hashtags:JsonProvider+JsonProvider+Hashtag[] -> symbols:JsonValue[] -> urls:JsonProvider+JsonProvider+Url[] -> userMentions:JsonProvider+JsonProvider+UserMention[] -> JsonProvider+Entities2 + JsonRuntime.CreateRecord([| ("hashtags", + (hashtags :> obj)) + ("symbols", + (symbols :> obj)) + ("urls", + (urls :> obj)) + ("user_mentions", + (userMentions :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities2 + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Symbols: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "symbols"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+Place : FDR.BaseTypes.IJsonDocument + new : id:string -> url:string -> placeType:string -> name:string -> fullName:string -> countryCode:string -> country:string -> boundingBox:JsonProvider+BoundingBox -> attributes:JsonProvider+Attributes -> JsonProvider+Place + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("url", + (url :> obj)) + ("place_type", + (placeType :> obj)) + ("name", + (name :> obj)) + ("full_name", + (fullName :> obj)) + ("country_code", + (countryCode :> obj)) + ("country", + (country :> obj)) + ("bounding_box", + (boundingBox :> obj)) + ("attributes", + (attributes :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Place + JsonDocument.Create(jsonValue, "") + + member Attributes: JsonProvider+Attributes with get + JsonRuntime.GetPropertyPacked(this, "attributes") + + member BoundingBox: JsonProvider+BoundingBox with get + JsonRuntime.GetPropertyPacked(this, "bounding_box") + + member Country: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member CountryCode: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country_code") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FullName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "full_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PlaceType: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "place_type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+RetweetedStatus : FDR.BaseTypes.IJsonDocument + new : createdAt:string -> id:int64 -> idStr:int64 -> text:string -> source:string -> truncated:bool -> inReplyToStatusId:JsonValue -> inReplyToStatusIdStr:JsonValue -> inReplyToUserId:int option -> inReplyToUserIdStr:int option -> inReplyToScreenName:string option -> user:JsonProvider+User2 -> geo:JsonValue -> coordinates:JsonValue -> place:JsonValue -> contributors:JsonValue -> retweetCount:int -> favoriteCount:int -> entities:JsonProvider+Entities -> favorited:bool -> retweeted:bool -> lang:string -> possiblySensitive:bool option -> JsonProvider+RetweetedStatus + JsonRuntime.CreateRecord([| ("created_at", + (createdAt :> obj)) + ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("text", + (text :> obj)) + ("source", + (source :> obj)) + ("truncated", + (truncated :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("user", + (user :> obj)) + ("geo", + (geo :> obj)) + ("coordinates", + (coordinates :> obj)) + ("place", + (place :> obj)) + ("contributors", + (contributors :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("favorite_count", + (favoriteCount :> obj)) + ("entities", + (entities :> obj)) + ("favorited", + (favorited :> obj)) + ("retweeted", + (retweeted :> obj)) + ("lang", + (lang :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+RetweetedStatus + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "coordinates") + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Entities: JsonProvider+Entities with get + JsonRuntime.GetPropertyPacked(this, "entities") + + member FavoriteCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favorite_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Favorited: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favorited") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Geo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "geo") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "in_reply_to_status_id") + + member InReplyToStatusIdStr: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "in_reply_to_status_id_str") + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Place: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member RetweetCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweet_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Retweeted: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweeted") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Source: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Truncated: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "truncated") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member User: JsonProvider+User2 with get + JsonRuntime.GetPropertyPacked(this, "user") + + +class JsonProvider+User : FDR.BaseTypes.IJsonDocument + new : id:int -> idStr:int -> name:string -> screenName:string -> location:string option -> url:string option -> description:string -> protected:bool -> followersCount:int -> friendsCount:int -> listedCount:int -> createdAt:string -> favouritesCount:int -> utcOffset:int option -> timeZone:string option -> geoEnabled:bool -> verified:bool -> statusesCount:int -> lang:string -> contributorsEnabled:bool -> isTranslator:bool -> profileBackgroundColor:JsonProvider+IntOrString -> profileBackgroundImageUrl:string -> profileBackgroundImageUrlHttps:string -> profileBackgroundTile:bool -> profileImageUrl:string -> profileImageUrlHttps:string -> profileBannerUrl:string option -> profileLinkColor:JsonProvider+IntOrString -> profileSidebarBorderColor:JsonProvider+IntOrString -> profileSidebarFillColor:JsonProvider+IntOrString -> profileTextColor:JsonProvider+IntOrString -> profileUseBackgroundImage:bool -> defaultProfile:bool -> defaultProfileImage:bool -> following:JsonValue -> followRequestSent:JsonValue -> notifications:JsonValue -> JsonProvider+User + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("name", + (name :> obj)) + ("screen_name", + (screenName :> obj)) + ("location", + (location :> obj)) + ("url", + (url :> obj)) + ("description", + (description :> obj)) + ("protected", + (protected :> obj)) + ("followers_count", + (followersCount :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("listed_count", + (listedCount :> obj)) + ("created_at", + (createdAt :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("time_zone", + (timeZone :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("verified", + (verified :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("lang", + (lang :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("following", + (following :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("notifications", + (notifications :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "description") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_link_color") + + member ProfileSidebarBorderColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Attributes : FDR.BaseTypes.IJsonDocument + new : () -> JsonProvider+Attributes + JsonRuntime.CreateRecord([| |], "") + + new : jsonValue:JsonValue -> JsonProvider+Attributes + JsonDocument.Create(jsonValue, "") + + +class JsonProvider+BoundingBox : FDR.BaseTypes.IJsonDocument + new : type:string -> coordinates:decimal[][][] -> JsonProvider+BoundingBox + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("coordinates", + (coordinates :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+BoundingBox + JsonDocument.Create(jsonValue, "") + + member Coordinates: decimal[][][] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "coordinates"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDecimal("", Some t.JsonValue), Some t.JsonValue))))))) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Entities : FDR.BaseTypes.IJsonDocument + new : hashtags:JsonProvider+JsonProvider+Hashtag[] -> symbols:JsonValue[] -> urls:JsonProvider+JsonProvider+Url[] -> userMentions:JsonProvider+JsonProvider+UserMention[] -> media:JsonProvider+JsonProvider+Media[] -> JsonProvider+Entities + JsonRuntime.CreateRecord([| ("hashtags", + (hashtags :> obj)) + ("symbols", + (symbols :> obj)) + ("urls", + (urls :> obj)) + ("user_mentions", + (userMentions :> obj)) + ("media", + (media :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Media: JsonProvider+JsonProvider+Media[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "media"), new Func<_,_>(id))) + + member Symbols: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "symbols"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+Hashtag : FDR.BaseTypes.IJsonDocument + new : text:string -> indices:int[] -> JsonProvider+Hashtag + JsonRuntime.CreateRecord([| ("text", + (text :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Hashtag + JsonDocument.Create(jsonValue, "") + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+IntOrString : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+IntOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+IntOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrString + JsonDocument.Create(jsonValue, "") + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Status : FDR.BaseTypes.IJsonDocument + new : id:int64 -> userId:int -> idStr:int64 -> userIdStr:int -> JsonProvider+Status + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("user_id", + (userId :> obj)) + ("id_str", + (idStr :> obj)) + ("user_id_str", + (userIdStr :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Status + JsonDocument.Create(jsonValue, "") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member UserId: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member UserIdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Url : FDR.BaseTypes.IJsonDocument + new : url:string -> expandedUrl:string -> displayUrl:string -> indices:int[] -> JsonProvider+Url + JsonRuntime.CreateRecord([| ("url", + (url :> obj)) + ("expanded_url", + (expandedUrl :> obj)) + ("display_url", + (displayUrl :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Url + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+User2 : FDR.BaseTypes.IJsonDocument + new : id:int -> idStr:int -> name:string -> screenName:string -> location:string option -> url:string option -> description:string -> protected:bool -> followersCount:int -> friendsCount:int -> listedCount:int -> createdAt:string -> favouritesCount:int -> utcOffset:int option -> timeZone:string option -> geoEnabled:bool -> verified:bool -> statusesCount:int -> lang:string -> contributorsEnabled:bool -> isTranslator:bool -> profileBackgroundColor:JsonProvider+IntOrString -> profileBackgroundImageUrl:string -> profileBackgroundImageUrlHttps:string -> profileBackgroundTile:bool -> profileImageUrl:string -> profileImageUrlHttps:string -> profileBannerUrl:string option -> profileLinkColor:string -> profileSidebarBorderColor:JsonProvider+IntOrString -> profileSidebarFillColor:JsonProvider+IntOrString -> profileTextColor:JsonProvider+IntOrString -> profileUseBackgroundImage:bool -> defaultProfile:bool -> defaultProfileImage:bool -> following:JsonValue -> followRequestSent:JsonValue -> notifications:JsonValue -> JsonProvider+User2 + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("name", + (name :> obj)) + ("screen_name", + (screenName :> obj)) + ("location", + (location :> obj)) + ("url", + (url :> obj)) + ("description", + (description :> obj)) + ("protected", + (protected :> obj)) + ("followers_count", + (followersCount :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("listed_count", + (listedCount :> obj)) + ("created_at", + (createdAt :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("time_zone", + (timeZone :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("verified", + (verified :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("lang", + (lang :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("following", + (following :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("notifications", + (notifications :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User2 + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "description") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_link_color") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileSidebarBorderColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+UserMention : FDR.BaseTypes.IJsonDocument + new : screenName:string -> name:string -> id:int -> idStr:int -> indices:int[] -> JsonProvider+UserMention + JsonRuntime.CreateRecord([| ("screen_name", + (screenName :> obj)) + ("name", + (name :> obj)) + ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+UserMention + JsonDocument.Create(jsonValue, "") + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Media : FDR.BaseTypes.IJsonDocument + new : id:int64 -> idStr:int64 -> indices:int[] -> mediaUrl:string -> mediaUrlHttps:string -> url:string -> displayUrl:string -> expandedUrl:string -> type:string -> sizes:JsonProvider+Sizes -> sourceStatusId:int64 -> sourceStatusIdStr:int64 -> JsonProvider+Media + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("indices", + (indices :> obj)) + ("media_url", + (mediaUrl :> obj)) + ("media_url_https", + (mediaUrlHttps :> obj)) + ("url", + (url :> obj)) + ("display_url", + (displayUrl :> obj)) + ("expanded_url", + (expandedUrl :> obj)) + ("type", + (type :> obj)) + ("sizes", + (sizes :> obj)) + ("source_status_id", + (sourceStatusId :> obj)) + ("source_status_id_str", + (sourceStatusIdStr :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Media + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member MediaUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member MediaUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Sizes: JsonProvider+Sizes with get + JsonRuntime.GetPropertyPacked(this, "sizes") + + member SourceStatusId: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source_status_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member SourceStatusIdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source_status_id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Sizes : FDR.BaseTypes.IJsonDocument + new : small:JsonProvider+Small -> thumb:JsonProvider+Small -> large:JsonProvider+Small -> medium:JsonProvider+Small -> JsonProvider+Sizes + JsonRuntime.CreateRecord([| ("small", + (small :> obj)) + ("thumb", + (thumb :> obj)) + ("large", + (large :> obj)) + ("medium", + (medium :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Sizes + JsonDocument.Create(jsonValue, "") + + member Large: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "large") + + member Medium: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "medium") + + member Small: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "small") + + member Thumb: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "thumb") + + +class JsonProvider+Small : FDR.BaseTypes.IJsonDocument + new : w:int -> h:int -> resize:string -> JsonProvider+Small + JsonRuntime.CreateRecord([| ("w", + (w :> obj)) + ("h", + (h :> obj)) + ("resize", + (resize :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Small + JsonDocument.Create(jsonValue, "") + + member H: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "h") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Resize: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "resize") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member W: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "w") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..ba4150a8d --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterSample.json,True,,,True,False,ValuesOnly.expected @@ -0,0 +1,1166 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterSample.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterSample.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : createdAt:string option -> id:int64 option -> idStr:int64 option -> text:string option -> source:string option -> truncated:bool option -> inReplyToStatusId:int64 option -> inReplyToStatusIdStr:int64 option -> inReplyToUserId:int option -> inReplyToUserIdStr:int option -> inReplyToScreenName:string option -> user:JsonProvider+User option -> geo:JsonValue -> coordinates:JsonValue -> place:JsonProvider+Place option -> contributors:JsonValue -> retweetedStatus:JsonProvider+RetweetedStatus option -> retweetCount:int option -> favoriteCount:int option -> entities:JsonProvider+Entities2 option -> favorited:bool option -> retweeted:bool option -> filterLevel:string option -> possiblySensitive:bool option -> lang:string option -> delete:JsonProvider+Delete option -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("created_at", + (createdAt :> obj)) + ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("text", + (text :> obj)) + ("source", + (source :> obj)) + ("truncated", + (truncated :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("user", + (user :> obj)) + ("geo", + (geo :> obj)) + ("coordinates", + (coordinates :> obj)) + ("place", + (place :> obj)) + ("contributors", + (contributors :> obj)) + ("retweeted_status", + (retweetedStatus :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("favorite_count", + (favoriteCount :> obj)) + ("entities", + (entities :> obj)) + ("favorited", + (favorited :> obj)) + ("retweeted", + (retweeted :> obj)) + ("filter_level", + (filterLevel :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) + ("lang", + (lang :> obj)) + ("delete", + (delete :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "coordinates") + + member CreatedAt: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "created_at")) + + member Delete: JsonProvider+Delete option with get + JsonRuntime.TryGetPropertyPacked(this, "delete") + + member Entities: JsonProvider+Entities2 option with get + JsonRuntime.TryGetPropertyPacked(this, "entities") + + member FavoriteCount: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "favorite_count")) + + member Favorited: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "favorited")) + + member FilterLevel: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "filter_level")) + + member Geo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "geo") + + member Id: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id")) + + member IdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id_str")) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id")) + + member InReplyToStatusIdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id_str")) + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Lang: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "lang")) + + member Place: JsonProvider+Place option with get + JsonRuntime.TryGetPropertyPacked(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member RetweetCount: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "retweet_count")) + + member Retweeted: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "retweeted")) + + member RetweetedStatus: JsonProvider+RetweetedStatus option with get + JsonRuntime.TryGetPropertyPacked(this, "retweeted_status") + + member Source: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "source")) + + member Text: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "text")) + + member Truncated: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "truncated")) + + member User: JsonProvider+User option with get + JsonRuntime.TryGetPropertyPacked(this, "user") + + +class JsonProvider+Delete : FDR.BaseTypes.IJsonDocument + new : status:JsonProvider+Status -> JsonProvider+Delete + JsonRuntime.CreateRecord([| ("status", + (status :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Delete + JsonDocument.Create(jsonValue, "") + + member Status: JsonProvider+Status with get + JsonRuntime.GetPropertyPacked(this, "status") + + +class JsonProvider+Entities2 : FDR.BaseTypes.IJsonDocument + new : hashtags:JsonProvider+JsonProvider+Hashtag[] -> symbols:JsonValue[] -> urls:JsonProvider+JsonProvider+Url[] -> userMentions:JsonProvider+JsonProvider+UserMention[] -> JsonProvider+Entities2 + JsonRuntime.CreateRecord([| ("hashtags", + (hashtags :> obj)) + ("symbols", + (symbols :> obj)) + ("urls", + (urls :> obj)) + ("user_mentions", + (userMentions :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities2 + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Symbols: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "symbols"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+Place : FDR.BaseTypes.IJsonDocument + new : id:string -> url:string -> placeType:string -> name:string -> fullName:string -> countryCode:string -> country:string -> boundingBox:JsonProvider+BoundingBox -> attributes:JsonProvider+Attributes -> JsonProvider+Place + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("url", + (url :> obj)) + ("place_type", + (placeType :> obj)) + ("name", + (name :> obj)) + ("full_name", + (fullName :> obj)) + ("country_code", + (countryCode :> obj)) + ("country", + (country :> obj)) + ("bounding_box", + (boundingBox :> obj)) + ("attributes", + (attributes :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Place + JsonDocument.Create(jsonValue, "") + + member Attributes: JsonProvider+Attributes with get + JsonRuntime.GetPropertyPacked(this, "attributes") + + member BoundingBox: JsonProvider+BoundingBox with get + JsonRuntime.GetPropertyPacked(this, "bounding_box") + + member Country: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member CountryCode: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country_code") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FullName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "full_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PlaceType: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "place_type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+RetweetedStatus : FDR.BaseTypes.IJsonDocument + new : createdAt:string -> id:int64 -> idStr:int64 -> text:string -> source:string -> truncated:bool -> inReplyToStatusId:JsonValue -> inReplyToStatusIdStr:JsonValue -> inReplyToUserId:int option -> inReplyToUserIdStr:int option -> inReplyToScreenName:string option -> user:JsonProvider+User2 -> geo:JsonValue -> coordinates:JsonValue -> place:JsonValue -> contributors:JsonValue -> retweetCount:int -> favoriteCount:int -> entities:JsonProvider+Entities -> favorited:bool -> retweeted:bool -> lang:string -> possiblySensitive:bool option -> JsonProvider+RetweetedStatus + JsonRuntime.CreateRecord([| ("created_at", + (createdAt :> obj)) + ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("text", + (text :> obj)) + ("source", + (source :> obj)) + ("truncated", + (truncated :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("user", + (user :> obj)) + ("geo", + (geo :> obj)) + ("coordinates", + (coordinates :> obj)) + ("place", + (place :> obj)) + ("contributors", + (contributors :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("favorite_count", + (favoriteCount :> obj)) + ("entities", + (entities :> obj)) + ("favorited", + (favorited :> obj)) + ("retweeted", + (retweeted :> obj)) + ("lang", + (lang :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+RetweetedStatus + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "coordinates") + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Entities: JsonProvider+Entities with get + JsonRuntime.GetPropertyPacked(this, "entities") + + member FavoriteCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favorite_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Favorited: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favorited") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Geo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "geo") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "in_reply_to_status_id") + + member InReplyToStatusIdStr: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "in_reply_to_status_id_str") + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Place: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member RetweetCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweet_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Retweeted: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweeted") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Source: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Truncated: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "truncated") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member User: JsonProvider+User2 with get + JsonRuntime.GetPropertyPacked(this, "user") + + +class JsonProvider+User : FDR.BaseTypes.IJsonDocument + new : id:int -> idStr:int -> name:string -> screenName:string -> location:string option -> url:string option -> description:string -> protected:bool -> followersCount:int -> friendsCount:int -> listedCount:int -> createdAt:string -> favouritesCount:int -> utcOffset:int option -> timeZone:string option -> geoEnabled:bool -> verified:bool -> statusesCount:int -> lang:string -> contributorsEnabled:bool -> isTranslator:bool -> profileBackgroundColor:JsonProvider+IntOrString -> profileBackgroundImageUrl:string -> profileBackgroundImageUrlHttps:string -> profileBackgroundTile:bool -> profileImageUrl:string -> profileImageUrlHttps:string -> profileBannerUrl:string option -> profileLinkColor:JsonProvider+IntOrString -> profileSidebarBorderColor:JsonProvider+IntOrString -> profileSidebarFillColor:JsonProvider+IntOrString -> profileTextColor:JsonProvider+IntOrString -> profileUseBackgroundImage:bool -> defaultProfile:bool -> defaultProfileImage:bool -> following:JsonValue -> followRequestSent:JsonValue -> notifications:JsonValue -> JsonProvider+User + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("name", + (name :> obj)) + ("screen_name", + (screenName :> obj)) + ("location", + (location :> obj)) + ("url", + (url :> obj)) + ("description", + (description :> obj)) + ("protected", + (protected :> obj)) + ("followers_count", + (followersCount :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("listed_count", + (listedCount :> obj)) + ("created_at", + (createdAt :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("time_zone", + (timeZone :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("verified", + (verified :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("lang", + (lang :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("following", + (following :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("notifications", + (notifications :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "description") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_link_color") + + member ProfileSidebarBorderColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Attributes : FDR.BaseTypes.IJsonDocument + new : () -> JsonProvider+Attributes + JsonRuntime.CreateRecord([| |], "") + + new : jsonValue:JsonValue -> JsonProvider+Attributes + JsonDocument.Create(jsonValue, "") + + +class JsonProvider+BoundingBox : FDR.BaseTypes.IJsonDocument + new : type:string -> coordinates:decimal[][][] -> JsonProvider+BoundingBox + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("coordinates", + (coordinates :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+BoundingBox + JsonDocument.Create(jsonValue, "") + + member Coordinates: decimal[][][] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "coordinates"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDecimal("", Some t.JsonValue), Some t.JsonValue))))))) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Entities : FDR.BaseTypes.IJsonDocument + new : hashtags:JsonProvider+JsonProvider+Hashtag[] -> symbols:JsonValue[] -> urls:JsonProvider+JsonProvider+Url[] -> userMentions:JsonProvider+JsonProvider+UserMention[] -> media:JsonProvider+JsonProvider+Media[] -> JsonProvider+Entities + JsonRuntime.CreateRecord([| ("hashtags", + (hashtags :> obj)) + ("symbols", + (symbols :> obj)) + ("urls", + (urls :> obj)) + ("user_mentions", + (userMentions :> obj)) + ("media", + (media :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Media: JsonProvider+JsonProvider+Media[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "media"), new Func<_,_>(id))) + + member Symbols: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "symbols"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+Hashtag : FDR.BaseTypes.IJsonDocument + new : text:string -> indices:int[] -> JsonProvider+Hashtag + JsonRuntime.CreateRecord([| ("text", + (text :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Hashtag + JsonDocument.Create(jsonValue, "") + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+IntOrString : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+IntOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+IntOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrString + JsonDocument.Create(jsonValue, "") + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Status : FDR.BaseTypes.IJsonDocument + new : id:int64 -> userId:int -> idStr:int64 -> userIdStr:int -> JsonProvider+Status + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("user_id", + (userId :> obj)) + ("id_str", + (idStr :> obj)) + ("user_id_str", + (userIdStr :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Status + JsonDocument.Create(jsonValue, "") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member UserId: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member UserIdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Url : FDR.BaseTypes.IJsonDocument + new : url:string -> expandedUrl:string -> displayUrl:string -> indices:int[] -> JsonProvider+Url + JsonRuntime.CreateRecord([| ("url", + (url :> obj)) + ("expanded_url", + (expandedUrl :> obj)) + ("display_url", + (displayUrl :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Url + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+User2 : FDR.BaseTypes.IJsonDocument + new : id:int -> idStr:int -> name:string -> screenName:string -> location:string option -> url:string option -> description:string -> protected:bool -> followersCount:int -> friendsCount:int -> listedCount:int -> createdAt:string -> favouritesCount:int -> utcOffset:int option -> timeZone:string option -> geoEnabled:bool -> verified:bool -> statusesCount:int -> lang:string -> contributorsEnabled:bool -> isTranslator:bool -> profileBackgroundColor:JsonProvider+IntOrString -> profileBackgroundImageUrl:string -> profileBackgroundImageUrlHttps:string -> profileBackgroundTile:bool -> profileImageUrl:string -> profileImageUrlHttps:string -> profileBannerUrl:string option -> profileLinkColor:string -> profileSidebarBorderColor:JsonProvider+IntOrString -> profileSidebarFillColor:JsonProvider+IntOrString -> profileTextColor:JsonProvider+IntOrString -> profileUseBackgroundImage:bool -> defaultProfile:bool -> defaultProfileImage:bool -> following:JsonValue -> followRequestSent:JsonValue -> notifications:JsonValue -> JsonProvider+User2 + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("name", + (name :> obj)) + ("screen_name", + (screenName :> obj)) + ("location", + (location :> obj)) + ("url", + (url :> obj)) + ("description", + (description :> obj)) + ("protected", + (protected :> obj)) + ("followers_count", + (followersCount :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("listed_count", + (listedCount :> obj)) + ("created_at", + (createdAt :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("time_zone", + (timeZone :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("verified", + (verified :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("lang", + (lang :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("following", + (following :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("notifications", + (notifications :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User2 + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "description") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_link_color") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileSidebarBorderColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+UserMention : FDR.BaseTypes.IJsonDocument + new : screenName:string -> name:string -> id:int -> idStr:int -> indices:int[] -> JsonProvider+UserMention + JsonRuntime.CreateRecord([| ("screen_name", + (screenName :> obj)) + ("name", + (name :> obj)) + ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+UserMention + JsonDocument.Create(jsonValue, "") + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Media : FDR.BaseTypes.IJsonDocument + new : id:int64 -> idStr:int64 -> indices:int[] -> mediaUrl:string -> mediaUrlHttps:string -> url:string -> displayUrl:string -> expandedUrl:string -> type:string -> sizes:JsonProvider+Sizes -> sourceStatusId:int64 -> sourceStatusIdStr:int64 -> JsonProvider+Media + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("id_str", + (idStr :> obj)) + ("indices", + (indices :> obj)) + ("media_url", + (mediaUrl :> obj)) + ("media_url_https", + (mediaUrlHttps :> obj)) + ("url", + (url :> obj)) + ("display_url", + (displayUrl :> obj)) + ("expanded_url", + (expandedUrl :> obj)) + ("type", + (type :> obj)) + ("sizes", + (sizes :> obj)) + ("source_status_id", + (sourceStatusId :> obj)) + ("source_status_id_str", + (sourceStatusIdStr :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Media + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member MediaUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member MediaUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Sizes: JsonProvider+Sizes with get + JsonRuntime.GetPropertyPacked(this, "sizes") + + member SourceStatusId: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source_status_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member SourceStatusIdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source_status_id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Sizes : FDR.BaseTypes.IJsonDocument + new : small:JsonProvider+Small -> thumb:JsonProvider+Small -> large:JsonProvider+Small -> medium:JsonProvider+Small -> JsonProvider+Sizes + JsonRuntime.CreateRecord([| ("small", + (small :> obj)) + ("thumb", + (thumb :> obj)) + ("large", + (large :> obj)) + ("medium", + (medium :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Sizes + JsonDocument.Create(jsonValue, "") + + member Large: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "large") + + member Medium: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "medium") + + member Small: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "small") + + member Thumb: JsonProvider+Small with get + JsonRuntime.GetPropertyPacked(this, "thumb") + + +class JsonProvider+Small : FDR.BaseTypes.IJsonDocument + new : w:int -> h:int -> resize:string -> JsonProvider+Small + JsonRuntime.CreateRecord([| ("w", + (w :> obj)) + ("h", + (h :> obj)) + ("resize", + (resize :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Small + JsonDocument.Create(jsonValue, "") + + member H: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "h") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Resize: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "resize") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member W: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "w") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..ba06eac44 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,1167 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterStream.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterStream.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : inReplyToStatusIdStr:int64 option -> text:string option -> inReplyToUserIdStr:int option -> retweetCount:int option -> geo:JsonProvider+Geo option -> source:string option -> retweeted:bool option -> truncated:bool option -> idStr:int64 option -> entities:JsonProvider+Entities option -> inReplyToUserId:int option -> inReplyToStatusId:int64 option -> place:JsonProvider+Place option -> coordinates:JsonProvider+Geo option -> inReplyToScreenName:string option -> createdAt:string option -> user:JsonProvider+User option -> id:int64 option -> contributors:JsonValue -> favorited:bool option -> possiblySensitive:bool option -> possiblySensitiveEditable:bool option -> retweetedStatus:JsonProvider+RetweetedStatus option -> delete:JsonProvider+Delete option -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("text", + (text :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("geo", + (geo :> obj)) + ("source", + (source :> obj)) + ("retweeted", + (retweeted :> obj)) + ("truncated", + (truncated :> obj)) + ("id_str", + (idStr :> obj)) + ("entities", + (entities :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("place", + (place :> obj)) + ("coordinates", + (coordinates :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("created_at", + (createdAt :> obj)) + ("user", + (user :> obj)) + ("id", + (id :> obj)) + ("contributors", + (contributors :> obj)) + ("favorited", + (favorited :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) + ("possibly_sensitive_editable", + (possiblySensitiveEditable :> obj)) + ("retweeted_status", + (retweetedStatus :> obj)) + ("delete", + (delete :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: JsonProvider+Geo option with get + JsonRuntime.TryGetPropertyPacked(this, "coordinates") + + member CreatedAt: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "created_at")) + + member Delete: JsonProvider+Delete option with get + JsonRuntime.TryGetPropertyPacked(this, "delete") + + member Entities: JsonProvider+Entities option with get + JsonRuntime.TryGetPropertyPacked(this, "entities") + + member Favorited: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "favorited")) + + member Geo: JsonProvider+Geo option with get + JsonRuntime.TryGetPropertyPacked(this, "geo") + + member Id: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id")) + + member IdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id_str")) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id")) + + member InReplyToStatusIdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id_str")) + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Place: JsonProvider+Place option with get + JsonRuntime.TryGetPropertyPacked(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member PossiblySensitiveEditable: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive_editable")) + + member RetweetCount: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "retweet_count")) + + member Retweeted: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "retweeted")) + + member RetweetedStatus: JsonProvider+RetweetedStatus option with get + JsonRuntime.TryGetPropertyPacked(this, "retweeted_status") + + member Source: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "source")) + + member Text: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "text")) + + member Truncated: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "truncated")) + + member User: JsonProvider+User option with get + JsonRuntime.TryGetPropertyPacked(this, "user") + + +class JsonProvider+Delete : FDR.BaseTypes.IJsonDocument + new : status:JsonProvider+Status -> JsonProvider+Delete + JsonRuntime.CreateRecord([| ("status", + (status :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Delete + JsonDocument.Create(jsonValue, "") + + member Status: JsonProvider+Status with get + JsonRuntime.GetPropertyPacked(this, "status") + + +class JsonProvider+Entities : FDR.BaseTypes.IJsonDocument + new : userMentions:JsonProvider+JsonProvider+UserMention[] -> hashtags:JsonProvider+JsonProvider+Hashtag[] -> urls:JsonProvider+JsonProvider+Url[] -> media:JsonProvider+JsonProvider+Media[] -> JsonProvider+Entities + JsonRuntime.CreateRecord([| ("user_mentions", + (userMentions :> obj)) + ("hashtags", + (hashtags :> obj)) + ("urls", + (urls :> obj)) + ("media", + (media :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Media: JsonProvider+JsonProvider+Media[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "media"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+Geo : FDR.BaseTypes.IJsonDocument + new : type:string -> coordinates:decimal[] -> JsonProvider+Geo + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("coordinates", + (coordinates :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Geo + JsonDocument.Create(jsonValue, "") + + member Coordinates: decimal[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "coordinates"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDecimal("", Some t.JsonValue), Some t.JsonValue))) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Place : FDR.BaseTypes.IJsonDocument + new : countryCode:string -> attributes:JsonProvider+Attributes -> fullName:string -> placeType:string -> name:string -> country:string -> id:string -> url:string -> boundingBox:JsonProvider+BoundingBox -> JsonProvider+Place + JsonRuntime.CreateRecord([| ("country_code", + (countryCode :> obj)) + ("attributes", + (attributes :> obj)) + ("full_name", + (fullName :> obj)) + ("place_type", + (placeType :> obj)) + ("name", + (name :> obj)) + ("country", + (country :> obj)) + ("id", + (id :> obj)) + ("url", + (url :> obj)) + ("bounding_box", + (boundingBox :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Place + JsonDocument.Create(jsonValue, "") + + member Attributes: JsonProvider+Attributes with get + JsonRuntime.GetPropertyPacked(this, "attributes") + + member BoundingBox: JsonProvider+BoundingBox with get + JsonRuntime.GetPropertyPacked(this, "bounding_box") + + member Country: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member CountryCode: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country_code") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FullName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "full_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PlaceType: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "place_type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+RetweetedStatus : FDR.BaseTypes.IJsonDocument + new : inReplyToStatusIdStr:int64 option -> text:string -> inReplyToUserIdStr:int option -> retweetCount:int -> geo:JsonValue -> source:string -> retweeted:bool -> truncated:bool -> idStr:int64 -> entities:JsonProvider+Entities2 -> inReplyToUserId:int option -> inReplyToStatusId:int64 option -> place:JsonValue -> coordinates:JsonValue -> inReplyToScreenName:string option -> createdAt:string -> user:JsonProvider+User2 -> id:int64 -> contributors:JsonValue -> favorited:bool -> possiblySensitive:bool option -> possiblySensitiveEditable:bool option -> JsonProvider+RetweetedStatus + JsonRuntime.CreateRecord([| ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("text", + (text :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("geo", + (geo :> obj)) + ("source", + (source :> obj)) + ("retweeted", + (retweeted :> obj)) + ("truncated", + (truncated :> obj)) + ("id_str", + (idStr :> obj)) + ("entities", + (entities :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("place", + (place :> obj)) + ("coordinates", + (coordinates :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("created_at", + (createdAt :> obj)) + ("user", + (user :> obj)) + ("id", + (id :> obj)) + ("contributors", + (contributors :> obj)) + ("favorited", + (favorited :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) + ("possibly_sensitive_editable", + (possiblySensitiveEditable :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+RetweetedStatus + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "coordinates") + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Entities: JsonProvider+Entities2 with get + JsonRuntime.GetPropertyPacked(this, "entities") + + member Favorited: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favorited") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Geo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "geo") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id")) + + member InReplyToStatusIdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id_str")) + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Place: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member PossiblySensitiveEditable: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive_editable")) + + member RetweetCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweet_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Retweeted: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweeted") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Source: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Truncated: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "truncated") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member User: JsonProvider+User2 with get + JsonRuntime.GetPropertyPacked(this, "user") + + +class JsonProvider+User : FDR.BaseTypes.IJsonDocument + new : notifications:JsonValue -> contributorsEnabled:bool -> timeZone:string option -> profileBackgroundColor:JsonProvider+IntOrString -> location:JsonProvider+IntOrString -> profileBackgroundTile:bool -> profileImageUrlHttps:string -> defaultProfileImage:bool -> followRequestSent:JsonValue -> profileSidebarFillColor:JsonProvider+IntOrString -> description:string option -> profileBannerUrl:string option -> favouritesCount:int -> screenName:string -> profileSidebarBorderColor:JsonProvider+FloatOrString -> idStr:int -> verified:bool -> lang:string -> statusesCount:int -> profileUseBackgroundImage:bool -> protected:bool -> profileImageUrl:string -> listedCount:int -> geoEnabled:bool -> createdAt:string -> profileTextColor:JsonProvider+FloatOrString -> name:string -> profileBackgroundImageUrl:string -> friendsCount:int -> url:string option -> id:int -> isTranslator:bool -> defaultProfile:bool -> following:JsonValue -> profileBackgroundImageUrlHttps:string -> utcOffset:int option -> profileLinkColor:JsonProvider+IntOrString -> followersCount:int -> JsonProvider+User + JsonRuntime.CreateRecord([| ("notifications", + (notifications :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("time_zone", + (timeZone :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("location", + (location :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("description", + (description :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("screen_name", + (screenName :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("id_str", + (idStr :> obj)) + ("verified", + (verified :> obj)) + ("lang", + (lang :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("protected", + (protected :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("listed_count", + (listedCount :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("created_at", + (createdAt :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("name", + (name :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("url", + (url :> obj)) + ("id", + (id :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("following", + (following :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("followers_count", + (followersCount :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "location") + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_link_color") + + member ProfileSidebarBorderColor: JsonProvider+FloatOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+FloatOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Attributes : FDR.BaseTypes.IJsonDocument + new : () -> JsonProvider+Attributes + JsonRuntime.CreateRecord([| |], "") + + new : jsonValue:JsonValue -> JsonProvider+Attributes + JsonDocument.Create(jsonValue, "") + + +class JsonProvider+BoundingBox : FDR.BaseTypes.IJsonDocument + new : type:string -> coordinates:decimal[][][] -> JsonProvider+BoundingBox + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("coordinates", + (coordinates :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+BoundingBox + JsonDocument.Create(jsonValue, "") + + member Coordinates: decimal[][][] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "coordinates"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDecimal("", Some t.JsonValue), Some t.JsonValue))))))) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Entities2 : FDR.BaseTypes.IJsonDocument + new : userMentions:JsonProvider+JsonProvider+UserMention[] -> hashtags:JsonProvider+JsonProvider+Hashtag[] -> urls:JsonProvider+JsonProvider+Url[] -> media:JsonProvider+JsonProvider+Media[] -> JsonProvider+Entities2 + JsonRuntime.CreateRecord([| ("user_mentions", + (userMentions :> obj)) + ("hashtags", + (hashtags :> obj)) + ("urls", + (urls :> obj)) + ("media", + (media :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities2 + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Media: JsonProvider+JsonProvider+Media[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "media"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+FloatOrString : FDR.BaseTypes.IJsonDocument + new : number:float -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+FloatOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+FloatOrString + JsonDocument.Create(jsonValue, "") + + member Number: float option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertFloat("", "", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Hashtag : FDR.BaseTypes.IJsonDocument + new : text:string -> indices:int[] -> JsonProvider+Hashtag + JsonRuntime.CreateRecord([| ("text", + (text :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Hashtag + JsonDocument.Create(jsonValue, "") + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+IntOrString : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+IntOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+IntOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrString + JsonDocument.Create(jsonValue, "") + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Media : FDR.BaseTypes.IJsonDocument + new : type:string -> expandedUrl:string -> indices:int[] -> mediaUrlHttps:string -> sizes:JsonProvider+Sizes -> idStr:int64 -> mediaUrl:string -> id:int64 -> url:string -> displayUrl:string -> JsonProvider+Media + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("expanded_url", + (expandedUrl :> obj)) + ("indices", + (indices :> obj)) + ("media_url_https", + (mediaUrlHttps :> obj)) + ("sizes", + (sizes :> obj)) + ("id_str", + (idStr :> obj)) + ("media_url", + (mediaUrl :> obj)) + ("id", + (id :> obj)) + ("url", + (url :> obj)) + ("display_url", + (displayUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Media + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member MediaUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member MediaUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Sizes: JsonProvider+Sizes with get + JsonRuntime.GetPropertyPacked(this, "sizes") + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Status : FDR.BaseTypes.IJsonDocument + new : userIdStr:int -> idStr:int64 -> id:int64 -> userId:int -> JsonProvider+Status + JsonRuntime.CreateRecord([| ("user_id_str", + (userIdStr :> obj)) + ("id_str", + (idStr :> obj)) + ("id", + (id :> obj)) + ("user_id", + (userId :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Status + JsonDocument.Create(jsonValue, "") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member UserId: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member UserIdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Url : FDR.BaseTypes.IJsonDocument + new : expandedUrl:string -> indices:int[] -> displayUrl:string -> url:string -> JsonProvider+Url + JsonRuntime.CreateRecord([| ("expanded_url", + (expandedUrl :> obj)) + ("indices", + (indices :> obj)) + ("display_url", + (displayUrl :> obj)) + ("url", + (url :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Url + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+User2 : FDR.BaseTypes.IJsonDocument + new : notifications:JsonValue -> contributorsEnabled:bool -> timeZone:string option -> profileBackgroundColor:JsonProvider+IntOrString -> location:string option -> profileBackgroundTile:bool -> profileImageUrlHttps:string -> defaultProfileImage:bool -> followRequestSent:JsonValue -> profileSidebarFillColor:JsonProvider+IntOrString -> description:string option -> favouritesCount:int -> screenName:string -> profileSidebarBorderColor:JsonProvider+IntOrString -> idStr:int -> verified:bool -> lang:string -> statusesCount:int -> profileUseBackgroundImage:bool -> protected:bool -> profileImageUrl:string -> listedCount:int -> geoEnabled:bool -> createdAt:string -> profileTextColor:JsonProvider+IntOrString -> name:string -> profileBackgroundImageUrl:string -> friendsCount:int -> url:string option -> id:int -> isTranslator:bool -> defaultProfile:bool -> following:JsonValue -> profileBackgroundImageUrlHttps:string -> utcOffset:int option -> profileLinkColor:JsonProvider+IntOrString -> followersCount:int -> profileBannerUrl:string option -> JsonProvider+User2 + JsonRuntime.CreateRecord([| ("notifications", + (notifications :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("time_zone", + (timeZone :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("location", + (location :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("description", + (description :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("screen_name", + (screenName :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("id_str", + (idStr :> obj)) + ("verified", + (verified :> obj)) + ("lang", + (lang :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("protected", + (protected :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("listed_count", + (listedCount :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("created_at", + (createdAt :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("name", + (name :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("url", + (url :> obj)) + ("id", + (id :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("following", + (following :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("followers_count", + (followersCount :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User2 + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_link_color") + + member ProfileSidebarBorderColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+UserMention : FDR.BaseTypes.IJsonDocument + new : indices:int[] -> screenName:string -> idStr:int -> name:string -> id:int -> JsonProvider+UserMention + JsonRuntime.CreateRecord([| ("indices", + (indices :> obj)) + ("screen_name", + (screenName :> obj)) + ("id_str", + (idStr :> obj)) + ("name", + (name :> obj)) + ("id", + (id :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+UserMention + JsonDocument.Create(jsonValue, "") + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Sizes : FDR.BaseTypes.IJsonDocument + new : thumb:JsonProvider+Thumb -> medium:JsonProvider+Thumb -> large:JsonProvider+Thumb -> small:JsonProvider+Thumb -> JsonProvider+Sizes + JsonRuntime.CreateRecord([| ("thumb", + (thumb :> obj)) + ("medium", + (medium :> obj)) + ("large", + (large :> obj)) + ("small", + (small :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Sizes + JsonDocument.Create(jsonValue, "") + + member Large: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "large") + + member Medium: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "medium") + + member Small: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "small") + + member Thumb: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "thumb") + + +class JsonProvider+Thumb : FDR.BaseTypes.IJsonDocument + new : h:int -> w:int -> resize:string -> JsonProvider+Thumb + JsonRuntime.CreateRecord([| ("h", + (h :> obj)) + ("w", + (w :> obj)) + ("resize", + (resize :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Thumb + JsonDocument.Create(jsonValue, "") + + member H: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "h") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Resize: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "resize") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member W: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "w") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..ba06eac44 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,1167 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterStream.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterStream.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : inReplyToStatusIdStr:int64 option -> text:string option -> inReplyToUserIdStr:int option -> retweetCount:int option -> geo:JsonProvider+Geo option -> source:string option -> retweeted:bool option -> truncated:bool option -> idStr:int64 option -> entities:JsonProvider+Entities option -> inReplyToUserId:int option -> inReplyToStatusId:int64 option -> place:JsonProvider+Place option -> coordinates:JsonProvider+Geo option -> inReplyToScreenName:string option -> createdAt:string option -> user:JsonProvider+User option -> id:int64 option -> contributors:JsonValue -> favorited:bool option -> possiblySensitive:bool option -> possiblySensitiveEditable:bool option -> retweetedStatus:JsonProvider+RetweetedStatus option -> delete:JsonProvider+Delete option -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("text", + (text :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("geo", + (geo :> obj)) + ("source", + (source :> obj)) + ("retweeted", + (retweeted :> obj)) + ("truncated", + (truncated :> obj)) + ("id_str", + (idStr :> obj)) + ("entities", + (entities :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("place", + (place :> obj)) + ("coordinates", + (coordinates :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("created_at", + (createdAt :> obj)) + ("user", + (user :> obj)) + ("id", + (id :> obj)) + ("contributors", + (contributors :> obj)) + ("favorited", + (favorited :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) + ("possibly_sensitive_editable", + (possiblySensitiveEditable :> obj)) + ("retweeted_status", + (retweetedStatus :> obj)) + ("delete", + (delete :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: JsonProvider+Geo option with get + JsonRuntime.TryGetPropertyPacked(this, "coordinates") + + member CreatedAt: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "created_at")) + + member Delete: JsonProvider+Delete option with get + JsonRuntime.TryGetPropertyPacked(this, "delete") + + member Entities: JsonProvider+Entities option with get + JsonRuntime.TryGetPropertyPacked(this, "entities") + + member Favorited: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "favorited")) + + member Geo: JsonProvider+Geo option with get + JsonRuntime.TryGetPropertyPacked(this, "geo") + + member Id: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id")) + + member IdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id_str")) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id")) + + member InReplyToStatusIdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id_str")) + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Place: JsonProvider+Place option with get + JsonRuntime.TryGetPropertyPacked(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member PossiblySensitiveEditable: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive_editable")) + + member RetweetCount: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "retweet_count")) + + member Retweeted: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "retweeted")) + + member RetweetedStatus: JsonProvider+RetweetedStatus option with get + JsonRuntime.TryGetPropertyPacked(this, "retweeted_status") + + member Source: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "source")) + + member Text: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "text")) + + member Truncated: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "truncated")) + + member User: JsonProvider+User option with get + JsonRuntime.TryGetPropertyPacked(this, "user") + + +class JsonProvider+Delete : FDR.BaseTypes.IJsonDocument + new : status:JsonProvider+Status -> JsonProvider+Delete + JsonRuntime.CreateRecord([| ("status", + (status :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Delete + JsonDocument.Create(jsonValue, "") + + member Status: JsonProvider+Status with get + JsonRuntime.GetPropertyPacked(this, "status") + + +class JsonProvider+Entities : FDR.BaseTypes.IJsonDocument + new : userMentions:JsonProvider+JsonProvider+UserMention[] -> hashtags:JsonProvider+JsonProvider+Hashtag[] -> urls:JsonProvider+JsonProvider+Url[] -> media:JsonProvider+JsonProvider+Media[] -> JsonProvider+Entities + JsonRuntime.CreateRecord([| ("user_mentions", + (userMentions :> obj)) + ("hashtags", + (hashtags :> obj)) + ("urls", + (urls :> obj)) + ("media", + (media :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Media: JsonProvider+JsonProvider+Media[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "media"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+Geo : FDR.BaseTypes.IJsonDocument + new : type:string -> coordinates:decimal[] -> JsonProvider+Geo + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("coordinates", + (coordinates :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Geo + JsonDocument.Create(jsonValue, "") + + member Coordinates: decimal[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "coordinates"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDecimal("", Some t.JsonValue), Some t.JsonValue))) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Place : FDR.BaseTypes.IJsonDocument + new : countryCode:string -> attributes:JsonProvider+Attributes -> fullName:string -> placeType:string -> name:string -> country:string -> id:string -> url:string -> boundingBox:JsonProvider+BoundingBox -> JsonProvider+Place + JsonRuntime.CreateRecord([| ("country_code", + (countryCode :> obj)) + ("attributes", + (attributes :> obj)) + ("full_name", + (fullName :> obj)) + ("place_type", + (placeType :> obj)) + ("name", + (name :> obj)) + ("country", + (country :> obj)) + ("id", + (id :> obj)) + ("url", + (url :> obj)) + ("bounding_box", + (boundingBox :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Place + JsonDocument.Create(jsonValue, "") + + member Attributes: JsonProvider+Attributes with get + JsonRuntime.GetPropertyPacked(this, "attributes") + + member BoundingBox: JsonProvider+BoundingBox with get + JsonRuntime.GetPropertyPacked(this, "bounding_box") + + member Country: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member CountryCode: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country_code") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FullName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "full_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PlaceType: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "place_type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+RetweetedStatus : FDR.BaseTypes.IJsonDocument + new : inReplyToStatusIdStr:int64 option -> text:string -> inReplyToUserIdStr:int option -> retweetCount:int -> geo:JsonValue -> source:string -> retweeted:bool -> truncated:bool -> idStr:int64 -> entities:JsonProvider+Entities2 -> inReplyToUserId:int option -> inReplyToStatusId:int64 option -> place:JsonValue -> coordinates:JsonValue -> inReplyToScreenName:string option -> createdAt:string -> user:JsonProvider+User2 -> id:int64 -> contributors:JsonValue -> favorited:bool -> possiblySensitive:bool option -> possiblySensitiveEditable:bool option -> JsonProvider+RetweetedStatus + JsonRuntime.CreateRecord([| ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("text", + (text :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("geo", + (geo :> obj)) + ("source", + (source :> obj)) + ("retweeted", + (retweeted :> obj)) + ("truncated", + (truncated :> obj)) + ("id_str", + (idStr :> obj)) + ("entities", + (entities :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("place", + (place :> obj)) + ("coordinates", + (coordinates :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("created_at", + (createdAt :> obj)) + ("user", + (user :> obj)) + ("id", + (id :> obj)) + ("contributors", + (contributors :> obj)) + ("favorited", + (favorited :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) + ("possibly_sensitive_editable", + (possiblySensitiveEditable :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+RetweetedStatus + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "coordinates") + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Entities: JsonProvider+Entities2 with get + JsonRuntime.GetPropertyPacked(this, "entities") + + member Favorited: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favorited") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Geo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "geo") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id")) + + member InReplyToStatusIdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id_str")) + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Place: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member PossiblySensitiveEditable: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive_editable")) + + member RetweetCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweet_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Retweeted: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweeted") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Source: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Truncated: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "truncated") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member User: JsonProvider+User2 with get + JsonRuntime.GetPropertyPacked(this, "user") + + +class JsonProvider+User : FDR.BaseTypes.IJsonDocument + new : notifications:JsonValue -> contributorsEnabled:bool -> timeZone:string option -> profileBackgroundColor:JsonProvider+IntOrString -> location:JsonProvider+IntOrString -> profileBackgroundTile:bool -> profileImageUrlHttps:string -> defaultProfileImage:bool -> followRequestSent:JsonValue -> profileSidebarFillColor:JsonProvider+IntOrString -> description:string option -> profileBannerUrl:string option -> favouritesCount:int -> screenName:string -> profileSidebarBorderColor:JsonProvider+FloatOrString -> idStr:int -> verified:bool -> lang:string -> statusesCount:int -> profileUseBackgroundImage:bool -> protected:bool -> profileImageUrl:string -> listedCount:int -> geoEnabled:bool -> createdAt:string -> profileTextColor:JsonProvider+FloatOrString -> name:string -> profileBackgroundImageUrl:string -> friendsCount:int -> url:string option -> id:int -> isTranslator:bool -> defaultProfile:bool -> following:JsonValue -> profileBackgroundImageUrlHttps:string -> utcOffset:int option -> profileLinkColor:JsonProvider+IntOrString -> followersCount:int -> JsonProvider+User + JsonRuntime.CreateRecord([| ("notifications", + (notifications :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("time_zone", + (timeZone :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("location", + (location :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("description", + (description :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("screen_name", + (screenName :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("id_str", + (idStr :> obj)) + ("verified", + (verified :> obj)) + ("lang", + (lang :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("protected", + (protected :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("listed_count", + (listedCount :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("created_at", + (createdAt :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("name", + (name :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("url", + (url :> obj)) + ("id", + (id :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("following", + (following :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("followers_count", + (followersCount :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "location") + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_link_color") + + member ProfileSidebarBorderColor: JsonProvider+FloatOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+FloatOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Attributes : FDR.BaseTypes.IJsonDocument + new : () -> JsonProvider+Attributes + JsonRuntime.CreateRecord([| |], "") + + new : jsonValue:JsonValue -> JsonProvider+Attributes + JsonDocument.Create(jsonValue, "") + + +class JsonProvider+BoundingBox : FDR.BaseTypes.IJsonDocument + new : type:string -> coordinates:decimal[][][] -> JsonProvider+BoundingBox + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("coordinates", + (coordinates :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+BoundingBox + JsonDocument.Create(jsonValue, "") + + member Coordinates: decimal[][][] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "coordinates"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDecimal("", Some t.JsonValue), Some t.JsonValue))))))) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Entities2 : FDR.BaseTypes.IJsonDocument + new : userMentions:JsonProvider+JsonProvider+UserMention[] -> hashtags:JsonProvider+JsonProvider+Hashtag[] -> urls:JsonProvider+JsonProvider+Url[] -> media:JsonProvider+JsonProvider+Media[] -> JsonProvider+Entities2 + JsonRuntime.CreateRecord([| ("user_mentions", + (userMentions :> obj)) + ("hashtags", + (hashtags :> obj)) + ("urls", + (urls :> obj)) + ("media", + (media :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities2 + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Media: JsonProvider+JsonProvider+Media[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "media"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+FloatOrString : FDR.BaseTypes.IJsonDocument + new : number:float -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+FloatOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+FloatOrString + JsonDocument.Create(jsonValue, "") + + member Number: float option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertFloat("", "", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Hashtag : FDR.BaseTypes.IJsonDocument + new : text:string -> indices:int[] -> JsonProvider+Hashtag + JsonRuntime.CreateRecord([| ("text", + (text :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Hashtag + JsonDocument.Create(jsonValue, "") + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+IntOrString : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+IntOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+IntOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrString + JsonDocument.Create(jsonValue, "") + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Media : FDR.BaseTypes.IJsonDocument + new : type:string -> expandedUrl:string -> indices:int[] -> mediaUrlHttps:string -> sizes:JsonProvider+Sizes -> idStr:int64 -> mediaUrl:string -> id:int64 -> url:string -> displayUrl:string -> JsonProvider+Media + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("expanded_url", + (expandedUrl :> obj)) + ("indices", + (indices :> obj)) + ("media_url_https", + (mediaUrlHttps :> obj)) + ("sizes", + (sizes :> obj)) + ("id_str", + (idStr :> obj)) + ("media_url", + (mediaUrl :> obj)) + ("id", + (id :> obj)) + ("url", + (url :> obj)) + ("display_url", + (displayUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Media + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member MediaUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member MediaUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Sizes: JsonProvider+Sizes with get + JsonRuntime.GetPropertyPacked(this, "sizes") + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Status : FDR.BaseTypes.IJsonDocument + new : userIdStr:int -> idStr:int64 -> id:int64 -> userId:int -> JsonProvider+Status + JsonRuntime.CreateRecord([| ("user_id_str", + (userIdStr :> obj)) + ("id_str", + (idStr :> obj)) + ("id", + (id :> obj)) + ("user_id", + (userId :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Status + JsonDocument.Create(jsonValue, "") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member UserId: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member UserIdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Url : FDR.BaseTypes.IJsonDocument + new : expandedUrl:string -> indices:int[] -> displayUrl:string -> url:string -> JsonProvider+Url + JsonRuntime.CreateRecord([| ("expanded_url", + (expandedUrl :> obj)) + ("indices", + (indices :> obj)) + ("display_url", + (displayUrl :> obj)) + ("url", + (url :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Url + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+User2 : FDR.BaseTypes.IJsonDocument + new : notifications:JsonValue -> contributorsEnabled:bool -> timeZone:string option -> profileBackgroundColor:JsonProvider+IntOrString -> location:string option -> profileBackgroundTile:bool -> profileImageUrlHttps:string -> defaultProfileImage:bool -> followRequestSent:JsonValue -> profileSidebarFillColor:JsonProvider+IntOrString -> description:string option -> favouritesCount:int -> screenName:string -> profileSidebarBorderColor:JsonProvider+IntOrString -> idStr:int -> verified:bool -> lang:string -> statusesCount:int -> profileUseBackgroundImage:bool -> protected:bool -> profileImageUrl:string -> listedCount:int -> geoEnabled:bool -> createdAt:string -> profileTextColor:JsonProvider+IntOrString -> name:string -> profileBackgroundImageUrl:string -> friendsCount:int -> url:string option -> id:int -> isTranslator:bool -> defaultProfile:bool -> following:JsonValue -> profileBackgroundImageUrlHttps:string -> utcOffset:int option -> profileLinkColor:JsonProvider+IntOrString -> followersCount:int -> profileBannerUrl:string option -> JsonProvider+User2 + JsonRuntime.CreateRecord([| ("notifications", + (notifications :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("time_zone", + (timeZone :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("location", + (location :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("description", + (description :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("screen_name", + (screenName :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("id_str", + (idStr :> obj)) + ("verified", + (verified :> obj)) + ("lang", + (lang :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("protected", + (protected :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("listed_count", + (listedCount :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("created_at", + (createdAt :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("name", + (name :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("url", + (url :> obj)) + ("id", + (id :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("following", + (following :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("followers_count", + (followersCount :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User2 + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_link_color") + + member ProfileSidebarBorderColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+UserMention : FDR.BaseTypes.IJsonDocument + new : indices:int[] -> screenName:string -> idStr:int -> name:string -> id:int -> JsonProvider+UserMention + JsonRuntime.CreateRecord([| ("indices", + (indices :> obj)) + ("screen_name", + (screenName :> obj)) + ("id_str", + (idStr :> obj)) + ("name", + (name :> obj)) + ("id", + (id :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+UserMention + JsonDocument.Create(jsonValue, "") + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Sizes : FDR.BaseTypes.IJsonDocument + new : thumb:JsonProvider+Thumb -> medium:JsonProvider+Thumb -> large:JsonProvider+Thumb -> small:JsonProvider+Thumb -> JsonProvider+Sizes + JsonRuntime.CreateRecord([| ("thumb", + (thumb :> obj)) + ("medium", + (medium :> obj)) + ("large", + (large :> obj)) + ("small", + (small :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Sizes + JsonDocument.Create(jsonValue, "") + + member Large: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "large") + + member Medium: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "medium") + + member Small: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "small") + + member Thumb: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "thumb") + + +class JsonProvider+Thumb : FDR.BaseTypes.IJsonDocument + new : h:int -> w:int -> resize:string -> JsonProvider+Thumb + JsonRuntime.CreateRecord([| ("h", + (h :> obj)) + ("w", + (w :> obj)) + ("resize", + (resize :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Thumb + JsonDocument.Create(jsonValue, "") + + member H: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "h") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Resize: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "resize") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member W: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "w") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..ba06eac44 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TwitterStream.json,True,,,True,False,ValuesOnly.expected @@ -0,0 +1,1167 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterStream.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TwitterStream.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : inReplyToStatusIdStr:int64 option -> text:string option -> inReplyToUserIdStr:int option -> retweetCount:int option -> geo:JsonProvider+Geo option -> source:string option -> retweeted:bool option -> truncated:bool option -> idStr:int64 option -> entities:JsonProvider+Entities option -> inReplyToUserId:int option -> inReplyToStatusId:int64 option -> place:JsonProvider+Place option -> coordinates:JsonProvider+Geo option -> inReplyToScreenName:string option -> createdAt:string option -> user:JsonProvider+User option -> id:int64 option -> contributors:JsonValue -> favorited:bool option -> possiblySensitive:bool option -> possiblySensitiveEditable:bool option -> retweetedStatus:JsonProvider+RetweetedStatus option -> delete:JsonProvider+Delete option -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("text", + (text :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("geo", + (geo :> obj)) + ("source", + (source :> obj)) + ("retweeted", + (retweeted :> obj)) + ("truncated", + (truncated :> obj)) + ("id_str", + (idStr :> obj)) + ("entities", + (entities :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("place", + (place :> obj)) + ("coordinates", + (coordinates :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("created_at", + (createdAt :> obj)) + ("user", + (user :> obj)) + ("id", + (id :> obj)) + ("contributors", + (contributors :> obj)) + ("favorited", + (favorited :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) + ("possibly_sensitive_editable", + (possiblySensitiveEditable :> obj)) + ("retweeted_status", + (retweetedStatus :> obj)) + ("delete", + (delete :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: JsonProvider+Geo option with get + JsonRuntime.TryGetPropertyPacked(this, "coordinates") + + member CreatedAt: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "created_at")) + + member Delete: JsonProvider+Delete option with get + JsonRuntime.TryGetPropertyPacked(this, "delete") + + member Entities: JsonProvider+Entities option with get + JsonRuntime.TryGetPropertyPacked(this, "entities") + + member Favorited: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "favorited")) + + member Geo: JsonProvider+Geo option with get + JsonRuntime.TryGetPropertyPacked(this, "geo") + + member Id: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id")) + + member IdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "id_str")) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id")) + + member InReplyToStatusIdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id_str")) + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Place: JsonProvider+Place option with get + JsonRuntime.TryGetPropertyPacked(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member PossiblySensitiveEditable: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive_editable")) + + member RetweetCount: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "retweet_count")) + + member Retweeted: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "retweeted")) + + member RetweetedStatus: JsonProvider+RetweetedStatus option with get + JsonRuntime.TryGetPropertyPacked(this, "retweeted_status") + + member Source: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "source")) + + member Text: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "text")) + + member Truncated: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "truncated")) + + member User: JsonProvider+User option with get + JsonRuntime.TryGetPropertyPacked(this, "user") + + +class JsonProvider+Delete : FDR.BaseTypes.IJsonDocument + new : status:JsonProvider+Status -> JsonProvider+Delete + JsonRuntime.CreateRecord([| ("status", + (status :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Delete + JsonDocument.Create(jsonValue, "") + + member Status: JsonProvider+Status with get + JsonRuntime.GetPropertyPacked(this, "status") + + +class JsonProvider+Entities : FDR.BaseTypes.IJsonDocument + new : userMentions:JsonProvider+JsonProvider+UserMention[] -> hashtags:JsonProvider+JsonProvider+Hashtag[] -> urls:JsonProvider+JsonProvider+Url[] -> media:JsonProvider+JsonProvider+Media[] -> JsonProvider+Entities + JsonRuntime.CreateRecord([| ("user_mentions", + (userMentions :> obj)) + ("hashtags", + (hashtags :> obj)) + ("urls", + (urls :> obj)) + ("media", + (media :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Media: JsonProvider+JsonProvider+Media[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "media"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+Geo : FDR.BaseTypes.IJsonDocument + new : type:string -> coordinates:decimal[] -> JsonProvider+Geo + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("coordinates", + (coordinates :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Geo + JsonDocument.Create(jsonValue, "") + + member Coordinates: decimal[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "coordinates"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDecimal("", Some t.JsonValue), Some t.JsonValue))) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Place : FDR.BaseTypes.IJsonDocument + new : countryCode:string -> attributes:JsonProvider+Attributes -> fullName:string -> placeType:string -> name:string -> country:string -> id:string -> url:string -> boundingBox:JsonProvider+BoundingBox -> JsonProvider+Place + JsonRuntime.CreateRecord([| ("country_code", + (countryCode :> obj)) + ("attributes", + (attributes :> obj)) + ("full_name", + (fullName :> obj)) + ("place_type", + (placeType :> obj)) + ("name", + (name :> obj)) + ("country", + (country :> obj)) + ("id", + (id :> obj)) + ("url", + (url :> obj)) + ("bounding_box", + (boundingBox :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Place + JsonDocument.Create(jsonValue, "") + + member Attributes: JsonProvider+Attributes with get + JsonRuntime.GetPropertyPacked(this, "attributes") + + member BoundingBox: JsonProvider+BoundingBox with get + JsonRuntime.GetPropertyPacked(this, "bounding_box") + + member Country: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member CountryCode: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "country_code") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member FullName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "full_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PlaceType: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "place_type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+RetweetedStatus : FDR.BaseTypes.IJsonDocument + new : inReplyToStatusIdStr:int64 option -> text:string -> inReplyToUserIdStr:int option -> retweetCount:int -> geo:JsonValue -> source:string -> retweeted:bool -> truncated:bool -> idStr:int64 -> entities:JsonProvider+Entities2 -> inReplyToUserId:int option -> inReplyToStatusId:int64 option -> place:JsonValue -> coordinates:JsonValue -> inReplyToScreenName:string option -> createdAt:string -> user:JsonProvider+User2 -> id:int64 -> contributors:JsonValue -> favorited:bool -> possiblySensitive:bool option -> possiblySensitiveEditable:bool option -> JsonProvider+RetweetedStatus + JsonRuntime.CreateRecord([| ("in_reply_to_status_id_str", + (inReplyToStatusIdStr :> obj)) + ("text", + (text :> obj)) + ("in_reply_to_user_id_str", + (inReplyToUserIdStr :> obj)) + ("retweet_count", + (retweetCount :> obj)) + ("geo", + (geo :> obj)) + ("source", + (source :> obj)) + ("retweeted", + (retweeted :> obj)) + ("truncated", + (truncated :> obj)) + ("id_str", + (idStr :> obj)) + ("entities", + (entities :> obj)) + ("in_reply_to_user_id", + (inReplyToUserId :> obj)) + ("in_reply_to_status_id", + (inReplyToStatusId :> obj)) + ("place", + (place :> obj)) + ("coordinates", + (coordinates :> obj)) + ("in_reply_to_screen_name", + (inReplyToScreenName :> obj)) + ("created_at", + (createdAt :> obj)) + ("user", + (user :> obj)) + ("id", + (id :> obj)) + ("contributors", + (contributors :> obj)) + ("favorited", + (favorited :> obj)) + ("possibly_sensitive", + (possiblySensitive :> obj)) + ("possibly_sensitive_editable", + (possiblySensitiveEditable :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+RetweetedStatus + JsonDocument.Create(jsonValue, "") + + member Contributors: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "contributors") + + member Coordinates: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "coordinates") + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Entities: JsonProvider+Entities2 with get + JsonRuntime.GetPropertyPacked(this, "entities") + + member Favorited: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favorited") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Geo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "geo") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member InReplyToScreenName: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_screen_name")) + + member InReplyToStatusId: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id")) + + member InReplyToStatusIdStr: int64 option with get + JsonRuntime.ConvertInteger64("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_status_id_str")) + + member InReplyToUserId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id")) + + member InReplyToUserIdStr: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "in_reply_to_user_id_str")) + + member Place: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "place") + + member PossiblySensitive: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive")) + + member PossiblySensitiveEditable: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "possibly_sensitive_editable")) + + member RetweetCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweet_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Retweeted: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "retweeted") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Source: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "source") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Truncated: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "truncated") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member User: JsonProvider+User2 with get + JsonRuntime.GetPropertyPacked(this, "user") + + +class JsonProvider+User : FDR.BaseTypes.IJsonDocument + new : notifications:JsonValue -> contributorsEnabled:bool -> timeZone:string option -> profileBackgroundColor:JsonProvider+IntOrString -> location:JsonProvider+IntOrString -> profileBackgroundTile:bool -> profileImageUrlHttps:string -> defaultProfileImage:bool -> followRequestSent:JsonValue -> profileSidebarFillColor:JsonProvider+IntOrString -> description:string option -> profileBannerUrl:string option -> favouritesCount:int -> screenName:string -> profileSidebarBorderColor:JsonProvider+FloatOrString -> idStr:int -> verified:bool -> lang:string -> statusesCount:int -> profileUseBackgroundImage:bool -> protected:bool -> profileImageUrl:string -> listedCount:int -> geoEnabled:bool -> createdAt:string -> profileTextColor:JsonProvider+FloatOrString -> name:string -> profileBackgroundImageUrl:string -> friendsCount:int -> url:string option -> id:int -> isTranslator:bool -> defaultProfile:bool -> following:JsonValue -> profileBackgroundImageUrlHttps:string -> utcOffset:int option -> profileLinkColor:JsonProvider+IntOrString -> followersCount:int -> JsonProvider+User + JsonRuntime.CreateRecord([| ("notifications", + (notifications :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("time_zone", + (timeZone :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("location", + (location :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("description", + (description :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("screen_name", + (screenName :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("id_str", + (idStr :> obj)) + ("verified", + (verified :> obj)) + ("lang", + (lang :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("protected", + (protected :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("listed_count", + (listedCount :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("created_at", + (createdAt :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("name", + (name :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("url", + (url :> obj)) + ("id", + (id :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("following", + (following :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("followers_count", + (followersCount :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "location") + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_link_color") + + member ProfileSidebarBorderColor: JsonProvider+FloatOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+FloatOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Attributes : FDR.BaseTypes.IJsonDocument + new : () -> JsonProvider+Attributes + JsonRuntime.CreateRecord([| |], "") + + new : jsonValue:JsonValue -> JsonProvider+Attributes + JsonDocument.Create(jsonValue, "") + + +class JsonProvider+BoundingBox : FDR.BaseTypes.IJsonDocument + new : type:string -> coordinates:decimal[][][] -> JsonProvider+BoundingBox + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("coordinates", + (coordinates :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+BoundingBox + JsonDocument.Create(jsonValue, "") + + member Coordinates: decimal[][][] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "coordinates"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.ConvertArray(t, new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDecimal("", Some t.JsonValue), Some t.JsonValue))))))) + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Entities2 : FDR.BaseTypes.IJsonDocument + new : userMentions:JsonProvider+JsonProvider+UserMention[] -> hashtags:JsonProvider+JsonProvider+Hashtag[] -> urls:JsonProvider+JsonProvider+Url[] -> media:JsonProvider+JsonProvider+Media[] -> JsonProvider+Entities2 + JsonRuntime.CreateRecord([| ("user_mentions", + (userMentions :> obj)) + ("hashtags", + (hashtags :> obj)) + ("urls", + (urls :> obj)) + ("media", + (media :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Entities2 + JsonDocument.Create(jsonValue, "") + + member Hashtags: JsonProvider+JsonProvider+Hashtag[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "hashtags"), new Func<_,_>(id))) + + member Media: JsonProvider+JsonProvider+Media[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "media"), new Func<_,_>(id))) + + member Urls: JsonProvider+JsonProvider+Url[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "urls"), new Func<_,_>(id))) + + member UserMentions: JsonProvider+JsonProvider+UserMention[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "user_mentions"), new Func<_,_>(id))) + + +class JsonProvider+FloatOrString : FDR.BaseTypes.IJsonDocument + new : number:float -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+FloatOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+FloatOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+FloatOrString + JsonDocument.Create(jsonValue, "") + + member Number: float option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertFloat("", "", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Hashtag : FDR.BaseTypes.IJsonDocument + new : text:string -> indices:int[] -> JsonProvider+Hashtag + JsonRuntime.CreateRecord([| ("text", + (text :> obj)) + ("indices", + (indices :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Hashtag + JsonDocument.Create(jsonValue, "") + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+IntOrString : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+IntOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+IntOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrString + JsonDocument.Create(jsonValue, "") + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Media : FDR.BaseTypes.IJsonDocument + new : type:string -> expandedUrl:string -> indices:int[] -> mediaUrlHttps:string -> sizes:JsonProvider+Sizes -> idStr:int64 -> mediaUrl:string -> id:int64 -> url:string -> displayUrl:string -> JsonProvider+Media + JsonRuntime.CreateRecord([| ("type", + (type :> obj)) + ("expanded_url", + (expandedUrl :> obj)) + ("indices", + (indices :> obj)) + ("media_url_https", + (mediaUrlHttps :> obj)) + ("sizes", + (sizes :> obj)) + ("id_str", + (idStr :> obj)) + ("media_url", + (mediaUrl :> obj)) + ("id", + (id :> obj)) + ("url", + (url :> obj)) + ("display_url", + (displayUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Media + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member MediaUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member MediaUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "media_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Sizes: JsonProvider+Sizes with get + JsonRuntime.GetPropertyPacked(this, "sizes") + + member Type: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Status : FDR.BaseTypes.IJsonDocument + new : userIdStr:int -> idStr:int64 -> id:int64 -> userId:int -> JsonProvider+Status + JsonRuntime.CreateRecord([| ("user_id_str", + (userIdStr :> obj)) + ("id_str", + (idStr :> obj)) + ("id", + (id :> obj)) + ("user_id", + (userId :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Status + JsonDocument.Create(jsonValue, "") + + member Id: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IdStr: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member UserId: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member UserIdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "user_id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Url : FDR.BaseTypes.IJsonDocument + new : expandedUrl:string -> indices:int[] -> displayUrl:string -> url:string -> JsonProvider+Url + JsonRuntime.CreateRecord([| ("expanded_url", + (expandedUrl :> obj)) + ("indices", + (indices :> obj)) + ("display_url", + (displayUrl :> obj)) + ("url", + (url :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Url + JsonDocument.Create(jsonValue, "") + + member DisplayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ExpandedUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "expanded_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Url: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+User2 : FDR.BaseTypes.IJsonDocument + new : notifications:JsonValue -> contributorsEnabled:bool -> timeZone:string option -> profileBackgroundColor:JsonProvider+IntOrString -> location:string option -> profileBackgroundTile:bool -> profileImageUrlHttps:string -> defaultProfileImage:bool -> followRequestSent:JsonValue -> profileSidebarFillColor:JsonProvider+IntOrString -> description:string option -> favouritesCount:int -> screenName:string -> profileSidebarBorderColor:JsonProvider+IntOrString -> idStr:int -> verified:bool -> lang:string -> statusesCount:int -> profileUseBackgroundImage:bool -> protected:bool -> profileImageUrl:string -> listedCount:int -> geoEnabled:bool -> createdAt:string -> profileTextColor:JsonProvider+IntOrString -> name:string -> profileBackgroundImageUrl:string -> friendsCount:int -> url:string option -> id:int -> isTranslator:bool -> defaultProfile:bool -> following:JsonValue -> profileBackgroundImageUrlHttps:string -> utcOffset:int option -> profileLinkColor:JsonProvider+IntOrString -> followersCount:int -> profileBannerUrl:string option -> JsonProvider+User2 + JsonRuntime.CreateRecord([| ("notifications", + (notifications :> obj)) + ("contributors_enabled", + (contributorsEnabled :> obj)) + ("time_zone", + (timeZone :> obj)) + ("profile_background_color", + (profileBackgroundColor :> obj)) + ("location", + (location :> obj)) + ("profile_background_tile", + (profileBackgroundTile :> obj)) + ("profile_image_url_https", + (profileImageUrlHttps :> obj)) + ("default_profile_image", + (defaultProfileImage :> obj)) + ("follow_request_sent", + (followRequestSent :> obj)) + ("profile_sidebar_fill_color", + (profileSidebarFillColor :> obj)) + ("description", + (description :> obj)) + ("favourites_count", + (favouritesCount :> obj)) + ("screen_name", + (screenName :> obj)) + ("profile_sidebar_border_color", + (profileSidebarBorderColor :> obj)) + ("id_str", + (idStr :> obj)) + ("verified", + (verified :> obj)) + ("lang", + (lang :> obj)) + ("statuses_count", + (statusesCount :> obj)) + ("profile_use_background_image", + (profileUseBackgroundImage :> obj)) + ("protected", + (protected :> obj)) + ("profile_image_url", + (profileImageUrl :> obj)) + ("listed_count", + (listedCount :> obj)) + ("geo_enabled", + (geoEnabled :> obj)) + ("created_at", + (createdAt :> obj)) + ("profile_text_color", + (profileTextColor :> obj)) + ("name", + (name :> obj)) + ("profile_background_image_url", + (profileBackgroundImageUrl :> obj)) + ("friends_count", + (friendsCount :> obj)) + ("url", + (url :> obj)) + ("id", + (id :> obj)) + ("is_translator", + (isTranslator :> obj)) + ("default_profile", + (defaultProfile :> obj)) + ("following", + (following :> obj)) + ("profile_background_image_url_https", + (profileBackgroundImageUrlHttps :> obj)) + ("utc_offset", + (utcOffset :> obj)) + ("profile_link_color", + (profileLinkColor :> obj)) + ("followers_count", + (followersCount :> obj)) + ("profile_banner_url", + (profileBannerUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+User2 + JsonDocument.Create(jsonValue, "") + + member ContributorsEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "contributors_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CreatedAt: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_at") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member DefaultProfile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DefaultProfileImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "default_profile_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member FavouritesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "favourites_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FollowRequestSent: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "follow_request_sent") + + member FollowersCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "followers_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Following: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "following") + + member FriendsCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "friends_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member GeoEnabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "geo_enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IsTranslator: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_translator") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Lang: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lang") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ListedCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "listed_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Notifications: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "notifications") + + member ProfileBackgroundColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_background_color") + + member ProfileBackgroundImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileBackgroundTile: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_background_tile") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProfileBannerUrl: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "profile_banner_url")) + + member ProfileImageUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileImageUrlHttps: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_image_url_https") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ProfileLinkColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_link_color") + + member ProfileSidebarBorderColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_border_color") + + member ProfileSidebarFillColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_sidebar_fill_color") + + member ProfileTextColor: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "profile_text_color") + + member ProfileUseBackgroundImage: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "profile_use_background_image") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Protected: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "protected") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StatusesCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "statuses_count") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member TimeZone: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "time_zone")) + + member Url: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "url")) + + member UtcOffset: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "utc_offset")) + + member Verified: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "verified") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + +class JsonProvider+UserMention : FDR.BaseTypes.IJsonDocument + new : indices:int[] -> screenName:string -> idStr:int -> name:string -> id:int -> JsonProvider+UserMention + JsonRuntime.CreateRecord([| ("indices", + (indices :> obj)) + ("screen_name", + (screenName :> obj)) + ("id_str", + (idStr :> obj)) + ("name", + (name :> obj)) + ("id", + (id :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+UserMention + JsonDocument.Create(jsonValue, "") + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member IdStr: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id_str") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Indices: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "indices"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ScreenName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "screen_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Sizes : FDR.BaseTypes.IJsonDocument + new : thumb:JsonProvider+Thumb -> medium:JsonProvider+Thumb -> large:JsonProvider+Thumb -> small:JsonProvider+Thumb -> JsonProvider+Sizes + JsonRuntime.CreateRecord([| ("thumb", + (thumb :> obj)) + ("medium", + (medium :> obj)) + ("large", + (large :> obj)) + ("small", + (small :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Sizes + JsonDocument.Create(jsonValue, "") + + member Large: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "large") + + member Medium: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "medium") + + member Small: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "small") + + member Thumb: JsonProvider+Thumb with get + JsonRuntime.GetPropertyPacked(this, "thumb") + + +class JsonProvider+Thumb : FDR.BaseTypes.IJsonDocument + new : h:int -> w:int -> resize:string -> JsonProvider+Thumb + JsonRuntime.CreateRecord([| ("h", + (h :> obj)) + ("w", + (w :> obj)) + ("resize", + (resize :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Thumb + JsonDocument.Create(jsonValue, "") + + member H: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "h") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Resize: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "resize") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member W: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "w") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,False,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,False,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,False,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,False,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..cd9e99a9f --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,56 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TypeInference.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TypeInference.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : intLike:int -> boolLike1:bool -> boolLike2:bool -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("intLike", + (intLike :> obj)) + ("boolLike1", + (boolLike1 :> obj)) + ("boolLike2", + (boolLike2 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member BoolLike1: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "boolLike1") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member BoolLike2: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "boolLike2") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member IntLike: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "intLike") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..cd9e99a9f --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,56 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TypeInference.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TypeInference.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : intLike:int -> boolLike1:bool -> boolLike2:bool -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("intLike", + (intLike :> obj)) + ("boolLike1", + (boolLike1 :> obj)) + ("boolLike2", + (boolLike2 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member BoolLike1: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "boolLike1") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member BoolLike2: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "boolLike2") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member IntLike: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "intLike") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..cd9e99a9f --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,TypeInference.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,56 @@ +class JsonProvider : obj + static member AsyncGetSamples: () -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TypeInference.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Root[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSamples: () -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "TypeInference.json"))), new Func<_,_>(id))) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Root[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Root[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : intLike:int -> boolLike1:bool -> boolLike2:bool -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("intLike", + (intLike :> obj)) + ("boolLike1", + (boolLike1 :> obj)) + ("boolLike2", + (boolLike2 :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member BoolLike1: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "boolLike1") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member BoolLike2: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "boolLike2") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member IntLike: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "intLike") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..7377926e1 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,210 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Vindinium.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Vindinium.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : game:JsonProvider+Game -> hero:JsonProvider+Hero -> token:string -> viewUrl:string -> playUrl:string -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("game", + (game :> obj)) + ("hero", + (hero :> obj)) + ("token", + (token :> obj)) + ("viewUrl", + (viewUrl :> obj)) + ("playUrl", + (playUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Game: JsonProvider+Game with get + JsonRuntime.GetPropertyPacked(this, "game") + + member Hero: JsonProvider+Hero with get + JsonRuntime.GetPropertyPacked(this, "hero") + + member PlayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "playUrl") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Token: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "token") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ViewUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "viewUrl") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Game : FDR.BaseTypes.IJsonDocument + new : id:string -> turn:int -> maxTurns:int -> heroes:JsonProvider+JsonProvider+Hero[] -> board:JsonProvider+Board -> finished:bool -> JsonProvider+Game + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("turn", + (turn :> obj)) + ("maxTurns", + (maxTurns :> obj)) + ("heroes", + (heroes :> obj)) + ("board", + (board :> obj)) + ("finished", + (finished :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Game + JsonDocument.Create(jsonValue, "") + + member Board: JsonProvider+Board with get + JsonRuntime.GetPropertyPacked(this, "board") + + member Finished: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "finished") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Heroes: JsonProvider+JsonProvider+Hero[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "heroes"), new Func<_,_>(id))) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member MaxTurns: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "maxTurns") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Turn: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "turn") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Hero : FDR.BaseTypes.IJsonDocument + new : id:int -> name:string -> userId:string -> elo:int -> pos:JsonProvider+Pos -> life:int -> gold:int -> mineCount:int -> spawnPos:JsonProvider+Pos -> crashed:bool -> JsonProvider+Hero + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("name", + (name :> obj)) + ("userId", + (userId :> obj)) + ("elo", + (elo :> obj)) + ("pos", + (pos :> obj)) + ("life", + (life :> obj)) + ("gold", + (gold :> obj)) + ("mineCount", + (mineCount :> obj)) + ("spawnPos", + (spawnPos :> obj)) + ("crashed", + (crashed :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Hero + JsonDocument.Create(jsonValue, "") + + member Crashed: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "crashed") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Elo: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "elo") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Gold: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gold") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Life: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "life") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member MineCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "mineCount") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Pos: JsonProvider+Pos with get + JsonRuntime.GetPropertyPacked(this, "pos") + + member SpawnPos: JsonProvider+Pos with get + JsonRuntime.GetPropertyPacked(this, "spawnPos") + + member UserId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "userId") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Board : FDR.BaseTypes.IJsonDocument + new : size:int -> tiles:string -> JsonProvider+Board + JsonRuntime.CreateRecord([| ("size", + (size :> obj)) + ("tiles", + (tiles :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Board + JsonDocument.Create(jsonValue, "") + + member Size: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "size") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Tiles: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "tiles") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Pos : FDR.BaseTypes.IJsonDocument + new : x:int -> y:int -> JsonProvider+Pos + JsonRuntime.CreateRecord([| ("x", + (x :> obj)) + ("y", + (y :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Pos + JsonDocument.Create(jsonValue, "") + + member X: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "x") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Y: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "y") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..7377926e1 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,210 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Vindinium.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Vindinium.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : game:JsonProvider+Game -> hero:JsonProvider+Hero -> token:string -> viewUrl:string -> playUrl:string -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("game", + (game :> obj)) + ("hero", + (hero :> obj)) + ("token", + (token :> obj)) + ("viewUrl", + (viewUrl :> obj)) + ("playUrl", + (playUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Game: JsonProvider+Game with get + JsonRuntime.GetPropertyPacked(this, "game") + + member Hero: JsonProvider+Hero with get + JsonRuntime.GetPropertyPacked(this, "hero") + + member PlayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "playUrl") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Token: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "token") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ViewUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "viewUrl") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Game : FDR.BaseTypes.IJsonDocument + new : id:string -> turn:int -> maxTurns:int -> heroes:JsonProvider+JsonProvider+Hero[] -> board:JsonProvider+Board -> finished:bool -> JsonProvider+Game + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("turn", + (turn :> obj)) + ("maxTurns", + (maxTurns :> obj)) + ("heroes", + (heroes :> obj)) + ("board", + (board :> obj)) + ("finished", + (finished :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Game + JsonDocument.Create(jsonValue, "") + + member Board: JsonProvider+Board with get + JsonRuntime.GetPropertyPacked(this, "board") + + member Finished: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "finished") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Heroes: JsonProvider+JsonProvider+Hero[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "heroes"), new Func<_,_>(id))) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member MaxTurns: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "maxTurns") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Turn: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "turn") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Hero : FDR.BaseTypes.IJsonDocument + new : id:int -> name:string -> userId:string -> elo:int -> pos:JsonProvider+Pos -> life:int -> gold:int -> mineCount:int -> spawnPos:JsonProvider+Pos -> crashed:bool -> JsonProvider+Hero + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("name", + (name :> obj)) + ("userId", + (userId :> obj)) + ("elo", + (elo :> obj)) + ("pos", + (pos :> obj)) + ("life", + (life :> obj)) + ("gold", + (gold :> obj)) + ("mineCount", + (mineCount :> obj)) + ("spawnPos", + (spawnPos :> obj)) + ("crashed", + (crashed :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Hero + JsonDocument.Create(jsonValue, "") + + member Crashed: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "crashed") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Elo: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "elo") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Gold: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gold") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Life: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "life") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member MineCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "mineCount") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Pos: JsonProvider+Pos with get + JsonRuntime.GetPropertyPacked(this, "pos") + + member SpawnPos: JsonProvider+Pos with get + JsonRuntime.GetPropertyPacked(this, "spawnPos") + + member UserId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "userId") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Board : FDR.BaseTypes.IJsonDocument + new : size:int -> tiles:string -> JsonProvider+Board + JsonRuntime.CreateRecord([| ("size", + (size :> obj)) + ("tiles", + (tiles :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Board + JsonDocument.Create(jsonValue, "") + + member Size: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "size") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Tiles: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "tiles") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Pos : FDR.BaseTypes.IJsonDocument + new : x:int -> y:int -> JsonProvider+Pos + JsonRuntime.CreateRecord([| ("x", + (x :> obj)) + ("y", + (y :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Pos + JsonDocument.Create(jsonValue, "") + + member X: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "x") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Y: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "y") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..7377926e1 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,Vindinium.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,210 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Vindinium.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "Vindinium.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : game:JsonProvider+Game -> hero:JsonProvider+Hero -> token:string -> viewUrl:string -> playUrl:string -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("game", + (game :> obj)) + ("hero", + (hero :> obj)) + ("token", + (token :> obj)) + ("viewUrl", + (viewUrl :> obj)) + ("playUrl", + (playUrl :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Game: JsonProvider+Game with get + JsonRuntime.GetPropertyPacked(this, "game") + + member Hero: JsonProvider+Hero with get + JsonRuntime.GetPropertyPacked(this, "hero") + + member PlayUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "playUrl") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Token: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "token") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ViewUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "viewUrl") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Game : FDR.BaseTypes.IJsonDocument + new : id:string -> turn:int -> maxTurns:int -> heroes:JsonProvider+JsonProvider+Hero[] -> board:JsonProvider+Board -> finished:bool -> JsonProvider+Game + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("turn", + (turn :> obj)) + ("maxTurns", + (maxTurns :> obj)) + ("heroes", + (heroes :> obj)) + ("board", + (board :> obj)) + ("finished", + (finished :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Game + JsonDocument.Create(jsonValue, "") + + member Board: JsonProvider+Board with get + JsonRuntime.GetPropertyPacked(this, "board") + + member Finished: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "finished") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Heroes: JsonProvider+JsonProvider+Hero[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "heroes"), new Func<_,_>(id))) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member MaxTurns: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "maxTurns") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Turn: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "turn") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Hero : FDR.BaseTypes.IJsonDocument + new : id:int -> name:string -> userId:string -> elo:int -> pos:JsonProvider+Pos -> life:int -> gold:int -> mineCount:int -> spawnPos:JsonProvider+Pos -> crashed:bool -> JsonProvider+Hero + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("name", + (name :> obj)) + ("userId", + (userId :> obj)) + ("elo", + (elo :> obj)) + ("pos", + (pos :> obj)) + ("life", + (life :> obj)) + ("gold", + (gold :> obj)) + ("mineCount", + (mineCount :> obj)) + ("spawnPos", + (spawnPos :> obj)) + ("crashed", + (crashed :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Hero + JsonDocument.Create(jsonValue, "") + + member Crashed: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "crashed") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Elo: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "elo") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Gold: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gold") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Life: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "life") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member MineCount: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "mineCount") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Pos: JsonProvider+Pos with get + JsonRuntime.GetPropertyPacked(this, "pos") + + member SpawnPos: JsonProvider+Pos with get + JsonRuntime.GetPropertyPacked(this, "spawnPos") + + member UserId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "userId") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Board : FDR.BaseTypes.IJsonDocument + new : size:int -> tiles:string -> JsonProvider+Board + JsonRuntime.CreateRecord([| ("size", + (size :> obj)) + ("tiles", + (tiles :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Board + JsonDocument.Create(jsonValue, "") + + member Size: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "size") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Tiles: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "tiles") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Pos : FDR.BaseTypes.IJsonDocument + new : x:int -> y:int -> JsonProvider+Pos + JsonRuntime.CreateRecord([| ("x", + (x :> obj)) + ("y", + (y :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Pos + JsonDocument.Create(jsonValue, "") + + member X: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "x") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Y: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "y") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..1947d86ac --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,92 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WikiData.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WikiData.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : firstName:string -> lastName:string -> age:int -> address:JsonProvider+Address -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("firstName", + (firstName :> obj)) + ("lastName", + (lastName :> obj)) + ("age", + (age :> obj)) + ("address", + (address :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Address: JsonProvider+Address with get + JsonRuntime.GetPropertyPacked(this, "address") + + member Age: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "age") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FirstName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "firstName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LastName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lastName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Address : FDR.BaseTypes.IJsonDocument + new : streetAddress:string -> city:string -> state:string -> postalCode:int -> JsonProvider+Address + JsonRuntime.CreateRecord([| ("streetAddress", + (streetAddress :> obj)) + ("city", + (city :> obj)) + ("state", + (state :> obj)) + ("postalCode", + (postalCode :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Address + JsonDocument.Create(jsonValue, "") + + member City: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "city") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PostalCode: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "postalCode") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member State: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "state") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StreetAddress: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "streetAddress") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..1947d86ac --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,92 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WikiData.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WikiData.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : firstName:string -> lastName:string -> age:int -> address:JsonProvider+Address -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("firstName", + (firstName :> obj)) + ("lastName", + (lastName :> obj)) + ("age", + (age :> obj)) + ("address", + (address :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Address: JsonProvider+Address with get + JsonRuntime.GetPropertyPacked(this, "address") + + member Age: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "age") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FirstName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "firstName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LastName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lastName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Address : FDR.BaseTypes.IJsonDocument + new : streetAddress:string -> city:string -> state:string -> postalCode:int -> JsonProvider+Address + JsonRuntime.CreateRecord([| ("streetAddress", + (streetAddress :> obj)) + ("city", + (city :> obj)) + ("state", + (state :> obj)) + ("postalCode", + (postalCode :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Address + JsonDocument.Create(jsonValue, "") + + member City: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "city") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PostalCode: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "postalCode") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member State: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "state") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StreetAddress: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "streetAddress") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..1947d86ac --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WikiData.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,92 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WikiData.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WikiData.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : firstName:string -> lastName:string -> age:int -> address:JsonProvider+Address -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("firstName", + (firstName :> obj)) + ("lastName", + (lastName :> obj)) + ("age", + (age :> obj)) + ("address", + (address :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Address: JsonProvider+Address with get + JsonRuntime.GetPropertyPacked(this, "address") + + member Age: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "age") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member FirstName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "firstName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LastName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "lastName") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Address : FDR.BaseTypes.IJsonDocument + new : streetAddress:string -> city:string -> state:string -> postalCode:int -> JsonProvider+Address + JsonRuntime.CreateRecord([| ("streetAddress", + (streetAddress :> obj)) + ("city", + (city :> obj)) + ("state", + (state :> obj)) + ("postalCode", + (postalCode :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Address + JsonDocument.Create(jsonValue, "") + + member City: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "city") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PostalCode: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "postalCode") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member State: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "state") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member StreetAddress: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "streetAddress") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..12a9ebf3c --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,130 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+WorldBank async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WorldBank.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+WorldBank async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+WorldBank + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WorldBank.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+WorldBank + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+WorldBank + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+WorldBank + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+WorldBank + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+WorldBank + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+WorldBank[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+WorldBank : FDR.BaseTypes.IJsonDocument + new : array:JsonProvider+JsonProvider+Record[] -> record:JsonProvider+Record2 -> JsonProvider+WorldBank + JsonRuntime.CreateArray([| (array :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+WorldBank + JsonDocument.Create(jsonValue, "") + + member Array: JsonProvider+JsonProvider+Record[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetArrayChildByTypeTag(this, "", "Array"), new Func<_,_>(id))) + + member Record: JsonProvider+Record2 with get + JsonRuntime.GetArrayChildByTypeTag(this, "", "Record") + + +class JsonProvider+Record : FDR.BaseTypes.IJsonDocument + new : indicator:JsonProvider+Indicator -> country:JsonProvider+Indicator -> value:decimal option -> decimal:int -> date:int -> JsonProvider+Record + JsonRuntime.CreateRecord([| ("indicator", + (indicator :> obj)) + ("country", + (country :> obj)) + ("value", + (value :> obj)) + ("decimal", + (decimal :> obj)) + ("date", + (date :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Record + JsonDocument.Create(jsonValue, "") + + member Country: JsonProvider+Indicator with get + JsonRuntime.GetPropertyPacked(this, "country") + + member Date: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "date") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Decimal: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "decimal") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Indicator: JsonProvider+Indicator with get + JsonRuntime.GetPropertyPacked(this, "indicator") + + member Value: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "value")) + + +class JsonProvider+Record2 : FDR.BaseTypes.IJsonDocument + new : page:int -> pages:int -> perPage:int -> total:int -> JsonProvider+Record2 + JsonRuntime.CreateRecord([| ("page", + (page :> obj)) + ("pages", + (pages :> obj)) + ("per_page", + (perPage :> obj)) + ("total", + (total :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Record2 + JsonDocument.Create(jsonValue, "") + + member Page: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "page") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Pages: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "pages") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member PerPage: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "per_page") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Total: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "total") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Indicator : FDR.BaseTypes.IJsonDocument + new : id:string -> value:string -> JsonProvider+Indicator + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("value", + (value :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Indicator + JsonDocument.Create(jsonValue, "") + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Value: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "value") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..12a9ebf3c --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,130 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+WorldBank async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WorldBank.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+WorldBank async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+WorldBank + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WorldBank.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+WorldBank + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+WorldBank + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+WorldBank + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+WorldBank + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+WorldBank + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+WorldBank[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+WorldBank : FDR.BaseTypes.IJsonDocument + new : array:JsonProvider+JsonProvider+Record[] -> record:JsonProvider+Record2 -> JsonProvider+WorldBank + JsonRuntime.CreateArray([| (array :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+WorldBank + JsonDocument.Create(jsonValue, "") + + member Array: JsonProvider+JsonProvider+Record[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetArrayChildByTypeTag(this, "", "Array"), new Func<_,_>(id))) + + member Record: JsonProvider+Record2 with get + JsonRuntime.GetArrayChildByTypeTag(this, "", "Record") + + +class JsonProvider+Record : FDR.BaseTypes.IJsonDocument + new : indicator:JsonProvider+Indicator -> country:JsonProvider+Indicator -> value:decimal option -> decimal:int -> date:int -> JsonProvider+Record + JsonRuntime.CreateRecord([| ("indicator", + (indicator :> obj)) + ("country", + (country :> obj)) + ("value", + (value :> obj)) + ("decimal", + (decimal :> obj)) + ("date", + (date :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Record + JsonDocument.Create(jsonValue, "") + + member Country: JsonProvider+Indicator with get + JsonRuntime.GetPropertyPacked(this, "country") + + member Date: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "date") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Decimal: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "decimal") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Indicator: JsonProvider+Indicator with get + JsonRuntime.GetPropertyPacked(this, "indicator") + + member Value: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "value")) + + +class JsonProvider+Record2 : FDR.BaseTypes.IJsonDocument + new : page:int -> pages:int -> perPage:int -> total:int -> JsonProvider+Record2 + JsonRuntime.CreateRecord([| ("page", + (page :> obj)) + ("pages", + (pages :> obj)) + ("per_page", + (perPage :> obj)) + ("total", + (total :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Record2 + JsonDocument.Create(jsonValue, "") + + member Page: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "page") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Pages: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "pages") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member PerPage: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "per_page") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Total: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "total") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Indicator : FDR.BaseTypes.IJsonDocument + new : id:string -> value:string -> JsonProvider+Indicator + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("value", + (value :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Indicator + JsonDocument.Create(jsonValue, "") + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Value: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "value") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..12a9ebf3c --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,WorldBank.json,False,WorldBank,,True,False,ValuesOnly.expected @@ -0,0 +1,130 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+WorldBank async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WorldBank.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+WorldBank async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+WorldBank + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "WorldBank.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+WorldBank + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+WorldBank + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+WorldBank + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+WorldBank + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+WorldBank + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+WorldBank[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+WorldBank : FDR.BaseTypes.IJsonDocument + new : array:JsonProvider+JsonProvider+Record[] -> record:JsonProvider+Record2 -> JsonProvider+WorldBank + JsonRuntime.CreateArray([| (array :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+WorldBank + JsonDocument.Create(jsonValue, "") + + member Array: JsonProvider+JsonProvider+Record[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetArrayChildByTypeTag(this, "", "Array"), new Func<_,_>(id))) + + member Record: JsonProvider+Record2 with get + JsonRuntime.GetArrayChildByTypeTag(this, "", "Record") + + +class JsonProvider+Record : FDR.BaseTypes.IJsonDocument + new : indicator:JsonProvider+Indicator -> country:JsonProvider+Indicator -> value:decimal option -> decimal:int -> date:int -> JsonProvider+Record + JsonRuntime.CreateRecord([| ("indicator", + (indicator :> obj)) + ("country", + (country :> obj)) + ("value", + (value :> obj)) + ("decimal", + (decimal :> obj)) + ("date", + (date :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Record + JsonDocument.Create(jsonValue, "") + + member Country: JsonProvider+Indicator with get + JsonRuntime.GetPropertyPacked(this, "country") + + member Date: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "date") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Decimal: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "decimal") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Indicator: JsonProvider+Indicator with get + JsonRuntime.GetPropertyPacked(this, "indicator") + + member Value: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "value")) + + +class JsonProvider+Record2 : FDR.BaseTypes.IJsonDocument + new : page:int -> pages:int -> perPage:int -> total:int -> JsonProvider+Record2 + JsonRuntime.CreateRecord([| ("page", + (page :> obj)) + ("pages", + (pages :> obj)) + ("per_page", + (perPage :> obj)) + ("total", + (total :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Record2 + JsonDocument.Create(jsonValue, "") + + member Page: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "page") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Pages: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "pages") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member PerPage: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "per_page") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Total: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "total") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Indicator : FDR.BaseTypes.IJsonDocument + new : id:string -> value:string -> JsonProvider+Indicator + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("value", + (value :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Indicator + JsonDocument.Create(jsonValue, "") + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Value: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "value") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..2bc3a204d --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,104 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "contacts.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "contacts.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : ab:JsonProvider+Ab -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("ab", + (ab :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Ab: JsonProvider+Ab with get + JsonRuntime.GetPropertyPacked(this, "ab") + + +class JsonProvider+Ab : FDR.BaseTypes.IJsonDocument + new : persons:JsonProvider+JsonProvider+Person[] -> JsonProvider+Ab + JsonRuntime.CreateRecord([| ("persons", + (persons :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Ab + JsonDocument.Create(jsonValue, "") + + member Persons: JsonProvider+JsonProvider+Person[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "persons"), new Func<_,_>(id))) + + +class JsonProvider+Person : FDR.BaseTypes.IJsonDocument + new : contacts:JsonProvider+JsonProvider+Contact[] -> emails:JsonValue[] -> phones:JsonValue[] -> JsonProvider+Person + JsonRuntime.CreateRecord([| ("contacts", + (contacts :> obj)) + ("emails", + (emails :> obj)) + ("phones", + (phones :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Person + JsonDocument.Create(jsonValue, "") + + member Contacts: JsonProvider+JsonProvider+Contact[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "contacts"), new Func<_,_>(id))) + + member Emails: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emails"), new Func<_,_>(id))) + + member Phones: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "phones"), new Func<_,_>(id))) + + +class JsonProvider+Contact : FDR.BaseTypes.IJsonDocument + new : emailCapability:int[] -> emailImEnabled:bool[] -> emails:string[] -> phones:JsonValue[] -> JsonProvider+Contact + JsonRuntime.CreateRecord([| ("emailCapability", + (emailCapability :> obj)) + ("emailIMEnabled", + (emailImEnabled :> obj)) + ("emails", + (emails :> obj)) + ("phones", + (phones :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Contact + JsonDocument.Create(jsonValue, "") + + member EmailCapability: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emailCapability"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member EmailImEnabled: bool[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emailIMEnabled"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Emails: string[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emails"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + member Phones: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "phones"), new Func<_,_>(id))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..2bc3a204d --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,104 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "contacts.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "contacts.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : ab:JsonProvider+Ab -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("ab", + (ab :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Ab: JsonProvider+Ab with get + JsonRuntime.GetPropertyPacked(this, "ab") + + +class JsonProvider+Ab : FDR.BaseTypes.IJsonDocument + new : persons:JsonProvider+JsonProvider+Person[] -> JsonProvider+Ab + JsonRuntime.CreateRecord([| ("persons", + (persons :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Ab + JsonDocument.Create(jsonValue, "") + + member Persons: JsonProvider+JsonProvider+Person[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "persons"), new Func<_,_>(id))) + + +class JsonProvider+Person : FDR.BaseTypes.IJsonDocument + new : contacts:JsonProvider+JsonProvider+Contact[] -> emails:JsonValue[] -> phones:JsonValue[] -> JsonProvider+Person + JsonRuntime.CreateRecord([| ("contacts", + (contacts :> obj)) + ("emails", + (emails :> obj)) + ("phones", + (phones :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Person + JsonDocument.Create(jsonValue, "") + + member Contacts: JsonProvider+JsonProvider+Contact[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "contacts"), new Func<_,_>(id))) + + member Emails: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emails"), new Func<_,_>(id))) + + member Phones: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "phones"), new Func<_,_>(id))) + + +class JsonProvider+Contact : FDR.BaseTypes.IJsonDocument + new : emailCapability:int[] -> emailImEnabled:bool[] -> emails:string[] -> phones:JsonValue[] -> JsonProvider+Contact + JsonRuntime.CreateRecord([| ("emailCapability", + (emailCapability :> obj)) + ("emailIMEnabled", + (emailImEnabled :> obj)) + ("emails", + (emails :> obj)) + ("phones", + (phones :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Contact + JsonDocument.Create(jsonValue, "") + + member EmailCapability: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emailCapability"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member EmailImEnabled: bool[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emailIMEnabled"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Emails: string[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emails"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + member Phones: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "phones"), new Func<_,_>(id))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..2bc3a204d --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,contacts.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,104 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "contacts.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "contacts.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : ab:JsonProvider+Ab -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("ab", + (ab :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Ab: JsonProvider+Ab with get + JsonRuntime.GetPropertyPacked(this, "ab") + + +class JsonProvider+Ab : FDR.BaseTypes.IJsonDocument + new : persons:JsonProvider+JsonProvider+Person[] -> JsonProvider+Ab + JsonRuntime.CreateRecord([| ("persons", + (persons :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Ab + JsonDocument.Create(jsonValue, "") + + member Persons: JsonProvider+JsonProvider+Person[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "persons"), new Func<_,_>(id))) + + +class JsonProvider+Person : FDR.BaseTypes.IJsonDocument + new : contacts:JsonProvider+JsonProvider+Contact[] -> emails:JsonValue[] -> phones:JsonValue[] -> JsonProvider+Person + JsonRuntime.CreateRecord([| ("contacts", + (contacts :> obj)) + ("emails", + (emails :> obj)) + ("phones", + (phones :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Person + JsonDocument.Create(jsonValue, "") + + member Contacts: JsonProvider+JsonProvider+Contact[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "contacts"), new Func<_,_>(id))) + + member Emails: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emails"), new Func<_,_>(id))) + + member Phones: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "phones"), new Func<_,_>(id))) + + +class JsonProvider+Contact : FDR.BaseTypes.IJsonDocument + new : emailCapability:int[] -> emailImEnabled:bool[] -> emails:string[] -> phones:JsonValue[] -> JsonProvider+Contact + JsonRuntime.CreateRecord([| ("emailCapability", + (emailCapability :> obj)) + ("emailIMEnabled", + (emailImEnabled :> obj)) + ("emails", + (emails :> obj)) + ("phones", + (phones :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Contact + JsonDocument.Create(jsonValue, "") + + member EmailCapability: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emailCapability"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member EmailImEnabled: bool[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emailIMEnabled"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Emails: string[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emails"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + member Phones: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "phones"), new Func<_,_>(id))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..b14805327 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,416 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "optionals.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "optionals.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : recordProperty:JsonProvider+RecordProperty -> nullProperty:JsonValue -> emptyStringProperty:JsonValue -> emptyArrayProperty:JsonValue[] -> oneElementArrayProperty:int[] -> multipleElementsArrayProperty:int[] -> arrayOfObjects:JsonProvider+JsonProvider+ArrayOfObject[] -> optionalPrimitives:JsonProvider+JsonProvider+OptionalPrimitive[] -> optionalRecords:JsonProvider+JsonProvider+OptionalRecord[] -> heterogeneousArray:JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray -> heterogeneousRecords:JsonProvider+JsonProvider+HeterogeneousRecord[] -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("recordProperty", + (recordProperty :> obj)) + ("nullProperty", + (nullProperty :> obj)) + ("emptyStringProperty", + (emptyStringProperty :> obj)) + ("emptyArrayProperty", + (emptyArrayProperty :> obj)) + ("oneElementArrayProperty", + (oneElementArrayProperty :> obj)) + ("multipleElementsArrayProperty", + (multipleElementsArrayProperty :> obj)) + ("arrayOfObjects", + (arrayOfObjects :> obj)) + ("optionalPrimitives", + (optionalPrimitives :> obj)) + ("optionalRecords", + (optionalRecords :> obj)) + ("heterogeneousArray", + (heterogeneousArray :> obj)) + ("heterogeneousRecords", + (heterogeneousRecords :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member ArrayOfObjects: JsonProvider+JsonProvider+ArrayOfObject[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "arrayOfObjects"), new Func<_,_>(id))) + + member EmptyArrayProperty: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emptyArrayProperty"), new Func<_,_>(id))) + + member EmptyStringProperty: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "emptyStringProperty") + + member HeterogeneousArray: JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousArray") + + member HeterogeneousRecords: JsonProvider+JsonProvider+HeterogeneousRecord[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousRecords"), new Func<_,_>(id))) + + member MultipleElementsArrayProperty: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "multipleElementsArrayProperty"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member NullProperty: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "nullProperty") + + member OneElementArrayProperty: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "oneElementArrayProperty"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member OptionalPrimitives: JsonProvider+JsonProvider+OptionalPrimitive[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "optionalPrimitives"), new Func<_,_>(id))) + + member OptionalRecords: JsonProvider+JsonProvider+OptionalRecord[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "optionalRecords"), new Func<_,_>(id))) + + member RecordProperty: JsonProvider+RecordProperty with get + JsonRuntime.GetPropertyPacked(this, "recordProperty") + + +class JsonProvider+ArrayOfObject : FDR.BaseTypes.IJsonDocument + new : heterogeneousArrayProperty:JsonProvider+NumbersOrBooleanOrString -> heterogeneousProperty:JsonProvider+IntOrBooleanOrDateTime -> heterogeneousOptionalProperty:JsonProvider+IntOrBoolean -> JsonProvider+ArrayOfObject + JsonRuntime.CreateRecord([| ("heterogeneousArrayProperty", + (heterogeneousArrayProperty :> obj)) + ("heterogeneousProperty", + (heterogeneousProperty :> obj)) + ("heterogeneousOptionalProperty", + (heterogeneousOptionalProperty :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+ArrayOfObject + JsonDocument.Create(jsonValue, "") + + member HeterogeneousArrayProperty: JsonProvider+NumbersOrBooleanOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousArrayProperty") + + member HeterogeneousOptionalProperty: JsonProvider+IntOrBoolean with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousOptionalProperty") + + member HeterogeneousProperty: JsonProvider+IntOrBooleanOrDateTime with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousProperty") + + +class JsonProvider+HeterogeneousRecord : FDR.BaseTypes.IJsonDocument + new : b:JsonProvider+IntOrBooleanOrArrayOrB -> JsonProvider+HeterogeneousRecord + JsonRuntime.CreateRecord([| ("b", + (b :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+HeterogeneousRecord + JsonDocument.Create(jsonValue, "") + + member B: JsonProvider+IntOrBooleanOrArrayOrB with get + JsonRuntime.GetPropertyPackedOrNull(this, "b") + + +class JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray : FDR.BaseTypes.IJsonDocument + new : number:int -> boolean:bool -> arrays:JsonProvider+JsonProvider+NumbersOrBooleanOrHeterogeneousArray[] -> record:JsonProvider+OptionalBecauseMissing -> JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray + JsonRuntime.CreateArray([| (number :> obj) + (boolean :> obj) + (arrays :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray + JsonDocument.Create(jsonValue, "") + + member Arrays: JsonProvider+JsonProvider+NumbersOrBooleanOrHeterogeneousArray[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Array", new Func<_,_>(id))) + + member Boolean: bool with get + let value = JsonRuntime.GetArrayChildByTypeTag(this, "", "Boolean") + JsonRuntime.GetNonOptionalValue(value.Path(), JsonRuntime.ConvertBoolean(Some value.JsonValue), Some value.JsonValue) + + member Number: int with get + let value = JsonRuntime.GetArrayChildByTypeTag(this, "", "Number") + JsonRuntime.GetNonOptionalValue(value.Path(), JsonRuntime.ConvertInteger("", Some value.JsonValue), Some value.JsonValue) + + member Record: JsonProvider+OptionalBecauseMissing with get + JsonRuntime.GetArrayChildByTypeTag(this, "", "Record@heterogeneousArray") + + +class JsonProvider+OptionalPrimitive : FDR.BaseTypes.IJsonDocument + new : optionalBecauseMissing:int option -> optionalBecauseNull:int option -> optionalBecauseEmptyString:int option -> notOptional:int -> nullNotOptional:JsonValue -> JsonProvider+OptionalPrimitive + JsonRuntime.CreateRecord([| ("optionalBecauseMissing", + (optionalBecauseMissing :> obj)) + ("optionalBecauseNull", + (optionalBecauseNull :> obj)) + ("optionalBecauseEmptyString", + (optionalBecauseEmptyString :> obj)) + ("notOptional", + (notOptional :> obj)) + ("nullNotOptional", + (nullNotOptional :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+OptionalPrimitive + JsonDocument.Create(jsonValue, "") + + member NotOptional: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "notOptional") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member NullNotOptional: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "nullNotOptional") + + member OptionalBecauseEmptyString: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "optionalBecauseEmptyString")) + + member OptionalBecauseMissing: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "optionalBecauseMissing")) + + member OptionalBecauseNull: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "optionalBecauseNull")) + + +class JsonProvider+OptionalRecord : FDR.BaseTypes.IJsonDocument + new : optionalBecauseMissing:JsonProvider+OptionalBecauseMissing option -> optionalBecauseNull:JsonProvider+OptionalBecauseMissing option -> optionalBecauseEmptyString:JsonProvider+OptionalBecauseMissing option -> notOptional:JsonProvider+OptionalBecauseMissing -> JsonProvider+OptionalRecord + JsonRuntime.CreateRecord([| ("optionalBecauseMissing", + (optionalBecauseMissing :> obj)) + ("optionalBecauseNull", + (optionalBecauseNull :> obj)) + ("optionalBecauseEmptyString", + (optionalBecauseEmptyString :> obj)) + ("notOptional", + (notOptional :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+OptionalRecord + JsonDocument.Create(jsonValue, "") + + member NotOptional: JsonProvider+OptionalBecauseMissing with get + JsonRuntime.GetPropertyPacked(this, "notOptional") + + member OptionalBecauseEmptyString: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetPropertyPacked(this, "optionalBecauseEmptyString") + + member OptionalBecauseMissing: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetPropertyPacked(this, "optionalBecauseMissing") + + member OptionalBecauseNull: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetPropertyPacked(this, "optionalBecauseNull") + + +class JsonProvider+RecordProperty : FDR.BaseTypes.IJsonDocument + new : stringProperty:string -> intProperty:int -> int64Property:int64 -> decimalProperty:decimal -> floatProperty:float -> boolProperty:bool -> dateProperty:System.DateTime -> guidProperty:System.Guid -> JsonProvider+RecordProperty + JsonRuntime.CreateRecord([| ("stringProperty", + (stringProperty :> obj)) + ("intProperty", + (intProperty :> obj)) + ("int64Property", + (int64Property :> obj)) + ("decimalProperty", + (decimalProperty :> obj)) + ("floatProperty", + (floatProperty :> obj)) + ("boolProperty", + (boolProperty :> obj)) + ("dateProperty", + (dateProperty :> obj)) + ("guidProperty", + (guidProperty :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+RecordProperty + JsonDocument.Create(jsonValue, "") + + member BoolProperty: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "boolProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DateProperty: System.DateTime with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "dateProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTime("", value.JsonOpt), value.JsonOpt) + + member DecimalProperty: decimal with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "decimalProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDecimal("", value.JsonOpt), value.JsonOpt) + + member FloatProperty: float with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "floatProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertFloat("", "", value.JsonOpt), value.JsonOpt) + + member GuidProperty: System.Guid with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "guidProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertGuid(value.JsonOpt), value.JsonOpt) + + member Int64Property: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "int64Property") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IntProperty: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "intProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member StringProperty: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "stringProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+IntOrBoolean : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrBoolean + JsonRuntime.CreateValue((number :> obj), "") + + new : boolean:bool -> JsonProvider+IntOrBoolean + JsonRuntime.CreateValue((boolean :> obj), "") + + new : () -> JsonProvider+IntOrBoolean + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBoolean + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+IntOrBooleanOrArrayOrB : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((number :> obj), "") + + new : boolean:bool -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((boolean :> obj), "") + + new : array:JsonProvider+NumbersOrBooleanOrB -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((array :> obj), "") + + new : record:JsonProvider+OptionalBecauseMissing -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((record :> obj), "") + + new : () -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBooleanOrArrayOrB + JsonDocument.Create(jsonValue, "") + + member Array: JsonProvider+NumbersOrBooleanOrB option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Array", new Func<_,_>(id))) + + member Boolean: bool option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Record: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Record@b", new Func<_,_>(id))) + + +class JsonProvider+IntOrBooleanOrDateTime : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue((number :> obj), "") + + new : boolean:bool -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue((boolean :> obj), "") + + new : dateTime:System.DateTime -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue((dateTime :> obj), "") + + new : () -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBooleanOrDateTime + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member DateTime: System.DateTime option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "DateTime", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDateTime("", Some t.JsonValue), Some t.JsonValue))) + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+NumbersOrBooleanOrHeterogeneousArray : FDR.BaseTypes.IJsonDocument + new : numbers:int[] -> boolean:bool option -> record:JsonProvider+OptionalBecauseMissing option -> JsonProvider+NumbersOrBooleanOrHeterogeneousArray + JsonRuntime.CreateArray([| (numbers :> obj) + (boolean :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+NumbersOrBooleanOrHeterogeneousArray + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Numbers: int[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Record: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Record@heterogeneousArray", new Func<_,_>(id))) + + +class JsonProvider+NumbersOrBooleanOrString : FDR.BaseTypes.IJsonDocument + new : numbers:int[] -> boolean:bool -> string:string option -> JsonProvider+NumbersOrBooleanOrString + JsonRuntime.CreateArray([| (numbers :> obj) + (boolean :> obj) + (string :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+NumbersOrBooleanOrString + JsonDocument.Create(jsonValue, "") + + member Boolean: bool with get + let value = JsonRuntime.GetArrayChildByTypeTag(this, "", "Boolean") + JsonRuntime.GetNonOptionalValue(value.Path(), JsonRuntime.ConvertBoolean(Some value.JsonValue), Some value.JsonValue) + + member Numbers: int[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+OptionalBecauseMissing : FDR.BaseTypes.IJsonDocument + new : a:int -> JsonProvider+OptionalBecauseMissing + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+OptionalBecauseMissing + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+NumbersOrBooleanOrB : FDR.BaseTypes.IJsonDocument + new : numbers:int[] -> boolean:bool option -> record:JsonProvider+OptionalBecauseMissing option -> JsonProvider+NumbersOrBooleanOrB + JsonRuntime.CreateArray([| (numbers :> obj) + (boolean :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+NumbersOrBooleanOrB + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Numbers: int[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Record: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Record@b", new Func<_,_>(id))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..b14805327 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,416 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "optionals.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "optionals.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : recordProperty:JsonProvider+RecordProperty -> nullProperty:JsonValue -> emptyStringProperty:JsonValue -> emptyArrayProperty:JsonValue[] -> oneElementArrayProperty:int[] -> multipleElementsArrayProperty:int[] -> arrayOfObjects:JsonProvider+JsonProvider+ArrayOfObject[] -> optionalPrimitives:JsonProvider+JsonProvider+OptionalPrimitive[] -> optionalRecords:JsonProvider+JsonProvider+OptionalRecord[] -> heterogeneousArray:JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray -> heterogeneousRecords:JsonProvider+JsonProvider+HeterogeneousRecord[] -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("recordProperty", + (recordProperty :> obj)) + ("nullProperty", + (nullProperty :> obj)) + ("emptyStringProperty", + (emptyStringProperty :> obj)) + ("emptyArrayProperty", + (emptyArrayProperty :> obj)) + ("oneElementArrayProperty", + (oneElementArrayProperty :> obj)) + ("multipleElementsArrayProperty", + (multipleElementsArrayProperty :> obj)) + ("arrayOfObjects", + (arrayOfObjects :> obj)) + ("optionalPrimitives", + (optionalPrimitives :> obj)) + ("optionalRecords", + (optionalRecords :> obj)) + ("heterogeneousArray", + (heterogeneousArray :> obj)) + ("heterogeneousRecords", + (heterogeneousRecords :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member ArrayOfObjects: JsonProvider+JsonProvider+ArrayOfObject[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "arrayOfObjects"), new Func<_,_>(id))) + + member EmptyArrayProperty: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emptyArrayProperty"), new Func<_,_>(id))) + + member EmptyStringProperty: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "emptyStringProperty") + + member HeterogeneousArray: JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousArray") + + member HeterogeneousRecords: JsonProvider+JsonProvider+HeterogeneousRecord[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousRecords"), new Func<_,_>(id))) + + member MultipleElementsArrayProperty: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "multipleElementsArrayProperty"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member NullProperty: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "nullProperty") + + member OneElementArrayProperty: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "oneElementArrayProperty"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member OptionalPrimitives: JsonProvider+JsonProvider+OptionalPrimitive[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "optionalPrimitives"), new Func<_,_>(id))) + + member OptionalRecords: JsonProvider+JsonProvider+OptionalRecord[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "optionalRecords"), new Func<_,_>(id))) + + member RecordProperty: JsonProvider+RecordProperty with get + JsonRuntime.GetPropertyPacked(this, "recordProperty") + + +class JsonProvider+ArrayOfObject : FDR.BaseTypes.IJsonDocument + new : heterogeneousArrayProperty:JsonProvider+NumbersOrBooleanOrString -> heterogeneousProperty:JsonProvider+IntOrBooleanOrDateTime -> heterogeneousOptionalProperty:JsonProvider+IntOrBoolean -> JsonProvider+ArrayOfObject + JsonRuntime.CreateRecord([| ("heterogeneousArrayProperty", + (heterogeneousArrayProperty :> obj)) + ("heterogeneousProperty", + (heterogeneousProperty :> obj)) + ("heterogeneousOptionalProperty", + (heterogeneousOptionalProperty :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+ArrayOfObject + JsonDocument.Create(jsonValue, "") + + member HeterogeneousArrayProperty: JsonProvider+NumbersOrBooleanOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousArrayProperty") + + member HeterogeneousOptionalProperty: JsonProvider+IntOrBoolean with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousOptionalProperty") + + member HeterogeneousProperty: JsonProvider+IntOrBooleanOrDateTime with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousProperty") + + +class JsonProvider+HeterogeneousRecord : FDR.BaseTypes.IJsonDocument + new : b:JsonProvider+IntOrBooleanOrArrayOrB -> JsonProvider+HeterogeneousRecord + JsonRuntime.CreateRecord([| ("b", + (b :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+HeterogeneousRecord + JsonDocument.Create(jsonValue, "") + + member B: JsonProvider+IntOrBooleanOrArrayOrB with get + JsonRuntime.GetPropertyPackedOrNull(this, "b") + + +class JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray : FDR.BaseTypes.IJsonDocument + new : number:int -> boolean:bool -> arrays:JsonProvider+JsonProvider+NumbersOrBooleanOrHeterogeneousArray[] -> record:JsonProvider+OptionalBecauseMissing -> JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray + JsonRuntime.CreateArray([| (number :> obj) + (boolean :> obj) + (arrays :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray + JsonDocument.Create(jsonValue, "") + + member Arrays: JsonProvider+JsonProvider+NumbersOrBooleanOrHeterogeneousArray[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Array", new Func<_,_>(id))) + + member Boolean: bool with get + let value = JsonRuntime.GetArrayChildByTypeTag(this, "", "Boolean") + JsonRuntime.GetNonOptionalValue(value.Path(), JsonRuntime.ConvertBoolean(Some value.JsonValue), Some value.JsonValue) + + member Number: int with get + let value = JsonRuntime.GetArrayChildByTypeTag(this, "", "Number") + JsonRuntime.GetNonOptionalValue(value.Path(), JsonRuntime.ConvertInteger("", Some value.JsonValue), Some value.JsonValue) + + member Record: JsonProvider+OptionalBecauseMissing with get + JsonRuntime.GetArrayChildByTypeTag(this, "", "Record@heterogeneousArray") + + +class JsonProvider+OptionalPrimitive : FDR.BaseTypes.IJsonDocument + new : optionalBecauseMissing:int option -> optionalBecauseNull:int option -> optionalBecauseEmptyString:int option -> notOptional:int -> nullNotOptional:JsonValue -> JsonProvider+OptionalPrimitive + JsonRuntime.CreateRecord([| ("optionalBecauseMissing", + (optionalBecauseMissing :> obj)) + ("optionalBecauseNull", + (optionalBecauseNull :> obj)) + ("optionalBecauseEmptyString", + (optionalBecauseEmptyString :> obj)) + ("notOptional", + (notOptional :> obj)) + ("nullNotOptional", + (nullNotOptional :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+OptionalPrimitive + JsonDocument.Create(jsonValue, "") + + member NotOptional: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "notOptional") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member NullNotOptional: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "nullNotOptional") + + member OptionalBecauseEmptyString: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "optionalBecauseEmptyString")) + + member OptionalBecauseMissing: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "optionalBecauseMissing")) + + member OptionalBecauseNull: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "optionalBecauseNull")) + + +class JsonProvider+OptionalRecord : FDR.BaseTypes.IJsonDocument + new : optionalBecauseMissing:JsonProvider+OptionalBecauseMissing option -> optionalBecauseNull:JsonProvider+OptionalBecauseMissing option -> optionalBecauseEmptyString:JsonProvider+OptionalBecauseMissing option -> notOptional:JsonProvider+OptionalBecauseMissing -> JsonProvider+OptionalRecord + JsonRuntime.CreateRecord([| ("optionalBecauseMissing", + (optionalBecauseMissing :> obj)) + ("optionalBecauseNull", + (optionalBecauseNull :> obj)) + ("optionalBecauseEmptyString", + (optionalBecauseEmptyString :> obj)) + ("notOptional", + (notOptional :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+OptionalRecord + JsonDocument.Create(jsonValue, "") + + member NotOptional: JsonProvider+OptionalBecauseMissing with get + JsonRuntime.GetPropertyPacked(this, "notOptional") + + member OptionalBecauseEmptyString: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetPropertyPacked(this, "optionalBecauseEmptyString") + + member OptionalBecauseMissing: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetPropertyPacked(this, "optionalBecauseMissing") + + member OptionalBecauseNull: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetPropertyPacked(this, "optionalBecauseNull") + + +class JsonProvider+RecordProperty : FDR.BaseTypes.IJsonDocument + new : stringProperty:string -> intProperty:int -> int64Property:int64 -> decimalProperty:decimal -> floatProperty:float -> boolProperty:bool -> dateProperty:System.DateTime -> guidProperty:System.Guid -> JsonProvider+RecordProperty + JsonRuntime.CreateRecord([| ("stringProperty", + (stringProperty :> obj)) + ("intProperty", + (intProperty :> obj)) + ("int64Property", + (int64Property :> obj)) + ("decimalProperty", + (decimalProperty :> obj)) + ("floatProperty", + (floatProperty :> obj)) + ("boolProperty", + (boolProperty :> obj)) + ("dateProperty", + (dateProperty :> obj)) + ("guidProperty", + (guidProperty :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+RecordProperty + JsonDocument.Create(jsonValue, "") + + member BoolProperty: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "boolProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DateProperty: System.DateTime with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "dateProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTime("", value.JsonOpt), value.JsonOpt) + + member DecimalProperty: decimal with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "decimalProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDecimal("", value.JsonOpt), value.JsonOpt) + + member FloatProperty: float with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "floatProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertFloat("", "", value.JsonOpt), value.JsonOpt) + + member GuidProperty: System.Guid with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "guidProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertGuid(value.JsonOpt), value.JsonOpt) + + member Int64Property: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "int64Property") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IntProperty: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "intProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member StringProperty: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "stringProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+IntOrBoolean : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrBoolean + JsonRuntime.CreateValue((number :> obj), "") + + new : boolean:bool -> JsonProvider+IntOrBoolean + JsonRuntime.CreateValue((boolean :> obj), "") + + new : () -> JsonProvider+IntOrBoolean + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBoolean + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+IntOrBooleanOrArrayOrB : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((number :> obj), "") + + new : boolean:bool -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((boolean :> obj), "") + + new : array:JsonProvider+NumbersOrBooleanOrB -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((array :> obj), "") + + new : record:JsonProvider+OptionalBecauseMissing -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((record :> obj), "") + + new : () -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBooleanOrArrayOrB + JsonDocument.Create(jsonValue, "") + + member Array: JsonProvider+NumbersOrBooleanOrB option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Array", new Func<_,_>(id))) + + member Boolean: bool option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Record: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Record@b", new Func<_,_>(id))) + + +class JsonProvider+IntOrBooleanOrDateTime : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue((number :> obj), "") + + new : boolean:bool -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue((boolean :> obj), "") + + new : dateTime:System.DateTime -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue((dateTime :> obj), "") + + new : () -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBooleanOrDateTime + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member DateTime: System.DateTime option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "DateTime", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDateTime("", Some t.JsonValue), Some t.JsonValue))) + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+NumbersOrBooleanOrHeterogeneousArray : FDR.BaseTypes.IJsonDocument + new : numbers:int[] -> boolean:bool option -> record:JsonProvider+OptionalBecauseMissing option -> JsonProvider+NumbersOrBooleanOrHeterogeneousArray + JsonRuntime.CreateArray([| (numbers :> obj) + (boolean :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+NumbersOrBooleanOrHeterogeneousArray + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Numbers: int[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Record: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Record@heterogeneousArray", new Func<_,_>(id))) + + +class JsonProvider+NumbersOrBooleanOrString : FDR.BaseTypes.IJsonDocument + new : numbers:int[] -> boolean:bool -> string:string option -> JsonProvider+NumbersOrBooleanOrString + JsonRuntime.CreateArray([| (numbers :> obj) + (boolean :> obj) + (string :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+NumbersOrBooleanOrString + JsonDocument.Create(jsonValue, "") + + member Boolean: bool with get + let value = JsonRuntime.GetArrayChildByTypeTag(this, "", "Boolean") + JsonRuntime.GetNonOptionalValue(value.Path(), JsonRuntime.ConvertBoolean(Some value.JsonValue), Some value.JsonValue) + + member Numbers: int[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+OptionalBecauseMissing : FDR.BaseTypes.IJsonDocument + new : a:int -> JsonProvider+OptionalBecauseMissing + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+OptionalBecauseMissing + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+NumbersOrBooleanOrB : FDR.BaseTypes.IJsonDocument + new : numbers:int[] -> boolean:bool option -> record:JsonProvider+OptionalBecauseMissing option -> JsonProvider+NumbersOrBooleanOrB + JsonRuntime.CreateArray([| (numbers :> obj) + (boolean :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+NumbersOrBooleanOrB + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Numbers: int[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Record: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Record@b", new Func<_,_>(id))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..b14805327 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,optionals.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,416 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "optionals.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "optionals.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : recordProperty:JsonProvider+RecordProperty -> nullProperty:JsonValue -> emptyStringProperty:JsonValue -> emptyArrayProperty:JsonValue[] -> oneElementArrayProperty:int[] -> multipleElementsArrayProperty:int[] -> arrayOfObjects:JsonProvider+JsonProvider+ArrayOfObject[] -> optionalPrimitives:JsonProvider+JsonProvider+OptionalPrimitive[] -> optionalRecords:JsonProvider+JsonProvider+OptionalRecord[] -> heterogeneousArray:JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray -> heterogeneousRecords:JsonProvider+JsonProvider+HeterogeneousRecord[] -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("recordProperty", + (recordProperty :> obj)) + ("nullProperty", + (nullProperty :> obj)) + ("emptyStringProperty", + (emptyStringProperty :> obj)) + ("emptyArrayProperty", + (emptyArrayProperty :> obj)) + ("oneElementArrayProperty", + (oneElementArrayProperty :> obj)) + ("multipleElementsArrayProperty", + (multipleElementsArrayProperty :> obj)) + ("arrayOfObjects", + (arrayOfObjects :> obj)) + ("optionalPrimitives", + (optionalPrimitives :> obj)) + ("optionalRecords", + (optionalRecords :> obj)) + ("heterogeneousArray", + (heterogeneousArray :> obj)) + ("heterogeneousRecords", + (heterogeneousRecords :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member ArrayOfObjects: JsonProvider+JsonProvider+ArrayOfObject[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "arrayOfObjects"), new Func<_,_>(id))) + + member EmptyArrayProperty: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "emptyArrayProperty"), new Func<_,_>(id))) + + member EmptyStringProperty: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "emptyStringProperty") + + member HeterogeneousArray: JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousArray") + + member HeterogeneousRecords: JsonProvider+JsonProvider+HeterogeneousRecord[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousRecords"), new Func<_,_>(id))) + + member MultipleElementsArrayProperty: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "multipleElementsArrayProperty"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member NullProperty: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "nullProperty") + + member OneElementArrayProperty: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "oneElementArrayProperty"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member OptionalPrimitives: JsonProvider+JsonProvider+OptionalPrimitive[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "optionalPrimitives"), new Func<_,_>(id))) + + member OptionalRecords: JsonProvider+JsonProvider+OptionalRecord[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "optionalRecords"), new Func<_,_>(id))) + + member RecordProperty: JsonProvider+RecordProperty with get + JsonRuntime.GetPropertyPacked(this, "recordProperty") + + +class JsonProvider+ArrayOfObject : FDR.BaseTypes.IJsonDocument + new : heterogeneousArrayProperty:JsonProvider+NumbersOrBooleanOrString -> heterogeneousProperty:JsonProvider+IntOrBooleanOrDateTime -> heterogeneousOptionalProperty:JsonProvider+IntOrBoolean -> JsonProvider+ArrayOfObject + JsonRuntime.CreateRecord([| ("heterogeneousArrayProperty", + (heterogeneousArrayProperty :> obj)) + ("heterogeneousProperty", + (heterogeneousProperty :> obj)) + ("heterogeneousOptionalProperty", + (heterogeneousOptionalProperty :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+ArrayOfObject + JsonDocument.Create(jsonValue, "") + + member HeterogeneousArrayProperty: JsonProvider+NumbersOrBooleanOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousArrayProperty") + + member HeterogeneousOptionalProperty: JsonProvider+IntOrBoolean with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousOptionalProperty") + + member HeterogeneousProperty: JsonProvider+IntOrBooleanOrDateTime with get + JsonRuntime.GetPropertyPackedOrNull(this, "heterogeneousProperty") + + +class JsonProvider+HeterogeneousRecord : FDR.BaseTypes.IJsonDocument + new : b:JsonProvider+IntOrBooleanOrArrayOrB -> JsonProvider+HeterogeneousRecord + JsonRuntime.CreateRecord([| ("b", + (b :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+HeterogeneousRecord + JsonDocument.Create(jsonValue, "") + + member B: JsonProvider+IntOrBooleanOrArrayOrB with get + JsonRuntime.GetPropertyPackedOrNull(this, "b") + + +class JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray : FDR.BaseTypes.IJsonDocument + new : number:int -> boolean:bool -> arrays:JsonProvider+JsonProvider+NumbersOrBooleanOrHeterogeneousArray[] -> record:JsonProvider+OptionalBecauseMissing -> JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray + JsonRuntime.CreateArray([| (number :> obj) + (boolean :> obj) + (arrays :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBooleanOrArraysOrHeterogeneousArray + JsonDocument.Create(jsonValue, "") + + member Arrays: JsonProvider+JsonProvider+NumbersOrBooleanOrHeterogeneousArray[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Array", new Func<_,_>(id))) + + member Boolean: bool with get + let value = JsonRuntime.GetArrayChildByTypeTag(this, "", "Boolean") + JsonRuntime.GetNonOptionalValue(value.Path(), JsonRuntime.ConvertBoolean(Some value.JsonValue), Some value.JsonValue) + + member Number: int with get + let value = JsonRuntime.GetArrayChildByTypeTag(this, "", "Number") + JsonRuntime.GetNonOptionalValue(value.Path(), JsonRuntime.ConvertInteger("", Some value.JsonValue), Some value.JsonValue) + + member Record: JsonProvider+OptionalBecauseMissing with get + JsonRuntime.GetArrayChildByTypeTag(this, "", "Record@heterogeneousArray") + + +class JsonProvider+OptionalPrimitive : FDR.BaseTypes.IJsonDocument + new : optionalBecauseMissing:int option -> optionalBecauseNull:int option -> optionalBecauseEmptyString:int option -> notOptional:int -> nullNotOptional:JsonValue -> JsonProvider+OptionalPrimitive + JsonRuntime.CreateRecord([| ("optionalBecauseMissing", + (optionalBecauseMissing :> obj)) + ("optionalBecauseNull", + (optionalBecauseNull :> obj)) + ("optionalBecauseEmptyString", + (optionalBecauseEmptyString :> obj)) + ("notOptional", + (notOptional :> obj)) + ("nullNotOptional", + (nullNotOptional :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+OptionalPrimitive + JsonDocument.Create(jsonValue, "") + + member NotOptional: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "notOptional") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member NullNotOptional: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "nullNotOptional") + + member OptionalBecauseEmptyString: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "optionalBecauseEmptyString")) + + member OptionalBecauseMissing: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "optionalBecauseMissing")) + + member OptionalBecauseNull: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "optionalBecauseNull")) + + +class JsonProvider+OptionalRecord : FDR.BaseTypes.IJsonDocument + new : optionalBecauseMissing:JsonProvider+OptionalBecauseMissing option -> optionalBecauseNull:JsonProvider+OptionalBecauseMissing option -> optionalBecauseEmptyString:JsonProvider+OptionalBecauseMissing option -> notOptional:JsonProvider+OptionalBecauseMissing -> JsonProvider+OptionalRecord + JsonRuntime.CreateRecord([| ("optionalBecauseMissing", + (optionalBecauseMissing :> obj)) + ("optionalBecauseNull", + (optionalBecauseNull :> obj)) + ("optionalBecauseEmptyString", + (optionalBecauseEmptyString :> obj)) + ("notOptional", + (notOptional :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+OptionalRecord + JsonDocument.Create(jsonValue, "") + + member NotOptional: JsonProvider+OptionalBecauseMissing with get + JsonRuntime.GetPropertyPacked(this, "notOptional") + + member OptionalBecauseEmptyString: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetPropertyPacked(this, "optionalBecauseEmptyString") + + member OptionalBecauseMissing: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetPropertyPacked(this, "optionalBecauseMissing") + + member OptionalBecauseNull: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetPropertyPacked(this, "optionalBecauseNull") + + +class JsonProvider+RecordProperty : FDR.BaseTypes.IJsonDocument + new : stringProperty:string -> intProperty:int -> int64Property:int64 -> decimalProperty:decimal -> floatProperty:float -> boolProperty:bool -> dateProperty:System.DateTime -> guidProperty:System.Guid -> JsonProvider+RecordProperty + JsonRuntime.CreateRecord([| ("stringProperty", + (stringProperty :> obj)) + ("intProperty", + (intProperty :> obj)) + ("int64Property", + (int64Property :> obj)) + ("decimalProperty", + (decimalProperty :> obj)) + ("floatProperty", + (floatProperty :> obj)) + ("boolProperty", + (boolProperty :> obj)) + ("dateProperty", + (dateProperty :> obj)) + ("guidProperty", + (guidProperty :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+RecordProperty + JsonDocument.Create(jsonValue, "") + + member BoolProperty: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "boolProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DateProperty: System.DateTime with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "dateProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTime("", value.JsonOpt), value.JsonOpt) + + member DecimalProperty: decimal with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "decimalProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDecimal("", value.JsonOpt), value.JsonOpt) + + member FloatProperty: float with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "floatProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertFloat("", "", value.JsonOpt), value.JsonOpt) + + member GuidProperty: System.Guid with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "guidProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertGuid(value.JsonOpt), value.JsonOpt) + + member Int64Property: int64 with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "int64Property") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger64("", value.JsonOpt), value.JsonOpt) + + member IntProperty: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "intProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member StringProperty: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "stringProperty") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+IntOrBoolean : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrBoolean + JsonRuntime.CreateValue((number :> obj), "") + + new : boolean:bool -> JsonProvider+IntOrBoolean + JsonRuntime.CreateValue((boolean :> obj), "") + + new : () -> JsonProvider+IntOrBoolean + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBoolean + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+IntOrBooleanOrArrayOrB : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((number :> obj), "") + + new : boolean:bool -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((boolean :> obj), "") + + new : array:JsonProvider+NumbersOrBooleanOrB -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((array :> obj), "") + + new : record:JsonProvider+OptionalBecauseMissing -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue((record :> obj), "") + + new : () -> JsonProvider+IntOrBooleanOrArrayOrB + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBooleanOrArrayOrB + JsonDocument.Create(jsonValue, "") + + member Array: JsonProvider+NumbersOrBooleanOrB option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Array", new Func<_,_>(id))) + + member Boolean: bool option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Record: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Record@b", new Func<_,_>(id))) + + +class JsonProvider+IntOrBooleanOrDateTime : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue((number :> obj), "") + + new : boolean:bool -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue((boolean :> obj), "") + + new : dateTime:System.DateTime -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue((dateTime :> obj), "") + + new : () -> JsonProvider+IntOrBooleanOrDateTime + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrBooleanOrDateTime + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member DateTime: System.DateTime option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "DateTime", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDateTime("", Some t.JsonValue), Some t.JsonValue))) + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+NumbersOrBooleanOrHeterogeneousArray : FDR.BaseTypes.IJsonDocument + new : numbers:int[] -> boolean:bool option -> record:JsonProvider+OptionalBecauseMissing option -> JsonProvider+NumbersOrBooleanOrHeterogeneousArray + JsonRuntime.CreateArray([| (numbers :> obj) + (boolean :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+NumbersOrBooleanOrHeterogeneousArray + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Numbers: int[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Record: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Record@heterogeneousArray", new Func<_,_>(id))) + + +class JsonProvider+NumbersOrBooleanOrString : FDR.BaseTypes.IJsonDocument + new : numbers:int[] -> boolean:bool -> string:string option -> JsonProvider+NumbersOrBooleanOrString + JsonRuntime.CreateArray([| (numbers :> obj) + (boolean :> obj) + (string :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+NumbersOrBooleanOrString + JsonDocument.Create(jsonValue, "") + + member Boolean: bool with get + let value = JsonRuntime.GetArrayChildByTypeTag(this, "", "Boolean") + JsonRuntime.GetNonOptionalValue(value.Path(), JsonRuntime.ConvertBoolean(Some value.JsonValue), Some value.JsonValue) + + member Numbers: int[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+OptionalBecauseMissing : FDR.BaseTypes.IJsonDocument + new : a:int -> JsonProvider+OptionalBecauseMissing + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+OptionalBecauseMissing + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+NumbersOrBooleanOrB : FDR.BaseTypes.IJsonDocument + new : numbers:int[] -> boolean:bool option -> record:JsonProvider+OptionalBecauseMissing option -> JsonProvider+NumbersOrBooleanOrB + JsonRuntime.CreateArray([| (numbers :> obj) + (boolean :> obj) + (record :> obj) |], "") + + new : jsonValue:JsonValue -> JsonProvider+NumbersOrBooleanOrB + JsonDocument.Create(jsonValue, "") + + member Boolean: bool option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Boolean", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertBoolean(Some t.JsonValue), Some t.JsonValue))) + + member Numbers: int[] with get + JsonRuntime.GetArrayChildrenByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Record: JsonProvider+OptionalBecauseMissing option with get + JsonRuntime.TryGetArrayChildByTypeTag(this, "", "Record@b", new Func<_,_>(id))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..6575d09b7 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,97 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "projects.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "projects.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : ordercontainer:JsonProvider+Ordercontainer -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("ordercontainer", + (ordercontainer :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Ordercontainer: JsonProvider+Ordercontainer with get + JsonRuntime.GetPropertyPacked(this, "ordercontainer") + + +class JsonProvider+Ordercontainer : FDR.BaseTypes.IJsonDocument + new : backgrounds:JsonProvider+Backgrounds -> project:JsonProvider+Background -> JsonProvider+Ordercontainer + JsonRuntime.CreateRecord([| ("backgrounds", + (backgrounds :> obj)) + ("project", + (project :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Ordercontainer + JsonDocument.Create(jsonValue, "") + + member Backgrounds: JsonProvider+Backgrounds with get + JsonRuntime.GetPropertyPacked(this, "backgrounds") + + member Project: JsonProvider+Background with get + JsonRuntime.GetPropertyPacked(this, "project") + + +class JsonProvider+Background : FDR.BaseTypes.IJsonDocument + new : title:JsonProvider+Title -> JsonProvider+Background + JsonRuntime.CreateRecord([| ("title", + (title :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Background + JsonDocument.Create(jsonValue, "") + + member Title: JsonProvider+Title with get + JsonRuntime.GetPropertyPacked(this, "title") + + +class JsonProvider+Backgrounds : FDR.BaseTypes.IJsonDocument + new : background:JsonProvider+Background -> JsonProvider+Backgrounds + JsonRuntime.CreateRecord([| ("background", + (background :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Backgrounds + JsonDocument.Create(jsonValue, "") + + member Background: JsonProvider+Background with get + JsonRuntime.GetPropertyPacked(this, "background") + + +class JsonProvider+Title : FDR.BaseTypes.IJsonDocument + new : text:string -> JsonProvider+Title + JsonRuntime.CreateRecord([| ("text", + (text :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Title + JsonDocument.Create(jsonValue, "") + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..6575d09b7 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,97 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "projects.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "projects.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : ordercontainer:JsonProvider+Ordercontainer -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("ordercontainer", + (ordercontainer :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Ordercontainer: JsonProvider+Ordercontainer with get + JsonRuntime.GetPropertyPacked(this, "ordercontainer") + + +class JsonProvider+Ordercontainer : FDR.BaseTypes.IJsonDocument + new : backgrounds:JsonProvider+Backgrounds -> project:JsonProvider+Background -> JsonProvider+Ordercontainer + JsonRuntime.CreateRecord([| ("backgrounds", + (backgrounds :> obj)) + ("project", + (project :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Ordercontainer + JsonDocument.Create(jsonValue, "") + + member Backgrounds: JsonProvider+Backgrounds with get + JsonRuntime.GetPropertyPacked(this, "backgrounds") + + member Project: JsonProvider+Background with get + JsonRuntime.GetPropertyPacked(this, "project") + + +class JsonProvider+Background : FDR.BaseTypes.IJsonDocument + new : title:JsonProvider+Title -> JsonProvider+Background + JsonRuntime.CreateRecord([| ("title", + (title :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Background + JsonDocument.Create(jsonValue, "") + + member Title: JsonProvider+Title with get + JsonRuntime.GetPropertyPacked(this, "title") + + +class JsonProvider+Backgrounds : FDR.BaseTypes.IJsonDocument + new : background:JsonProvider+Background -> JsonProvider+Backgrounds + JsonRuntime.CreateRecord([| ("background", + (background :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Backgrounds + JsonDocument.Create(jsonValue, "") + + member Background: JsonProvider+Background with get + JsonRuntime.GetPropertyPacked(this, "background") + + +class JsonProvider+Title : FDR.BaseTypes.IJsonDocument + new : text:string -> JsonProvider+Title + JsonRuntime.CreateRecord([| ("text", + (text :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Title + JsonDocument.Create(jsonValue, "") + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..6575d09b7 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,projects.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,97 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "projects.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "projects.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : ordercontainer:JsonProvider+Ordercontainer -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("ordercontainer", + (ordercontainer :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Ordercontainer: JsonProvider+Ordercontainer with get + JsonRuntime.GetPropertyPacked(this, "ordercontainer") + + +class JsonProvider+Ordercontainer : FDR.BaseTypes.IJsonDocument + new : backgrounds:JsonProvider+Backgrounds -> project:JsonProvider+Background -> JsonProvider+Ordercontainer + JsonRuntime.CreateRecord([| ("backgrounds", + (backgrounds :> obj)) + ("project", + (project :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Ordercontainer + JsonDocument.Create(jsonValue, "") + + member Backgrounds: JsonProvider+Backgrounds with get + JsonRuntime.GetPropertyPacked(this, "backgrounds") + + member Project: JsonProvider+Background with get + JsonRuntime.GetPropertyPacked(this, "project") + + +class JsonProvider+Background : FDR.BaseTypes.IJsonDocument + new : title:JsonProvider+Title -> JsonProvider+Background + JsonRuntime.CreateRecord([| ("title", + (title :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Background + JsonDocument.Create(jsonValue, "") + + member Title: JsonProvider+Title with get + JsonRuntime.GetPropertyPacked(this, "title") + + +class JsonProvider+Backgrounds : FDR.BaseTypes.IJsonDocument + new : background:JsonProvider+Background -> JsonProvider+Backgrounds + JsonRuntime.CreateRecord([| ("background", + (background :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Backgrounds + JsonDocument.Create(jsonValue, "") + + member Background: JsonProvider+Background with get + JsonRuntime.GetPropertyPacked(this, "background") + + +class JsonProvider+Title : FDR.BaseTypes.IJsonDocument + new : text:string -> JsonProvider+Title + JsonRuntime.CreateRecord([| ("text", + (text :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Title + JsonDocument.Create(jsonValue, "") + + member Text: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "text") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..58761f1d0 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,262 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "reddit.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "reddit.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : kind:string -> data:JsonProvider+Data -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("kind", + (kind :> obj)) + ("data", + (data :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Data: JsonProvider+Data with get + JsonRuntime.GetPropertyPacked(this, "data") + + member Kind: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "kind") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Data : FDR.BaseTypes.IJsonDocument + new : modhash:JsonValue -> children:JsonProvider+JsonProvider+Child[] -> after:string -> before:JsonValue -> JsonProvider+Data + JsonRuntime.CreateRecord([| ("modhash", + (modhash :> obj)) + ("children", + (children :> obj)) + ("after", + (after :> obj)) + ("before", + (before :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Data + JsonDocument.Create(jsonValue, "") + + member After: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "after") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Before: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "before") + + member Children: JsonProvider+JsonProvider+Child[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "children"), new Func<_,_>(id))) + + member Modhash: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "modhash") + + +class JsonProvider+Child : FDR.BaseTypes.IJsonDocument + new : kind:string -> data:JsonProvider+Data2 -> JsonProvider+Child + JsonRuntime.CreateRecord([| ("kind", + (kind :> obj)) + ("data", + (data :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Child + JsonDocument.Create(jsonValue, "") + + member Data: JsonProvider+Data2 with get + JsonRuntime.GetPropertyPacked(this, "data") + + member Kind: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "kind") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Data2 : FDR.BaseTypes.IJsonDocument + new : subredditId:string -> linkTitle:string -> bannedBy:JsonValue -> subreddit:string -> linkAuthor:string -> likes:JsonValue -> replies:JsonValue -> saved:bool -> id:string -> gilded:int -> author:string -> parentId:string -> approvedBy:JsonValue -> body:string -> edited:bool -> authorFlairCssClass:JsonValue -> downs:int -> bodyHtml:string -> linkId:string -> scoreHidden:bool -> name:string -> created:int -> authorFlairText:JsonValue -> linkUrl:string -> createdUtc:int -> ups:int -> numReports:JsonValue -> distinguished:JsonValue -> JsonProvider+Data2 + JsonRuntime.CreateRecord([| ("subreddit_id", + (subredditId :> obj)) + ("link_title", + (linkTitle :> obj)) + ("banned_by", + (bannedBy :> obj)) + ("subreddit", + (subreddit :> obj)) + ("link_author", + (linkAuthor :> obj)) + ("likes", + (likes :> obj)) + ("replies", + (replies :> obj)) + ("saved", + (saved :> obj)) + ("id", + (id :> obj)) + ("gilded", + (gilded :> obj)) + ("author", + (author :> obj)) + ("parent_id", + (parentId :> obj)) + ("approved_by", + (approvedBy :> obj)) + ("body", + (body :> obj)) + ("edited", + (edited :> obj)) + ("author_flair_css_class", + (authorFlairCssClass :> obj)) + ("downs", + (downs :> obj)) + ("body_html", + (bodyHtml :> obj)) + ("link_id", + (linkId :> obj)) + ("score_hidden", + (scoreHidden :> obj)) + ("name", + (name :> obj)) + ("created", + (created :> obj)) + ("author_flair_text", + (authorFlairText :> obj)) + ("link_url", + (linkUrl :> obj)) + ("created_utc", + (createdUtc :> obj)) + ("ups", + (ups :> obj)) + ("num_reports", + (numReports :> obj)) + ("distinguished", + (distinguished :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Data2 + JsonDocument.Create(jsonValue, "") + + member ApprovedBy: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "approved_by") + + member Author: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "author") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member AuthorFlairCssClass: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "author_flair_css_class") + + member AuthorFlairText: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "author_flair_text") + + member BannedBy: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "banned_by") + + member Body: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "body") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member BodyHtml: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "body_html") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Created: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member CreatedUtc: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_utc") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Distinguished: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "distinguished") + + member Downs: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "downs") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Edited: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "edited") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Gilded: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gilded") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Likes: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "likes") + + member LinkAuthor: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_author") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LinkId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LinkTitle: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_title") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LinkUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member NumReports: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "num_reports") + + member ParentId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "parent_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Replies: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "replies") + + member Saved: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "saved") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScoreHidden: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "score_hidden") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Subreddit: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "subreddit") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SubredditId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "subreddit_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Ups: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "ups") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..58761f1d0 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,262 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "reddit.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "reddit.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : kind:string -> data:JsonProvider+Data -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("kind", + (kind :> obj)) + ("data", + (data :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Data: JsonProvider+Data with get + JsonRuntime.GetPropertyPacked(this, "data") + + member Kind: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "kind") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Data : FDR.BaseTypes.IJsonDocument + new : modhash:JsonValue -> children:JsonProvider+JsonProvider+Child[] -> after:string -> before:JsonValue -> JsonProvider+Data + JsonRuntime.CreateRecord([| ("modhash", + (modhash :> obj)) + ("children", + (children :> obj)) + ("after", + (after :> obj)) + ("before", + (before :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Data + JsonDocument.Create(jsonValue, "") + + member After: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "after") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Before: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "before") + + member Children: JsonProvider+JsonProvider+Child[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "children"), new Func<_,_>(id))) + + member Modhash: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "modhash") + + +class JsonProvider+Child : FDR.BaseTypes.IJsonDocument + new : kind:string -> data:JsonProvider+Data2 -> JsonProvider+Child + JsonRuntime.CreateRecord([| ("kind", + (kind :> obj)) + ("data", + (data :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Child + JsonDocument.Create(jsonValue, "") + + member Data: JsonProvider+Data2 with get + JsonRuntime.GetPropertyPacked(this, "data") + + member Kind: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "kind") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Data2 : FDR.BaseTypes.IJsonDocument + new : subredditId:string -> linkTitle:string -> bannedBy:JsonValue -> subreddit:string -> linkAuthor:string -> likes:JsonValue -> replies:JsonValue -> saved:bool -> id:string -> gilded:int -> author:string -> parentId:string -> approvedBy:JsonValue -> body:string -> edited:bool -> authorFlairCssClass:JsonValue -> downs:int -> bodyHtml:string -> linkId:string -> scoreHidden:bool -> name:string -> created:int -> authorFlairText:JsonValue -> linkUrl:string -> createdUtc:int -> ups:int -> numReports:JsonValue -> distinguished:JsonValue -> JsonProvider+Data2 + JsonRuntime.CreateRecord([| ("subreddit_id", + (subredditId :> obj)) + ("link_title", + (linkTitle :> obj)) + ("banned_by", + (bannedBy :> obj)) + ("subreddit", + (subreddit :> obj)) + ("link_author", + (linkAuthor :> obj)) + ("likes", + (likes :> obj)) + ("replies", + (replies :> obj)) + ("saved", + (saved :> obj)) + ("id", + (id :> obj)) + ("gilded", + (gilded :> obj)) + ("author", + (author :> obj)) + ("parent_id", + (parentId :> obj)) + ("approved_by", + (approvedBy :> obj)) + ("body", + (body :> obj)) + ("edited", + (edited :> obj)) + ("author_flair_css_class", + (authorFlairCssClass :> obj)) + ("downs", + (downs :> obj)) + ("body_html", + (bodyHtml :> obj)) + ("link_id", + (linkId :> obj)) + ("score_hidden", + (scoreHidden :> obj)) + ("name", + (name :> obj)) + ("created", + (created :> obj)) + ("author_flair_text", + (authorFlairText :> obj)) + ("link_url", + (linkUrl :> obj)) + ("created_utc", + (createdUtc :> obj)) + ("ups", + (ups :> obj)) + ("num_reports", + (numReports :> obj)) + ("distinguished", + (distinguished :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Data2 + JsonDocument.Create(jsonValue, "") + + member ApprovedBy: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "approved_by") + + member Author: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "author") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member AuthorFlairCssClass: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "author_flair_css_class") + + member AuthorFlairText: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "author_flair_text") + + member BannedBy: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "banned_by") + + member Body: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "body") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member BodyHtml: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "body_html") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Created: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member CreatedUtc: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_utc") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Distinguished: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "distinguished") + + member Downs: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "downs") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Edited: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "edited") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Gilded: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gilded") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Likes: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "likes") + + member LinkAuthor: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_author") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LinkId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LinkTitle: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_title") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LinkUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member NumReports: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "num_reports") + + member ParentId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "parent_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Replies: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "replies") + + member Saved: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "saved") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScoreHidden: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "score_hidden") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Subreddit: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "subreddit") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SubredditId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "subreddit_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Ups: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "ups") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..58761f1d0 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,reddit.json,False,,,True,False,ValuesOnly.expected @@ -0,0 +1,262 @@ +class JsonProvider : obj + static member AsyncGetSample: () -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "reddit.json"), f) + + static member AsyncLoad: uri:string -> JsonProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> JsonDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member GetSample: () -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "JSON" "" "reddit.json"))) + + static member Load: stream:System.IO.Stream -> JsonProvider+Root + JsonDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> JsonProvider+Root + JsonDocument.Create(reader) + + static member Load: uri:string -> JsonProvider+Root + JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))) + + static member Load: value:JsonValue -> JsonProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> JsonProvider+Root + JsonDocument.Create(((new StringReader(text)) :> TextReader)) + + static member ParseList: text:string -> JsonProvider+JsonProvider+Root[] + JsonDocument.CreateList(((new StringReader(text)) :> TextReader)) + + +class JsonProvider+Root : FDR.BaseTypes.IJsonDocument + new : kind:string -> data:JsonProvider+Data -> JsonProvider+Root + JsonRuntime.CreateRecord([| ("kind", + (kind :> obj)) + ("data", + (data :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Root + JsonDocument.Create(jsonValue, "") + + member Data: JsonProvider+Data with get + JsonRuntime.GetPropertyPacked(this, "data") + + member Kind: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "kind") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Data : FDR.BaseTypes.IJsonDocument + new : modhash:JsonValue -> children:JsonProvider+JsonProvider+Child[] -> after:string -> before:JsonValue -> JsonProvider+Data + JsonRuntime.CreateRecord([| ("modhash", + (modhash :> obj)) + ("children", + (children :> obj)) + ("after", + (after :> obj)) + ("before", + (before :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Data + JsonDocument.Create(jsonValue, "") + + member After: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "after") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Before: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "before") + + member Children: JsonProvider+JsonProvider+Child[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "children"), new Func<_,_>(id))) + + member Modhash: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "modhash") + + +class JsonProvider+Child : FDR.BaseTypes.IJsonDocument + new : kind:string -> data:JsonProvider+Data2 -> JsonProvider+Child + JsonRuntime.CreateRecord([| ("kind", + (kind :> obj)) + ("data", + (data :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Child + JsonDocument.Create(jsonValue, "") + + member Data: JsonProvider+Data2 with get + JsonRuntime.GetPropertyPacked(this, "data") + + member Kind: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "kind") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Data2 : FDR.BaseTypes.IJsonDocument + new : subredditId:string -> linkTitle:string -> bannedBy:JsonValue -> subreddit:string -> linkAuthor:string -> likes:JsonValue -> replies:JsonValue -> saved:bool -> id:string -> gilded:int -> author:string -> parentId:string -> approvedBy:JsonValue -> body:string -> edited:bool -> authorFlairCssClass:JsonValue -> downs:int -> bodyHtml:string -> linkId:string -> scoreHidden:bool -> name:string -> created:int -> authorFlairText:JsonValue -> linkUrl:string -> createdUtc:int -> ups:int -> numReports:JsonValue -> distinguished:JsonValue -> JsonProvider+Data2 + JsonRuntime.CreateRecord([| ("subreddit_id", + (subredditId :> obj)) + ("link_title", + (linkTitle :> obj)) + ("banned_by", + (bannedBy :> obj)) + ("subreddit", + (subreddit :> obj)) + ("link_author", + (linkAuthor :> obj)) + ("likes", + (likes :> obj)) + ("replies", + (replies :> obj)) + ("saved", + (saved :> obj)) + ("id", + (id :> obj)) + ("gilded", + (gilded :> obj)) + ("author", + (author :> obj)) + ("parent_id", + (parentId :> obj)) + ("approved_by", + (approvedBy :> obj)) + ("body", + (body :> obj)) + ("edited", + (edited :> obj)) + ("author_flair_css_class", + (authorFlairCssClass :> obj)) + ("downs", + (downs :> obj)) + ("body_html", + (bodyHtml :> obj)) + ("link_id", + (linkId :> obj)) + ("score_hidden", + (scoreHidden :> obj)) + ("name", + (name :> obj)) + ("created", + (created :> obj)) + ("author_flair_text", + (authorFlairText :> obj)) + ("link_url", + (linkUrl :> obj)) + ("created_utc", + (createdUtc :> obj)) + ("ups", + (ups :> obj)) + ("num_reports", + (numReports :> obj)) + ("distinguished", + (distinguished :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Data2 + JsonDocument.Create(jsonValue, "") + + member ApprovedBy: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "approved_by") + + member Author: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "author") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member AuthorFlairCssClass: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "author_flair_css_class") + + member AuthorFlairText: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "author_flair_text") + + member BannedBy: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "banned_by") + + member Body: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "body") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member BodyHtml: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "body_html") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Created: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member CreatedUtc: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "created_utc") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Distinguished: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "distinguished") + + member Downs: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "downs") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Edited: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "edited") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Gilded: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "gilded") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Id: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Likes: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "likes") + + member LinkAuthor: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_author") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LinkId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LinkTitle: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_title") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LinkUrl: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "link_url") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member NumReports: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "num_reports") + + member ParentId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "parent_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Replies: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "replies") + + member Saved: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "saved") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ScoreHidden: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "score_hidden") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Subreddit: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "subreddit") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SubredditId: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "subreddit_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Ups: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "ups") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..f6796d5ff --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,713 @@ +class JsonProvider : obj + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Topic[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Topic[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Topic : FDR.BaseTypes.IJsonDocument + new : photo:string -> previewLink:string option -> smallIconHover:string -> largeIcon:string -> video:string option -> universityIds:string[] -> id:int -> universities:JsonProvider+JsonProvider+University[] -> selfServiceCourseId:int option -> shortDescription:string -> shortName:string -> categoryIds:string[] -> visibility:int option -> smallIcon:string -> instructor:string option -> categories:JsonProvider+JsonProvider+Category[] -> name:string -> language:string -> courses:JsonProvider+JsonProvider+Course[] -> universityLogo:string option -> courseIds:int[] -> display:bool -> subtitleLanguagesCsv:string option -> JsonProvider+Topic + JsonRuntime.CreateRecord([| ("photo", + (photo :> obj)) + ("preview_link", + (previewLink :> obj)) + ("small_icon_hover", + (smallIconHover :> obj)) + ("large_icon", + (largeIcon :> obj)) + ("video", + (video :> obj)) + ("university-ids", + (universityIds :> obj)) + ("id", + (id :> obj)) + ("universities", + (universities :> obj)) + ("self_service_course_id", + (selfServiceCourseId :> obj)) + ("short_description", + (shortDescription :> obj)) + ("short_name", + (shortName :> obj)) + ("category-ids", + (categoryIds :> obj)) + ("visibility", + (visibility :> obj)) + ("small_icon", + (smallIcon :> obj)) + ("instructor", + (instructor :> obj)) + ("categories", + (categories :> obj)) + ("name", + (name :> obj)) + ("language", + (language :> obj)) + ("courses", + (courses :> obj)) + ("university_logo", + (universityLogo :> obj)) + ("course-ids", + (courseIds :> obj)) + ("display", + (display :> obj)) + ("subtitle_languages_csv", + (subtitleLanguagesCsv :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Topic + JsonDocument.Create(jsonValue, "") + + member Categories: JsonProvider+JsonProvider+Category[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "categories"), new Func<_,_>(id))) + + member CategoryIds: string[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "category-ids"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + member CourseIds: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "course-ids"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Courses: JsonProvider+JsonProvider+Course[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "courses"), new Func<_,_>(id))) + + member Display: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Instructor: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "instructor")) + + member Language: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "language") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LargeIcon: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "large_icon") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Photo: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "photo") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PreviewLink: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "preview_link")) + + member SelfServiceCourseId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "self_service_course_id")) + + member ShortDescription: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_description") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ShortName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SmallIcon: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "small_icon") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SmallIconHover: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "small_icon_hover") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SubtitleLanguagesCsv: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "subtitle_languages_csv")) + + member Universities: JsonProvider+JsonProvider+University[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "universities"), new Func<_,_>(id))) + + member UniversityIds: string[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "university-ids"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + member UniversityLogo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "university_logo")) + + member Video: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "video")) + + member Visibility: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "visibility")) + + +class JsonProvider+Category : FDR.BaseTypes.IJsonDocument + new : id:int -> name:string -> mailingListId:int option -> shortName:string -> description:string option -> JsonProvider+Category + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("name", + (name :> obj)) + ("mailing_list_id", + (mailingListId :> obj)) + ("short_name", + (shortName :> obj)) + ("description", + (description :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Category + JsonDocument.Create(jsonValue, "") + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member MailingListId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "mailing_list_id")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ShortName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Course : FDR.BaseTypes.IJsonDocument + new : gradingPolicyDistinction:string option -> aceTrackPriceDisplay:JsonValue -> signatureTrackCertificateDesignId:JsonValue -> aceSemesterHours:JsonValue -> startDay:int option -> durationString:string option -> signatureTrackLastChanceTime:System.DateTime option -> id:int -> startMonth:int option -> certificateDescription:string option -> startDateString:JsonProvider+StringOrDateTime -> cheggSessionId:JsonValue -> signatureTrackRegularPrice:int option -> gradesReleaseDate:System.DateTime option -> certificatesReady:bool -> signatureTrackPrice:int option -> statementDesignId:int option -> signatureTrackRegistrationOpen:bool -> topicId:int -> eligibleForSignatureTrack:bool -> startDate:System.DateTime option -> record:JsonProvider+Record -> status:bool -> startYear:int option -> signatureTrackCertificateCombinedSignature:JsonValue -> endDate:JsonValue -> notifiedSubscribers:bool -> instructors:int[] -> active:bool -> eligibleForCertificates:bool -> signatureTrackCertificateSignatureBlurb:JsonValue -> deployed:bool -> aceCloseDate:JsonValue -> name:JsonProvider+IntOrString -> textbooks:JsonValue[] -> signatureTrackOpenTime:System.DateTime option -> eligibleForAce:bool option -> gradingPolicyNormal:string option -> aceOpenDate:JsonValue -> homeLink:string option -> creatorId:int option -> proctoredExamCompletionDate:JsonValue -> universityLogo:JsonValue -> signatureTrackCloseTime:System.DateTime option -> authReviewCompletionDate:JsonValue -> JsonProvider+Course + JsonRuntime.CreateRecord([| ("grading_policy_distinction", + (gradingPolicyDistinction :> obj)) + ("ace_track_price_display", + (aceTrackPriceDisplay :> obj)) + ("signature_track_certificate_design_id", + (signatureTrackCertificateDesignId :> obj)) + ("ace_semester_hours", + (aceSemesterHours :> obj)) + ("start_day", + (startDay :> obj)) + ("duration_string", + (durationString :> obj)) + ("signature_track_last_chance_time", + (signatureTrackLastChanceTime :> obj)) + ("id", + (id :> obj)) + ("start_month", + (startMonth :> obj)) + ("certificate_description", + (certificateDescription :> obj)) + ("start_date_string", + (startDateString :> obj)) + ("chegg_session_id", + (cheggSessionId :> obj)) + ("signature_track_regular_price", + (signatureTrackRegularPrice :> obj)) + ("grades_release_date", + (gradesReleaseDate :> obj)) + ("certificates_ready", + (certificatesReady :> obj)) + ("signature_track_price", + (signatureTrackPrice :> obj)) + ("statement_design_id", + (statementDesignId :> obj)) + ("signature_track_registration_open", + (signatureTrackRegistrationOpen :> obj)) + ("topic_id", + (topicId :> obj)) + ("eligible_for_signature_track", + (eligibleForSignatureTrack :> obj)) + ("start_date", + (startDate :> obj)) + ("record", + (record :> obj)) + ("status", + (status :> obj)) + ("start_year", + (startYear :> obj)) + ("signature_track_certificate_combined_signature", + (signatureTrackCertificateCombinedSignature :> obj)) + ("end_date", + (endDate :> obj)) + ("notified_subscribers", + (notifiedSubscribers :> obj)) + ("instructors", + (instructors :> obj)) + ("active", + (active :> obj)) + ("eligible_for_certificates", + (eligibleForCertificates :> obj)) + ("signature_track_certificate_signature_blurb", + (signatureTrackCertificateSignatureBlurb :> obj)) + ("deployed", + (deployed :> obj)) + ("ace_close_date", + (aceCloseDate :> obj)) + ("name", + (name :> obj)) + ("textbooks", + (textbooks :> obj)) + ("signature_track_open_time", + (signatureTrackOpenTime :> obj)) + ("eligible_for_ACE", + (eligibleForAce :> obj)) + ("grading_policy_normal", + (gradingPolicyNormal :> obj)) + ("ace_open_date", + (aceOpenDate :> obj)) + ("home_link", + (homeLink :> obj)) + ("creator_id", + (creatorId :> obj)) + ("proctored_exam_completion_date", + (proctoredExamCompletionDate :> obj)) + ("university_logo", + (universityLogo :> obj)) + ("signature_track_close_time", + (signatureTrackCloseTime :> obj)) + ("auth_review_completion_date", + (authReviewCompletionDate :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Course + JsonDocument.Create(jsonValue, "") + + member AceCloseDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_close_date") + + member AceOpenDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_open_date") + + member AceSemesterHours: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_semester_hours") + + member AceTrackPriceDisplay: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_track_price_display") + + member Active: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "active") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member AuthReviewCompletionDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "auth_review_completion_date") + + member CertificateDescription: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "certificate_description")) + + member CertificatesReady: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "certificates_ready") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CheggSessionId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "chegg_session_id") + + member CreatorId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "creator_id")) + + member Deployed: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "deployed") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DurationString: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "duration_string")) + + member EligibleForAce: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "eligible_for_ACE")) + + member EligibleForCertificates: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "eligible_for_certificates") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member EligibleForSignatureTrack: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "eligible_for_signature_track") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member EndDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "end_date") + + member GradesReleaseDate: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "grades_release_date")) + + member GradingPolicyDistinction: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "grading_policy_distinction")) + + member GradingPolicyNormal: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "grading_policy_normal")) + + member HomeLink: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "home_link")) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Instructors: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "instructors"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Name: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "name") + + member NotifiedSubscribers: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "notified_subscribers") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProctoredExamCompletionDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "proctored_exam_completion_date") + + member Record: JsonProvider+Record with get + JsonRuntime.GetPropertyPacked(this, "record") + + member SignatureTrackCertificateCombinedSignature: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "signature_track_certificate_combined_signature") + + member SignatureTrackCertificateDesignId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "signature_track_certificate_design_id") + + member SignatureTrackCertificateSignatureBlurb: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "signature_track_certificate_signature_blurb") + + member SignatureTrackCloseTime: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_close_time")) + + member SignatureTrackLastChanceTime: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_last_chance_time")) + + member SignatureTrackOpenTime: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_open_time")) + + member SignatureTrackPrice: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_price")) + + member SignatureTrackRegistrationOpen: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "signature_track_registration_open") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member SignatureTrackRegularPrice: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_regular_price")) + + member StartDate: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "start_date")) + + member StartDateString: JsonProvider+StringOrDateTime with get + JsonRuntime.GetPropertyPackedOrNull(this, "start_date_string") + + member StartDay: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "start_day")) + + member StartMonth: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "start_month")) + + member StartYear: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "start_year")) + + member StatementDesignId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "statement_design_id")) + + member Status: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "status") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Textbooks: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "textbooks"), new Func<_,_>(id))) + + member TopicId: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "topic_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member UniversityLogo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "university_logo") + + +class JsonProvider+University : FDR.BaseTypes.IJsonDocument + new : rectangularLogoSvg:string option -> wordmark:JsonValue -> websiteTwitter:string option -> chinaMirror:int option -> favicon:string option -> websiteFacebook:string option -> logo:string option -> backgroundColor:JsonValue -> id:int -> locationCity:string option -> locationCountry:string option -> locationLat:decimal option -> location:string option -> primaryColor:string option -> abbrName:string -> website:string option -> description:string option -> shortName:string -> landingPageBanner:string option -> mailingListId:JsonValue -> websiteYoutube:string option -> partnerType:int -> banner:string option -> locationState:string option -> name:string -> squareLogo:string option -> squareLogoSource:string option -> squareLogoSvg:string option -> locationLng:decimal option -> homeLink:string option -> classLogo:string option -> display:bool -> JsonProvider+University + JsonRuntime.CreateRecord([| ("rectangular_logo_svg", + (rectangularLogoSvg :> obj)) + ("wordmark", + (wordmark :> obj)) + ("website_twitter", + (websiteTwitter :> obj)) + ("china_mirror", + (chinaMirror :> obj)) + ("favicon", + (favicon :> obj)) + ("website_facebook", + (websiteFacebook :> obj)) + ("logo", + (logo :> obj)) + ("background_color", + (backgroundColor :> obj)) + ("id", + (id :> obj)) + ("location_city", + (locationCity :> obj)) + ("location_country", + (locationCountry :> obj)) + ("location_lat", + (locationLat :> obj)) + ("location", + (location :> obj)) + ("primary_color", + (primaryColor :> obj)) + ("abbr_name", + (abbrName :> obj)) + ("website", + (website :> obj)) + ("description", + (description :> obj)) + ("short_name", + (shortName :> obj)) + ("landing_page_banner", + (landingPageBanner :> obj)) + ("mailing_list_id", + (mailingListId :> obj)) + ("website_youtube", + (websiteYoutube :> obj)) + ("partner_type", + (partnerType :> obj)) + ("banner", + (banner :> obj)) + ("location_state", + (locationState :> obj)) + ("name", + (name :> obj)) + ("square_logo", + (squareLogo :> obj)) + ("square_logo_source", + (squareLogoSource :> obj)) + ("square_logo_svg", + (squareLogoSvg :> obj)) + ("location_lng", + (locationLng :> obj)) + ("home_link", + (homeLink :> obj)) + ("class_logo", + (classLogo :> obj)) + ("display", + (display :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+University + JsonDocument.Create(jsonValue, "") + + member AbbrName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "abbr_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member BackgroundColor: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "background_color") + + member Banner: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "banner")) + + member ChinaMirror: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "china_mirror")) + + member ClassLogo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "class_logo")) + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member Display: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Favicon: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "favicon")) + + member HomeLink: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "home_link")) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member LandingPageBanner: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "landing_page_banner")) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member LocationCity: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location_city")) + + member LocationCountry: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location_country")) + + member LocationLat: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "location_lat")) + + member LocationLng: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "location_lng")) + + member LocationState: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location_state")) + + member Logo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "logo")) + + member MailingListId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "mailing_list_id") + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PartnerType: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "partner_type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member PrimaryColor: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "primary_color")) + + member RectangularLogoSvg: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "rectangular_logo_svg")) + + member ShortName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SquareLogo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "square_logo")) + + member SquareLogoSource: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "square_logo_source")) + + member SquareLogoSvg: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "square_logo_svg")) + + member Website: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website")) + + member WebsiteFacebook: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website_facebook")) + + member WebsiteTwitter: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website_twitter")) + + member WebsiteYoutube: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website_youtube")) + + member Wordmark: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "wordmark") + + +class JsonProvider+IntOrString : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+IntOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+IntOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrString + JsonDocument.Create(jsonValue, "") + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Record : FDR.BaseTypes.IJsonDocument + new : gradeDistinction:decimal option -> shareForWork:bool option -> isEnrolledForProctoredExam:bool -> achievementLevel:int option -> signatureTrack:bool -> passedAce:bool -> aceGrade:int -> gradeNormal:decimal option -> verifyCertId:JsonValue -> authenticatedOverall:bool -> withGradeCertId:JsonValue -> JsonProvider+Record + JsonRuntime.CreateRecord([| ("grade_distinction", + (gradeDistinction :> obj)) + ("share_for_work", + (shareForWork :> obj)) + ("is_enrolled_for_proctored_exam", + (isEnrolledForProctoredExam :> obj)) + ("achievement_level", + (achievementLevel :> obj)) + ("signature_track", + (signatureTrack :> obj)) + ("passed_ace", + (passedAce :> obj)) + ("ace_grade", + (aceGrade :> obj)) + ("grade_normal", + (gradeNormal :> obj)) + ("verify_cert_id", + (verifyCertId :> obj)) + ("authenticated_overall", + (authenticatedOverall :> obj)) + ("with_grade_cert_id", + (withGradeCertId :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Record + JsonDocument.Create(jsonValue, "") + + member AceGrade: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "ace_grade") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member AchievementLevel: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "achievement_level")) + + member AuthenticatedOverall: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "authenticated_overall") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member GradeDistinction: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "grade_distinction")) + + member GradeNormal: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "grade_normal")) + + member IsEnrolledForProctoredExam: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_enrolled_for_proctored_exam") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member PassedAce: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "passed_ace") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ShareForWork: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "share_for_work")) + + member SignatureTrack: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "signature_track") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member VerifyCertId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "verify_cert_id") + + member WithGradeCertId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "with_grade_cert_id") + + +class JsonProvider+StringOrDateTime : FDR.BaseTypes.IJsonDocument + new : string:string -> JsonProvider+StringOrDateTime + JsonRuntime.CreateValue((string :> obj), "") + + new : dateTime:System.DateTime -> JsonProvider+StringOrDateTime + JsonRuntime.CreateValue((dateTime :> obj), "") + + new : () -> JsonProvider+StringOrDateTime + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+StringOrDateTime + JsonDocument.Create(jsonValue, "") + + member DateTime: System.DateTime option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "DateTime", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDateTime("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..f6796d5ff --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,713 @@ +class JsonProvider : obj + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Topic[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Topic[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Topic : FDR.BaseTypes.IJsonDocument + new : photo:string -> previewLink:string option -> smallIconHover:string -> largeIcon:string -> video:string option -> universityIds:string[] -> id:int -> universities:JsonProvider+JsonProvider+University[] -> selfServiceCourseId:int option -> shortDescription:string -> shortName:string -> categoryIds:string[] -> visibility:int option -> smallIcon:string -> instructor:string option -> categories:JsonProvider+JsonProvider+Category[] -> name:string -> language:string -> courses:JsonProvider+JsonProvider+Course[] -> universityLogo:string option -> courseIds:int[] -> display:bool -> subtitleLanguagesCsv:string option -> JsonProvider+Topic + JsonRuntime.CreateRecord([| ("photo", + (photo :> obj)) + ("preview_link", + (previewLink :> obj)) + ("small_icon_hover", + (smallIconHover :> obj)) + ("large_icon", + (largeIcon :> obj)) + ("video", + (video :> obj)) + ("university-ids", + (universityIds :> obj)) + ("id", + (id :> obj)) + ("universities", + (universities :> obj)) + ("self_service_course_id", + (selfServiceCourseId :> obj)) + ("short_description", + (shortDescription :> obj)) + ("short_name", + (shortName :> obj)) + ("category-ids", + (categoryIds :> obj)) + ("visibility", + (visibility :> obj)) + ("small_icon", + (smallIcon :> obj)) + ("instructor", + (instructor :> obj)) + ("categories", + (categories :> obj)) + ("name", + (name :> obj)) + ("language", + (language :> obj)) + ("courses", + (courses :> obj)) + ("university_logo", + (universityLogo :> obj)) + ("course-ids", + (courseIds :> obj)) + ("display", + (display :> obj)) + ("subtitle_languages_csv", + (subtitleLanguagesCsv :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Topic + JsonDocument.Create(jsonValue, "") + + member Categories: JsonProvider+JsonProvider+Category[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "categories"), new Func<_,_>(id))) + + member CategoryIds: string[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "category-ids"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + member CourseIds: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "course-ids"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Courses: JsonProvider+JsonProvider+Course[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "courses"), new Func<_,_>(id))) + + member Display: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Instructor: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "instructor")) + + member Language: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "language") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LargeIcon: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "large_icon") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Photo: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "photo") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PreviewLink: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "preview_link")) + + member SelfServiceCourseId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "self_service_course_id")) + + member ShortDescription: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_description") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ShortName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SmallIcon: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "small_icon") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SmallIconHover: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "small_icon_hover") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SubtitleLanguagesCsv: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "subtitle_languages_csv")) + + member Universities: JsonProvider+JsonProvider+University[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "universities"), new Func<_,_>(id))) + + member UniversityIds: string[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "university-ids"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + member UniversityLogo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "university_logo")) + + member Video: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "video")) + + member Visibility: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "visibility")) + + +class JsonProvider+Category : FDR.BaseTypes.IJsonDocument + new : id:int -> name:string -> mailingListId:int option -> shortName:string -> description:string option -> JsonProvider+Category + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("name", + (name :> obj)) + ("mailing_list_id", + (mailingListId :> obj)) + ("short_name", + (shortName :> obj)) + ("description", + (description :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Category + JsonDocument.Create(jsonValue, "") + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member MailingListId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "mailing_list_id")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ShortName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Course : FDR.BaseTypes.IJsonDocument + new : gradingPolicyDistinction:string option -> aceTrackPriceDisplay:JsonValue -> signatureTrackCertificateDesignId:JsonValue -> aceSemesterHours:JsonValue -> startDay:int option -> durationString:string option -> signatureTrackLastChanceTime:System.DateTime option -> id:int -> startMonth:int option -> certificateDescription:string option -> startDateString:JsonProvider+StringOrDateTime -> cheggSessionId:JsonValue -> signatureTrackRegularPrice:int option -> gradesReleaseDate:System.DateTime option -> certificatesReady:bool -> signatureTrackPrice:int option -> statementDesignId:int option -> signatureTrackRegistrationOpen:bool -> topicId:int -> eligibleForSignatureTrack:bool -> startDate:System.DateTime option -> record:JsonProvider+Record -> status:bool -> startYear:int option -> signatureTrackCertificateCombinedSignature:JsonValue -> endDate:JsonValue -> notifiedSubscribers:bool -> instructors:int[] -> active:bool -> eligibleForCertificates:bool -> signatureTrackCertificateSignatureBlurb:JsonValue -> deployed:bool -> aceCloseDate:JsonValue -> name:JsonProvider+IntOrString -> textbooks:JsonValue[] -> signatureTrackOpenTime:System.DateTime option -> eligibleForAce:bool option -> gradingPolicyNormal:string option -> aceOpenDate:JsonValue -> homeLink:string option -> creatorId:int option -> proctoredExamCompletionDate:JsonValue -> universityLogo:JsonValue -> signatureTrackCloseTime:System.DateTime option -> authReviewCompletionDate:JsonValue -> JsonProvider+Course + JsonRuntime.CreateRecord([| ("grading_policy_distinction", + (gradingPolicyDistinction :> obj)) + ("ace_track_price_display", + (aceTrackPriceDisplay :> obj)) + ("signature_track_certificate_design_id", + (signatureTrackCertificateDesignId :> obj)) + ("ace_semester_hours", + (aceSemesterHours :> obj)) + ("start_day", + (startDay :> obj)) + ("duration_string", + (durationString :> obj)) + ("signature_track_last_chance_time", + (signatureTrackLastChanceTime :> obj)) + ("id", + (id :> obj)) + ("start_month", + (startMonth :> obj)) + ("certificate_description", + (certificateDescription :> obj)) + ("start_date_string", + (startDateString :> obj)) + ("chegg_session_id", + (cheggSessionId :> obj)) + ("signature_track_regular_price", + (signatureTrackRegularPrice :> obj)) + ("grades_release_date", + (gradesReleaseDate :> obj)) + ("certificates_ready", + (certificatesReady :> obj)) + ("signature_track_price", + (signatureTrackPrice :> obj)) + ("statement_design_id", + (statementDesignId :> obj)) + ("signature_track_registration_open", + (signatureTrackRegistrationOpen :> obj)) + ("topic_id", + (topicId :> obj)) + ("eligible_for_signature_track", + (eligibleForSignatureTrack :> obj)) + ("start_date", + (startDate :> obj)) + ("record", + (record :> obj)) + ("status", + (status :> obj)) + ("start_year", + (startYear :> obj)) + ("signature_track_certificate_combined_signature", + (signatureTrackCertificateCombinedSignature :> obj)) + ("end_date", + (endDate :> obj)) + ("notified_subscribers", + (notifiedSubscribers :> obj)) + ("instructors", + (instructors :> obj)) + ("active", + (active :> obj)) + ("eligible_for_certificates", + (eligibleForCertificates :> obj)) + ("signature_track_certificate_signature_blurb", + (signatureTrackCertificateSignatureBlurb :> obj)) + ("deployed", + (deployed :> obj)) + ("ace_close_date", + (aceCloseDate :> obj)) + ("name", + (name :> obj)) + ("textbooks", + (textbooks :> obj)) + ("signature_track_open_time", + (signatureTrackOpenTime :> obj)) + ("eligible_for_ACE", + (eligibleForAce :> obj)) + ("grading_policy_normal", + (gradingPolicyNormal :> obj)) + ("ace_open_date", + (aceOpenDate :> obj)) + ("home_link", + (homeLink :> obj)) + ("creator_id", + (creatorId :> obj)) + ("proctored_exam_completion_date", + (proctoredExamCompletionDate :> obj)) + ("university_logo", + (universityLogo :> obj)) + ("signature_track_close_time", + (signatureTrackCloseTime :> obj)) + ("auth_review_completion_date", + (authReviewCompletionDate :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Course + JsonDocument.Create(jsonValue, "") + + member AceCloseDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_close_date") + + member AceOpenDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_open_date") + + member AceSemesterHours: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_semester_hours") + + member AceTrackPriceDisplay: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_track_price_display") + + member Active: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "active") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member AuthReviewCompletionDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "auth_review_completion_date") + + member CertificateDescription: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "certificate_description")) + + member CertificatesReady: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "certificates_ready") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CheggSessionId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "chegg_session_id") + + member CreatorId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "creator_id")) + + member Deployed: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "deployed") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DurationString: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "duration_string")) + + member EligibleForAce: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "eligible_for_ACE")) + + member EligibleForCertificates: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "eligible_for_certificates") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member EligibleForSignatureTrack: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "eligible_for_signature_track") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member EndDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "end_date") + + member GradesReleaseDate: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "grades_release_date")) + + member GradingPolicyDistinction: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "grading_policy_distinction")) + + member GradingPolicyNormal: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "grading_policy_normal")) + + member HomeLink: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "home_link")) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Instructors: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "instructors"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Name: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "name") + + member NotifiedSubscribers: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "notified_subscribers") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProctoredExamCompletionDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "proctored_exam_completion_date") + + member Record: JsonProvider+Record with get + JsonRuntime.GetPropertyPacked(this, "record") + + member SignatureTrackCertificateCombinedSignature: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "signature_track_certificate_combined_signature") + + member SignatureTrackCertificateDesignId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "signature_track_certificate_design_id") + + member SignatureTrackCertificateSignatureBlurb: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "signature_track_certificate_signature_blurb") + + member SignatureTrackCloseTime: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_close_time")) + + member SignatureTrackLastChanceTime: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_last_chance_time")) + + member SignatureTrackOpenTime: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_open_time")) + + member SignatureTrackPrice: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_price")) + + member SignatureTrackRegistrationOpen: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "signature_track_registration_open") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member SignatureTrackRegularPrice: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_regular_price")) + + member StartDate: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "start_date")) + + member StartDateString: JsonProvider+StringOrDateTime with get + JsonRuntime.GetPropertyPackedOrNull(this, "start_date_string") + + member StartDay: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "start_day")) + + member StartMonth: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "start_month")) + + member StartYear: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "start_year")) + + member StatementDesignId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "statement_design_id")) + + member Status: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "status") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Textbooks: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "textbooks"), new Func<_,_>(id))) + + member TopicId: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "topic_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member UniversityLogo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "university_logo") + + +class JsonProvider+University : FDR.BaseTypes.IJsonDocument + new : rectangularLogoSvg:string option -> wordmark:JsonValue -> websiteTwitter:string option -> chinaMirror:int option -> favicon:string option -> websiteFacebook:string option -> logo:string option -> backgroundColor:JsonValue -> id:int -> locationCity:string option -> locationCountry:string option -> locationLat:decimal option -> location:string option -> primaryColor:string option -> abbrName:string -> website:string option -> description:string option -> shortName:string -> landingPageBanner:string option -> mailingListId:JsonValue -> websiteYoutube:string option -> partnerType:int -> banner:string option -> locationState:string option -> name:string -> squareLogo:string option -> squareLogoSource:string option -> squareLogoSvg:string option -> locationLng:decimal option -> homeLink:string option -> classLogo:string option -> display:bool -> JsonProvider+University + JsonRuntime.CreateRecord([| ("rectangular_logo_svg", + (rectangularLogoSvg :> obj)) + ("wordmark", + (wordmark :> obj)) + ("website_twitter", + (websiteTwitter :> obj)) + ("china_mirror", + (chinaMirror :> obj)) + ("favicon", + (favicon :> obj)) + ("website_facebook", + (websiteFacebook :> obj)) + ("logo", + (logo :> obj)) + ("background_color", + (backgroundColor :> obj)) + ("id", + (id :> obj)) + ("location_city", + (locationCity :> obj)) + ("location_country", + (locationCountry :> obj)) + ("location_lat", + (locationLat :> obj)) + ("location", + (location :> obj)) + ("primary_color", + (primaryColor :> obj)) + ("abbr_name", + (abbrName :> obj)) + ("website", + (website :> obj)) + ("description", + (description :> obj)) + ("short_name", + (shortName :> obj)) + ("landing_page_banner", + (landingPageBanner :> obj)) + ("mailing_list_id", + (mailingListId :> obj)) + ("website_youtube", + (websiteYoutube :> obj)) + ("partner_type", + (partnerType :> obj)) + ("banner", + (banner :> obj)) + ("location_state", + (locationState :> obj)) + ("name", + (name :> obj)) + ("square_logo", + (squareLogo :> obj)) + ("square_logo_source", + (squareLogoSource :> obj)) + ("square_logo_svg", + (squareLogoSvg :> obj)) + ("location_lng", + (locationLng :> obj)) + ("home_link", + (homeLink :> obj)) + ("class_logo", + (classLogo :> obj)) + ("display", + (display :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+University + JsonDocument.Create(jsonValue, "") + + member AbbrName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "abbr_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member BackgroundColor: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "background_color") + + member Banner: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "banner")) + + member ChinaMirror: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "china_mirror")) + + member ClassLogo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "class_logo")) + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member Display: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Favicon: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "favicon")) + + member HomeLink: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "home_link")) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member LandingPageBanner: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "landing_page_banner")) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member LocationCity: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location_city")) + + member LocationCountry: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location_country")) + + member LocationLat: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "location_lat")) + + member LocationLng: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "location_lng")) + + member LocationState: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location_state")) + + member Logo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "logo")) + + member MailingListId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "mailing_list_id") + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PartnerType: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "partner_type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member PrimaryColor: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "primary_color")) + + member RectangularLogoSvg: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "rectangular_logo_svg")) + + member ShortName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SquareLogo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "square_logo")) + + member SquareLogoSource: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "square_logo_source")) + + member SquareLogoSvg: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "square_logo_svg")) + + member Website: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website")) + + member WebsiteFacebook: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website_facebook")) + + member WebsiteTwitter: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website_twitter")) + + member WebsiteYoutube: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website_youtube")) + + member Wordmark: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "wordmark") + + +class JsonProvider+IntOrString : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+IntOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+IntOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrString + JsonDocument.Create(jsonValue, "") + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Record : FDR.BaseTypes.IJsonDocument + new : gradeDistinction:decimal option -> shareForWork:bool option -> isEnrolledForProctoredExam:bool -> achievementLevel:int option -> signatureTrack:bool -> passedAce:bool -> aceGrade:int -> gradeNormal:decimal option -> verifyCertId:JsonValue -> authenticatedOverall:bool -> withGradeCertId:JsonValue -> JsonProvider+Record + JsonRuntime.CreateRecord([| ("grade_distinction", + (gradeDistinction :> obj)) + ("share_for_work", + (shareForWork :> obj)) + ("is_enrolled_for_proctored_exam", + (isEnrolledForProctoredExam :> obj)) + ("achievement_level", + (achievementLevel :> obj)) + ("signature_track", + (signatureTrack :> obj)) + ("passed_ace", + (passedAce :> obj)) + ("ace_grade", + (aceGrade :> obj)) + ("grade_normal", + (gradeNormal :> obj)) + ("verify_cert_id", + (verifyCertId :> obj)) + ("authenticated_overall", + (authenticatedOverall :> obj)) + ("with_grade_cert_id", + (withGradeCertId :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Record + JsonDocument.Create(jsonValue, "") + + member AceGrade: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "ace_grade") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member AchievementLevel: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "achievement_level")) + + member AuthenticatedOverall: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "authenticated_overall") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member GradeDistinction: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "grade_distinction")) + + member GradeNormal: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "grade_normal")) + + member IsEnrolledForProctoredExam: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_enrolled_for_proctored_exam") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member PassedAce: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "passed_ace") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ShareForWork: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "share_for_work")) + + member SignatureTrack: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "signature_track") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member VerifyCertId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "verify_cert_id") + + member WithGradeCertId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "with_grade_cert_id") + + +class JsonProvider+StringOrDateTime : FDR.BaseTypes.IJsonDocument + new : string:string -> JsonProvider+StringOrDateTime + JsonRuntime.CreateValue((string :> obj), "") + + new : dateTime:System.DateTime -> JsonProvider+StringOrDateTime + JsonRuntime.CreateValue((dateTime :> obj), "") + + new : () -> JsonProvider+StringOrDateTime + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+StringOrDateTime + JsonDocument.Create(jsonValue, "") + + member DateTime: System.DateTime option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "DateTime", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDateTime("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,ValuesOnly.expected new file mode 100644 index 000000000..f6796d5ff --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Json,topics.json,True,Topic,,True,False,ValuesOnly.expected @@ -0,0 +1,713 @@ +class JsonProvider : obj + static member AsyncLoad: uri:string -> JsonProvider+JsonProvider+Topic[] async + let f = new Func<_,_>(fun (t:TextReader) -> JsonRuntime.ConvertArray(JsonDocument.Create(t), new Func<_,_>(id)))) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri), f) + + static member Load: stream:System.IO.Stream -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StreamReader(stream)) :> TextReader)), new Func<_,_>(id))) + + static member Load: reader:System.IO.TextReader -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(reader), new Func<_,_>(id))) + + static member Load: uri:string -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "JSON" "" uri))), new Func<_,_>(id))) + + static member Load: value:JsonValue -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(value, ""), new Func<_,_>(id))) + + static member Parse: text:string -> JsonProvider+JsonProvider+Topic[] + JsonRuntime.ConvertArray(JsonDocument.Create(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + static member ParseList: text:string -> JsonProvider+JsonProvider+JsonProvider+Topic[][] + JsonRuntime.ConvertArray(JsonDocument.CreateList(((new StringReader(text)) :> TextReader)), new Func<_,_>(id))) + + +class JsonProvider+Topic : FDR.BaseTypes.IJsonDocument + new : photo:string -> previewLink:string option -> smallIconHover:string -> largeIcon:string -> video:string option -> universityIds:string[] -> id:int -> universities:JsonProvider+JsonProvider+University[] -> selfServiceCourseId:int option -> shortDescription:string -> shortName:string -> categoryIds:string[] -> visibility:int option -> smallIcon:string -> instructor:string option -> categories:JsonProvider+JsonProvider+Category[] -> name:string -> language:string -> courses:JsonProvider+JsonProvider+Course[] -> universityLogo:string option -> courseIds:int[] -> display:bool -> subtitleLanguagesCsv:string option -> JsonProvider+Topic + JsonRuntime.CreateRecord([| ("photo", + (photo :> obj)) + ("preview_link", + (previewLink :> obj)) + ("small_icon_hover", + (smallIconHover :> obj)) + ("large_icon", + (largeIcon :> obj)) + ("video", + (video :> obj)) + ("university-ids", + (universityIds :> obj)) + ("id", + (id :> obj)) + ("universities", + (universities :> obj)) + ("self_service_course_id", + (selfServiceCourseId :> obj)) + ("short_description", + (shortDescription :> obj)) + ("short_name", + (shortName :> obj)) + ("category-ids", + (categoryIds :> obj)) + ("visibility", + (visibility :> obj)) + ("small_icon", + (smallIcon :> obj)) + ("instructor", + (instructor :> obj)) + ("categories", + (categories :> obj)) + ("name", + (name :> obj)) + ("language", + (language :> obj)) + ("courses", + (courses :> obj)) + ("university_logo", + (universityLogo :> obj)) + ("course-ids", + (courseIds :> obj)) + ("display", + (display :> obj)) + ("subtitle_languages_csv", + (subtitleLanguagesCsv :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Topic + JsonDocument.Create(jsonValue, "") + + member Categories: JsonProvider+JsonProvider+Category[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "categories"), new Func<_,_>(id))) + + member CategoryIds: string[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "category-ids"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + member CourseIds: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "course-ids"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Courses: JsonProvider+JsonProvider+Course[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "courses"), new Func<_,_>(id))) + + member Display: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Instructor: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "instructor")) + + member Language: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "language") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member LargeIcon: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "large_icon") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Photo: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "photo") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PreviewLink: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "preview_link")) + + member SelfServiceCourseId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "self_service_course_id")) + + member ShortDescription: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_description") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ShortName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SmallIcon: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "small_icon") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SmallIconHover: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "small_icon_hover") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SubtitleLanguagesCsv: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "subtitle_languages_csv")) + + member Universities: JsonProvider+JsonProvider+University[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "universities"), new Func<_,_>(id))) + + member UniversityIds: string[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "university-ids"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + member UniversityLogo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "university_logo")) + + member Video: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "video")) + + member Visibility: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "visibility")) + + +class JsonProvider+Category : FDR.BaseTypes.IJsonDocument + new : id:int -> name:string -> mailingListId:int option -> shortName:string -> description:string option -> JsonProvider+Category + JsonRuntime.CreateRecord([| ("id", + (id :> obj)) + ("name", + (name :> obj)) + ("mailing_list_id", + (mailingListId :> obj)) + ("short_name", + (shortName :> obj)) + ("description", + (description :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Category + JsonDocument.Create(jsonValue, "") + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member MailingListId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "mailing_list_id")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member ShortName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class JsonProvider+Course : FDR.BaseTypes.IJsonDocument + new : gradingPolicyDistinction:string option -> aceTrackPriceDisplay:JsonValue -> signatureTrackCertificateDesignId:JsonValue -> aceSemesterHours:JsonValue -> startDay:int option -> durationString:string option -> signatureTrackLastChanceTime:System.DateTime option -> id:int -> startMonth:int option -> certificateDescription:string option -> startDateString:JsonProvider+StringOrDateTime -> cheggSessionId:JsonValue -> signatureTrackRegularPrice:int option -> gradesReleaseDate:System.DateTime option -> certificatesReady:bool -> signatureTrackPrice:int option -> statementDesignId:int option -> signatureTrackRegistrationOpen:bool -> topicId:int -> eligibleForSignatureTrack:bool -> startDate:System.DateTime option -> record:JsonProvider+Record -> status:bool -> startYear:int option -> signatureTrackCertificateCombinedSignature:JsonValue -> endDate:JsonValue -> notifiedSubscribers:bool -> instructors:int[] -> active:bool -> eligibleForCertificates:bool -> signatureTrackCertificateSignatureBlurb:JsonValue -> deployed:bool -> aceCloseDate:JsonValue -> name:JsonProvider+IntOrString -> textbooks:JsonValue[] -> signatureTrackOpenTime:System.DateTime option -> eligibleForAce:bool option -> gradingPolicyNormal:string option -> aceOpenDate:JsonValue -> homeLink:string option -> creatorId:int option -> proctoredExamCompletionDate:JsonValue -> universityLogo:JsonValue -> signatureTrackCloseTime:System.DateTime option -> authReviewCompletionDate:JsonValue -> JsonProvider+Course + JsonRuntime.CreateRecord([| ("grading_policy_distinction", + (gradingPolicyDistinction :> obj)) + ("ace_track_price_display", + (aceTrackPriceDisplay :> obj)) + ("signature_track_certificate_design_id", + (signatureTrackCertificateDesignId :> obj)) + ("ace_semester_hours", + (aceSemesterHours :> obj)) + ("start_day", + (startDay :> obj)) + ("duration_string", + (durationString :> obj)) + ("signature_track_last_chance_time", + (signatureTrackLastChanceTime :> obj)) + ("id", + (id :> obj)) + ("start_month", + (startMonth :> obj)) + ("certificate_description", + (certificateDescription :> obj)) + ("start_date_string", + (startDateString :> obj)) + ("chegg_session_id", + (cheggSessionId :> obj)) + ("signature_track_regular_price", + (signatureTrackRegularPrice :> obj)) + ("grades_release_date", + (gradesReleaseDate :> obj)) + ("certificates_ready", + (certificatesReady :> obj)) + ("signature_track_price", + (signatureTrackPrice :> obj)) + ("statement_design_id", + (statementDesignId :> obj)) + ("signature_track_registration_open", + (signatureTrackRegistrationOpen :> obj)) + ("topic_id", + (topicId :> obj)) + ("eligible_for_signature_track", + (eligibleForSignatureTrack :> obj)) + ("start_date", + (startDate :> obj)) + ("record", + (record :> obj)) + ("status", + (status :> obj)) + ("start_year", + (startYear :> obj)) + ("signature_track_certificate_combined_signature", + (signatureTrackCertificateCombinedSignature :> obj)) + ("end_date", + (endDate :> obj)) + ("notified_subscribers", + (notifiedSubscribers :> obj)) + ("instructors", + (instructors :> obj)) + ("active", + (active :> obj)) + ("eligible_for_certificates", + (eligibleForCertificates :> obj)) + ("signature_track_certificate_signature_blurb", + (signatureTrackCertificateSignatureBlurb :> obj)) + ("deployed", + (deployed :> obj)) + ("ace_close_date", + (aceCloseDate :> obj)) + ("name", + (name :> obj)) + ("textbooks", + (textbooks :> obj)) + ("signature_track_open_time", + (signatureTrackOpenTime :> obj)) + ("eligible_for_ACE", + (eligibleForAce :> obj)) + ("grading_policy_normal", + (gradingPolicyNormal :> obj)) + ("ace_open_date", + (aceOpenDate :> obj)) + ("home_link", + (homeLink :> obj)) + ("creator_id", + (creatorId :> obj)) + ("proctored_exam_completion_date", + (proctoredExamCompletionDate :> obj)) + ("university_logo", + (universityLogo :> obj)) + ("signature_track_close_time", + (signatureTrackCloseTime :> obj)) + ("auth_review_completion_date", + (authReviewCompletionDate :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Course + JsonDocument.Create(jsonValue, "") + + member AceCloseDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_close_date") + + member AceOpenDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_open_date") + + member AceSemesterHours: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_semester_hours") + + member AceTrackPriceDisplay: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "ace_track_price_display") + + member Active: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "active") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member AuthReviewCompletionDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "auth_review_completion_date") + + member CertificateDescription: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "certificate_description")) + + member CertificatesReady: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "certificates_ready") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member CheggSessionId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "chegg_session_id") + + member CreatorId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "creator_id")) + + member Deployed: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "deployed") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member DurationString: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "duration_string")) + + member EligibleForAce: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "eligible_for_ACE")) + + member EligibleForCertificates: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "eligible_for_certificates") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member EligibleForSignatureTrack: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "eligible_for_signature_track") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member EndDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "end_date") + + member GradesReleaseDate: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "grades_release_date")) + + member GradingPolicyDistinction: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "grading_policy_distinction")) + + member GradingPolicyNormal: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "grading_policy_normal")) + + member HomeLink: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "home_link")) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Instructors: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "instructors"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Name: JsonProvider+IntOrString with get + JsonRuntime.GetPropertyPackedOrNull(this, "name") + + member NotifiedSubscribers: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "notified_subscribers") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ProctoredExamCompletionDate: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "proctored_exam_completion_date") + + member Record: JsonProvider+Record with get + JsonRuntime.GetPropertyPacked(this, "record") + + member SignatureTrackCertificateCombinedSignature: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "signature_track_certificate_combined_signature") + + member SignatureTrackCertificateDesignId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "signature_track_certificate_design_id") + + member SignatureTrackCertificateSignatureBlurb: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "signature_track_certificate_signature_blurb") + + member SignatureTrackCloseTime: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_close_time")) + + member SignatureTrackLastChanceTime: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_last_chance_time")) + + member SignatureTrackOpenTime: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_open_time")) + + member SignatureTrackPrice: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_price")) + + member SignatureTrackRegistrationOpen: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "signature_track_registration_open") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member SignatureTrackRegularPrice: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "signature_track_regular_price")) + + member StartDate: System.DateTime option with get + JsonRuntime.ConvertDateTime("", JsonRuntime.TryGetPropertyUnpacked(this, "start_date")) + + member StartDateString: JsonProvider+StringOrDateTime with get + JsonRuntime.GetPropertyPackedOrNull(this, "start_date_string") + + member StartDay: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "start_day")) + + member StartMonth: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "start_month")) + + member StartYear: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "start_year")) + + member StatementDesignId: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "statement_design_id")) + + member Status: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "status") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Textbooks: FDR.BaseTypes.IJsonDocument[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "textbooks"), new Func<_,_>(id))) + + member TopicId: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "topic_id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member UniversityLogo: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "university_logo") + + +class JsonProvider+University : FDR.BaseTypes.IJsonDocument + new : rectangularLogoSvg:string option -> wordmark:JsonValue -> websiteTwitter:string option -> chinaMirror:int option -> favicon:string option -> websiteFacebook:string option -> logo:string option -> backgroundColor:JsonValue -> id:int -> locationCity:string option -> locationCountry:string option -> locationLat:decimal option -> location:string option -> primaryColor:string option -> abbrName:string -> website:string option -> description:string option -> shortName:string -> landingPageBanner:string option -> mailingListId:JsonValue -> websiteYoutube:string option -> partnerType:int -> banner:string option -> locationState:string option -> name:string -> squareLogo:string option -> squareLogoSource:string option -> squareLogoSvg:string option -> locationLng:decimal option -> homeLink:string option -> classLogo:string option -> display:bool -> JsonProvider+University + JsonRuntime.CreateRecord([| ("rectangular_logo_svg", + (rectangularLogoSvg :> obj)) + ("wordmark", + (wordmark :> obj)) + ("website_twitter", + (websiteTwitter :> obj)) + ("china_mirror", + (chinaMirror :> obj)) + ("favicon", + (favicon :> obj)) + ("website_facebook", + (websiteFacebook :> obj)) + ("logo", + (logo :> obj)) + ("background_color", + (backgroundColor :> obj)) + ("id", + (id :> obj)) + ("location_city", + (locationCity :> obj)) + ("location_country", + (locationCountry :> obj)) + ("location_lat", + (locationLat :> obj)) + ("location", + (location :> obj)) + ("primary_color", + (primaryColor :> obj)) + ("abbr_name", + (abbrName :> obj)) + ("website", + (website :> obj)) + ("description", + (description :> obj)) + ("short_name", + (shortName :> obj)) + ("landing_page_banner", + (landingPageBanner :> obj)) + ("mailing_list_id", + (mailingListId :> obj)) + ("website_youtube", + (websiteYoutube :> obj)) + ("partner_type", + (partnerType :> obj)) + ("banner", + (banner :> obj)) + ("location_state", + (locationState :> obj)) + ("name", + (name :> obj)) + ("square_logo", + (squareLogo :> obj)) + ("square_logo_source", + (squareLogoSource :> obj)) + ("square_logo_svg", + (squareLogoSvg :> obj)) + ("location_lng", + (locationLng :> obj)) + ("home_link", + (homeLink :> obj)) + ("class_logo", + (classLogo :> obj)) + ("display", + (display :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+University + JsonDocument.Create(jsonValue, "") + + member AbbrName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "abbr_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member BackgroundColor: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "background_color") + + member Banner: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "banner")) + + member ChinaMirror: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "china_mirror")) + + member ClassLogo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "class_logo")) + + member Description: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "description")) + + member Display: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "display") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Favicon: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "favicon")) + + member HomeLink: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "home_link")) + + member Id: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "id") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member LandingPageBanner: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "landing_page_banner")) + + member Location: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location")) + + member LocationCity: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location_city")) + + member LocationCountry: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location_country")) + + member LocationLat: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "location_lat")) + + member LocationLng: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "location_lng")) + + member LocationState: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "location_state")) + + member Logo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "logo")) + + member MailingListId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "mailing_list_id") + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member PartnerType: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "partner_type") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member PrimaryColor: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "primary_color")) + + member RectangularLogoSvg: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "rectangular_logo_svg")) + + member ShortName: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "short_name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SquareLogo: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "square_logo")) + + member SquareLogoSource: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "square_logo_source")) + + member SquareLogoSvg: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "square_logo_svg")) + + member Website: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website")) + + member WebsiteFacebook: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website_facebook")) + + member WebsiteTwitter: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website_twitter")) + + member WebsiteYoutube: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "website_youtube")) + + member Wordmark: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "wordmark") + + +class JsonProvider+IntOrString : FDR.BaseTypes.IJsonDocument + new : number:int -> JsonProvider+IntOrString + JsonRuntime.CreateValue((number :> obj), "") + + new : string:string -> JsonProvider+IntOrString + JsonRuntime.CreateValue((string :> obj), "") + + new : () -> JsonProvider+IntOrString + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+IntOrString + JsonDocument.Create(jsonValue, "") + + member Number: int option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "Number", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + +class JsonProvider+Record : FDR.BaseTypes.IJsonDocument + new : gradeDistinction:decimal option -> shareForWork:bool option -> isEnrolledForProctoredExam:bool -> achievementLevel:int option -> signatureTrack:bool -> passedAce:bool -> aceGrade:int -> gradeNormal:decimal option -> verifyCertId:JsonValue -> authenticatedOverall:bool -> withGradeCertId:JsonValue -> JsonProvider+Record + JsonRuntime.CreateRecord([| ("grade_distinction", + (gradeDistinction :> obj)) + ("share_for_work", + (shareForWork :> obj)) + ("is_enrolled_for_proctored_exam", + (isEnrolledForProctoredExam :> obj)) + ("achievement_level", + (achievementLevel :> obj)) + ("signature_track", + (signatureTrack :> obj)) + ("passed_ace", + (passedAce :> obj)) + ("ace_grade", + (aceGrade :> obj)) + ("grade_normal", + (gradeNormal :> obj)) + ("verify_cert_id", + (verifyCertId :> obj)) + ("authenticated_overall", + (authenticatedOverall :> obj)) + ("with_grade_cert_id", + (withGradeCertId :> obj)) |], "") + + new : jsonValue:JsonValue -> JsonProvider+Record + JsonDocument.Create(jsonValue, "") + + member AceGrade: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "ace_grade") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member AchievementLevel: int option with get + JsonRuntime.ConvertInteger("", JsonRuntime.TryGetPropertyUnpacked(this, "achievement_level")) + + member AuthenticatedOverall: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "authenticated_overall") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member GradeDistinction: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "grade_distinction")) + + member GradeNormal: decimal option with get + JsonRuntime.ConvertDecimal("", JsonRuntime.TryGetPropertyUnpacked(this, "grade_normal")) + + member IsEnrolledForProctoredExam: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "is_enrolled_for_proctored_exam") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member PassedAce: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "passed_ace") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member ShareForWork: bool option with get + JsonRuntime.ConvertBoolean(JsonRuntime.TryGetPropertyUnpacked(this, "share_for_work")) + + member SignatureTrack: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "signature_track") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member VerifyCertId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "verify_cert_id") + + member WithGradeCertId: FDR.BaseTypes.IJsonDocument with get + JsonRuntime.GetPropertyPackedOrNull(this, "with_grade_cert_id") + + +class JsonProvider+StringOrDateTime : FDR.BaseTypes.IJsonDocument + new : string:string -> JsonProvider+StringOrDateTime + JsonRuntime.CreateValue((string :> obj), "") + + new : dateTime:System.DateTime -> JsonProvider+StringOrDateTime + JsonRuntime.CreateValue((dateTime :> obj), "") + + new : () -> JsonProvider+StringOrDateTime + JsonRuntime.CreateValue(null, "") + + new : jsonValue:JsonValue -> JsonProvider+StringOrDateTime + JsonDocument.Create(jsonValue, "") + + member DateTime: System.DateTime option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "DateTime", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertDateTime("", Some t.JsonValue), Some t.JsonValue))) + + member String: string option with get + JsonRuntime.TryGetValueByTypeTag(this, "", "String", new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertString("", Some t.JsonValue), Some t.JsonValue))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,IncludeFromWeb.xsd.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,IncludeFromWeb.xsd,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,IncludeFromWeb.xsd.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,IncludeFromWeb.xsd,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,homonim.xsd.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,homonim.xsd,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,homonim.xsd.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,homonim.xsd,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,po.xsd.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,po.xsd,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,po.xsd.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,,False,False,,False,po.xsd,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..548585caf --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,272 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Choice[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "AnyFeed.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Choice async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Choice[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "AnyFeed.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Choice + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Choice + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Choice + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Choice + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Choice : FDR.BaseTypes.XmlElement + new : rss:XmlProvider+Rss -> XmlProvider+Choice + rss + + new : feed:XmlProvider+Feed -> XmlProvider+Choice + feed + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Choice + XmlElement.Create(xElement) + + member Feed: XmlProvider+Feed option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}feed", new Func<_,_>(id))) + + member Rss: XmlProvider+Rss option with get + XmlRuntime.ConvertAsName(this, "rss", new Func<_,_>(id))) + + +class XmlProvider+Feed : FDR.BaseTypes.XmlElement + new : title:string -> subtitle:string -> links:XmlProvider+XmlProvider+Link[] -> id:string -> updated:System.DateTimeOffset -> entry:XmlProvider+Entry -> XmlProvider+Feed + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}feed", + [| |], + [| ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}subtitle", + (subtitle :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://www.w3.org/2005/Atom}entry", + (entry :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Feed + XmlElement.Create(xElement) + + member Entry: XmlProvider+Entry with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}entry") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Subtitle: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}subtitle")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) + ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Entry : FDR.BaseTypes.XmlElement + new : title:string -> links:XmlProvider+XmlProvider+Link2[] -> id:string -> updated:System.DateTimeOffset -> summary:string -> author:XmlProvider+Author -> XmlProvider+Entry + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}entry", + [| |], + [| ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://www.w3.org/2005/Atom}summary", + (summary :> obj)) + ("{http://www.w3.org/2005/Atom}author", + (author :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Entry + XmlElement.Create(xElement) + + member Author: XmlProvider+Author with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}author") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link2[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Summary: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}summary")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Link : FDR.BaseTypes.XmlElement + new : href:string -> rel:string option -> XmlProvider+Link + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "rel")) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> email:string -> XmlProvider+Author + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}author", + [| |], + [| ("{http://www.w3.org/2005/Atom}name", + (name :> obj)) + ("{http://www.w3.org/2005/Atom}email", + (email :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Email: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}email")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Link2 : FDR.BaseTypes.XmlElement + new : href:string -> rel:string option -> type:string option -> XmlProvider+Link2 + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("href", + (href :> obj)) + ("rel", + (rel :> obj)) + ("type", + (type :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link2 + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "rel")) + + member Type: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "type")) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..548585caf --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,272 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Choice[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "AnyFeed.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Choice async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Choice[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "AnyFeed.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Choice + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Choice + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Choice + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Choice + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Choice : FDR.BaseTypes.XmlElement + new : rss:XmlProvider+Rss -> XmlProvider+Choice + rss + + new : feed:XmlProvider+Feed -> XmlProvider+Choice + feed + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Choice + XmlElement.Create(xElement) + + member Feed: XmlProvider+Feed option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}feed", new Func<_,_>(id))) + + member Rss: XmlProvider+Rss option with get + XmlRuntime.ConvertAsName(this, "rss", new Func<_,_>(id))) + + +class XmlProvider+Feed : FDR.BaseTypes.XmlElement + new : title:string -> subtitle:string -> links:XmlProvider+XmlProvider+Link[] -> id:string -> updated:System.DateTimeOffset -> entry:XmlProvider+Entry -> XmlProvider+Feed + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}feed", + [| |], + [| ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}subtitle", + (subtitle :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://www.w3.org/2005/Atom}entry", + (entry :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Feed + XmlElement.Create(xElement) + + member Entry: XmlProvider+Entry with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}entry") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Subtitle: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}subtitle")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) + ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Entry : FDR.BaseTypes.XmlElement + new : title:string -> links:XmlProvider+XmlProvider+Link2[] -> id:string -> updated:System.DateTimeOffset -> summary:string -> author:XmlProvider+Author -> XmlProvider+Entry + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}entry", + [| |], + [| ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://www.w3.org/2005/Atom}summary", + (summary :> obj)) + ("{http://www.w3.org/2005/Atom}author", + (author :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Entry + XmlElement.Create(xElement) + + member Author: XmlProvider+Author with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}author") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link2[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Summary: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}summary")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Link : FDR.BaseTypes.XmlElement + new : href:string -> rel:string option -> XmlProvider+Link + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "rel")) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> email:string -> XmlProvider+Author + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}author", + [| |], + [| ("{http://www.w3.org/2005/Atom}name", + (name :> obj)) + ("{http://www.w3.org/2005/Atom}email", + (email :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Email: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}email")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Link2 : FDR.BaseTypes.XmlElement + new : href:string -> rel:string option -> type:string option -> XmlProvider+Link2 + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("href", + (href :> obj)) + ("rel", + (rel :> obj)) + ("type", + (type :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link2 + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "rel")) + + member Type: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "type")) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..548585caf --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,AnyFeed.xml,True,False,,True,,ValuesOnly.expected @@ -0,0 +1,272 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Choice[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "AnyFeed.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Choice async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Choice[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "AnyFeed.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Choice + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Choice + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Choice + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Choice + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Choice : FDR.BaseTypes.XmlElement + new : rss:XmlProvider+Rss -> XmlProvider+Choice + rss + + new : feed:XmlProvider+Feed -> XmlProvider+Choice + feed + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Choice + XmlElement.Create(xElement) + + member Feed: XmlProvider+Feed option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}feed", new Func<_,_>(id))) + + member Rss: XmlProvider+Rss option with get + XmlRuntime.ConvertAsName(this, "rss", new Func<_,_>(id))) + + +class XmlProvider+Feed : FDR.BaseTypes.XmlElement + new : title:string -> subtitle:string -> links:XmlProvider+XmlProvider+Link[] -> id:string -> updated:System.DateTimeOffset -> entry:XmlProvider+Entry -> XmlProvider+Feed + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}feed", + [| |], + [| ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}subtitle", + (subtitle :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://www.w3.org/2005/Atom}entry", + (entry :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Feed + XmlElement.Create(xElement) + + member Entry: XmlProvider+Entry with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}entry") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Subtitle: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}subtitle")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) + ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Entry : FDR.BaseTypes.XmlElement + new : title:string -> links:XmlProvider+XmlProvider+Link2[] -> id:string -> updated:System.DateTimeOffset -> summary:string -> author:XmlProvider+Author -> XmlProvider+Entry + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}entry", + [| |], + [| ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://www.w3.org/2005/Atom}summary", + (summary :> obj)) + ("{http://www.w3.org/2005/Atom}author", + (author :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Entry + XmlElement.Create(xElement) + + member Author: XmlProvider+Author with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}author") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link2[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Summary: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}summary")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Link : FDR.BaseTypes.XmlElement + new : href:string -> rel:string option -> XmlProvider+Link + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "rel")) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> email:string -> XmlProvider+Author + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}author", + [| |], + [| ("{http://www.w3.org/2005/Atom}name", + (name :> obj)) + ("{http://www.w3.org/2005/Atom}email", + (email :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Email: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}email")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Link2 : FDR.BaseTypes.XmlElement + new : href:string -> rel:string option -> type:string option -> XmlProvider+Link2 + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("href", + (href :> obj)) + ("rel", + (rel :> obj)) + ("type", + (type :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link2 + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "rel")) + + member Type: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "type")) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..78e31ee99 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,78 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Div + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Div + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Div + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Div : FDR.BaseTypes.XmlElement + new : id:string -> span:string -> divs:XmlProvider+XmlProvider+Div2[] -> XmlProvider+Div + XmlRuntime.CreateRecord("div", + [| ("id", + (id :> obj)) |], + [| ("span", + (span :> obj)) + ("div", + (divs :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Div + XmlElement.Create(xElement) + + member Divs: XmlProvider+XmlProvider+Div2[] with get + XmlRuntime.ConvertArray(this, "div", new Func<_,_>(id))) + + member Id: string with get + let value = XmlRuntime.TryGetAttribute(this, "id") + TextRuntime.GetNonOptionalValue("Attribute id", TextRuntime.ConvertString(value), value) + + member Span: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "span")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Div2 : FDR.BaseTypes.XmlElement + new : id:string -> spans:string[] -> div:string option -> XmlProvider+Div2 + XmlRuntime.CreateRecord("div", + [| ("id", + (id :> obj)) |], + [| ("span", + (spans :> obj)) + ("div", + (div :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Div2 + XmlElement.Create(xElement) + + member Div: string option with get + XmlRuntime.ConvertOptional(this, "div", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Id: string with get + let value = XmlRuntime.TryGetAttribute(this, "id") + TextRuntime.GetNonOptionalValue("Attribute id", TextRuntime.ConvertString(value), value) + + member Spans: string[] with get + XmlRuntime.ConvertArray(this, "span", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..78e31ee99 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,78 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Div + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Div + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Div + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Div : FDR.BaseTypes.XmlElement + new : id:string -> span:string -> divs:XmlProvider+XmlProvider+Div2[] -> XmlProvider+Div + XmlRuntime.CreateRecord("div", + [| ("id", + (id :> obj)) |], + [| ("span", + (span :> obj)) + ("div", + (divs :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Div + XmlElement.Create(xElement) + + member Divs: XmlProvider+XmlProvider+Div2[] with get + XmlRuntime.ConvertArray(this, "div", new Func<_,_>(id))) + + member Id: string with get + let value = XmlRuntime.TryGetAttribute(this, "id") + TextRuntime.GetNonOptionalValue("Attribute id", TextRuntime.ConvertString(value), value) + + member Span: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "span")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Div2 : FDR.BaseTypes.XmlElement + new : id:string -> spans:string[] -> div:string option -> XmlProvider+Div2 + XmlRuntime.CreateRecord("div", + [| ("id", + (id :> obj)) |], + [| ("span", + (spans :> obj)) + ("div", + (div :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Div2 + XmlElement.Create(xElement) + + member Div: string option with get + XmlRuntime.ConvertOptional(this, "div", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Id: string with get + let value = XmlRuntime.TryGetAttribute(this, "id") + TextRuntime.GetNonOptionalValue("Attribute id", TextRuntime.ConvertString(value), value) + + member Spans: string[] with get + XmlRuntime.ConvertArray(this, "span", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..78e31ee99 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,78 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Div + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Div + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Div + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Div : FDR.BaseTypes.XmlElement + new : id:string -> span:string -> divs:XmlProvider+XmlProvider+Div2[] -> XmlProvider+Div + XmlRuntime.CreateRecord("div", + [| ("id", + (id :> obj)) |], + [| ("span", + (span :> obj)) + ("div", + (divs :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Div + XmlElement.Create(xElement) + + member Divs: XmlProvider+XmlProvider+Div2[] with get + XmlRuntime.ConvertArray(this, "div", new Func<_,_>(id))) + + member Id: string with get + let value = XmlRuntime.TryGetAttribute(this, "id") + TextRuntime.GetNonOptionalValue("Attribute id", TextRuntime.ConvertString(value), value) + + member Span: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "span")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Div2 : FDR.BaseTypes.XmlElement + new : id:string -> spans:string[] -> div:string option -> XmlProvider+Div2 + XmlRuntime.CreateRecord("div", + [| ("id", + (id :> obj)) |], + [| ("span", + (spans :> obj)) + ("div", + (div :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Div2 + XmlElement.Create(xElement) + + member Div: string option with get + XmlRuntime.ConvertOptional(this, "div", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Id: string with get + let value = XmlRuntime.TryGetAttribute(this, "id") + TextRuntime.GetNonOptionalValue("Attribute id", TextRuntime.ConvertString(value), value) + + member Spans: string[] with get + XmlRuntime.ConvertArray(this, "span", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..235007588 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,55 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Div + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Div + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Div + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Div : FDR.BaseTypes.XmlElement + new : id:string option -> value:string option -> spans:string[] -> divs:XmlProvider+XmlProvider+Div[] -> XmlProvider+Div + XmlRuntime.CreateRecord("div", + [| ("id", + (id :> obj)) |], + [| ("", + (value :> obj)) + ("span", + (spans :> obj)) + ("div", + (divs :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Div + XmlElement.Create(xElement) + + member Divs: XmlProvider+XmlProvider+Div[] with get + XmlRuntime.ConvertArray(this, "div", new Func<_,_>(id))) + + member Id: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "id")) + + member Spans: string[] with get + XmlRuntime.ConvertArray(this, "span", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Value: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetValue(this)) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..235007588 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,55 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Div + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Div + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Div + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Div : FDR.BaseTypes.XmlElement + new : id:string option -> value:string option -> spans:string[] -> divs:XmlProvider+XmlProvider+Div[] -> XmlProvider+Div + XmlRuntime.CreateRecord("div", + [| ("id", + (id :> obj)) |], + [| ("", + (value :> obj)) + ("span", + (spans :> obj)) + ("div", + (divs :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Div + XmlElement.Create(xElement) + + member Divs: XmlProvider+XmlProvider+Div[] with get + XmlRuntime.ConvertArray(this, "div", new Func<_,_>(id))) + + member Id: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "id")) + + member Spans: string[] with get + XmlRuntime.ConvertArray(this, "span", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Value: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetValue(this)) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,ValuesOnly.expected new file mode 100644 index 000000000..235007588 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,HtmlBody.xml,False,True,,True,,ValuesOnly.expected @@ -0,0 +1,55 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Div async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "HtmlBody.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Div + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Div + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Div + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Div + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Div : FDR.BaseTypes.XmlElement + new : id:string option -> value:string option -> spans:string[] -> divs:XmlProvider+XmlProvider+Div[] -> XmlProvider+Div + XmlRuntime.CreateRecord("div", + [| ("id", + (id :> obj)) |], + [| ("", + (value :> obj)) + ("span", + (spans :> obj)) + ("div", + (divs :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Div + XmlElement.Create(xElement) + + member Divs: XmlProvider+XmlProvider+Div[] with get + XmlRuntime.ConvertArray(this, "div", new Func<_,_>(id))) + + member Id: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "id")) + + member Spans: string[] with get + XmlRuntime.ConvertArray(this, "span", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Value: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetValue(this)) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..7c53baaa4 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,69 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+ObjStation[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "IrelandStations.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+ObjStation async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+ObjStation[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "IrelandStations.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+ObjStation + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+ObjStation + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+ObjStation + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+ObjStation + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+ObjStation : FDR.BaseTypes.XmlElement + new : stationDesc:string -> stationAlias:string option -> stationLatitude:decimal -> stationLongitude:decimal -> stationCode:string -> stationId:int -> XmlProvider+ObjStation + XmlRuntime.CreateRecord("{http://api.irishrail.ie/realtime/}objStation", + [| |], + [| ("{http://api.irishrail.ie/realtime/}StationDesc", + (stationDesc :> obj)) + ("{http://api.irishrail.ie/realtime/}StationAlias", + (stationAlias :> obj)) + ("{http://api.irishrail.ie/realtime/}StationLatitude", + (stationLatitude :> obj)) + ("{http://api.irishrail.ie/realtime/}StationLongitude", + (stationLongitude :> obj)) + ("{http://api.irishrail.ie/realtime/}StationCode", + (stationCode :> obj)) + ("{http://api.irishrail.ie/realtime/}StationId", + (stationId :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+ObjStation + XmlElement.Create(xElement) + + member StationAlias: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationAlias"))) + + member StationCode: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationCode")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member StationDesc: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationDesc")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member StationId: int with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationId")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertInteger("", value), value) + + member StationLatitude: decimal with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationLatitude")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDecimal("", value), value) + + member StationLongitude: decimal with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationLongitude")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDecimal("", value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..7c53baaa4 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,69 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+ObjStation[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "IrelandStations.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+ObjStation async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+ObjStation[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "IrelandStations.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+ObjStation + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+ObjStation + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+ObjStation + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+ObjStation + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+ObjStation : FDR.BaseTypes.XmlElement + new : stationDesc:string -> stationAlias:string option -> stationLatitude:decimal -> stationLongitude:decimal -> stationCode:string -> stationId:int -> XmlProvider+ObjStation + XmlRuntime.CreateRecord("{http://api.irishrail.ie/realtime/}objStation", + [| |], + [| ("{http://api.irishrail.ie/realtime/}StationDesc", + (stationDesc :> obj)) + ("{http://api.irishrail.ie/realtime/}StationAlias", + (stationAlias :> obj)) + ("{http://api.irishrail.ie/realtime/}StationLatitude", + (stationLatitude :> obj)) + ("{http://api.irishrail.ie/realtime/}StationLongitude", + (stationLongitude :> obj)) + ("{http://api.irishrail.ie/realtime/}StationCode", + (stationCode :> obj)) + ("{http://api.irishrail.ie/realtime/}StationId", + (stationId :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+ObjStation + XmlElement.Create(xElement) + + member StationAlias: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationAlias"))) + + member StationCode: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationCode")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member StationDesc: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationDesc")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member StationId: int with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationId")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertInteger("", value), value) + + member StationLatitude: decimal with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationLatitude")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDecimal("", value), value) + + member StationLongitude: decimal with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationLongitude")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDecimal("", value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..7c53baaa4 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,IrelandStations.xml,True,False,,True,,ValuesOnly.expected @@ -0,0 +1,69 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+ObjStation[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "IrelandStations.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+ObjStation async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+ObjStation[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "IrelandStations.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+ObjStation + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+ObjStation + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+ObjStation + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+ObjStation + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+ObjStation : FDR.BaseTypes.XmlElement + new : stationDesc:string -> stationAlias:string option -> stationLatitude:decimal -> stationLongitude:decimal -> stationCode:string -> stationId:int -> XmlProvider+ObjStation + XmlRuntime.CreateRecord("{http://api.irishrail.ie/realtime/}objStation", + [| |], + [| ("{http://api.irishrail.ie/realtime/}StationDesc", + (stationDesc :> obj)) + ("{http://api.irishrail.ie/realtime/}StationAlias", + (stationAlias :> obj)) + ("{http://api.irishrail.ie/realtime/}StationLatitude", + (stationLatitude :> obj)) + ("{http://api.irishrail.ie/realtime/}StationLongitude", + (stationLongitude :> obj)) + ("{http://api.irishrail.ie/realtime/}StationCode", + (stationCode :> obj)) + ("{http://api.irishrail.ie/realtime/}StationId", + (stationId :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+ObjStation + XmlElement.Create(xElement) + + member StationAlias: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationAlias"))) + + member StationCode: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationCode")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member StationDesc: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationDesc")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member StationId: int with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationId")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertInteger("", value), value) + + member StationLatitude: decimal with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationLatitude")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDecimal("", value), value) + + member StationLongitude: decimal with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.irishrail.ie/realtime/}StationLongitude")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDecimal("", value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..d6e715620 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,207 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+PropertyBag[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "JsonInXml.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+PropertyBag async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+PropertyBag[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "JsonInXml.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+PropertyBag + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+PropertyBag + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+PropertyBag + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+PropertyBag + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+PropertyBag : FDR.BaseTypes.XmlElement + new : blahData:XmlProvider+BlahData -> XmlProvider+PropertyBag + XmlRuntime.CreateRecord("PropertyBag", + [| |], + [| ("BlahDataArray|BlahData", + (blahData :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+PropertyBag + XmlElement.Create(xElement) + + member BlahData: XmlProvider+BlahData with get + XmlRuntime.GetChild(this, "BlahDataArray|BlahData") + + +class XmlProvider+BlahData : FDR.BaseTypes.XmlElement + new : x:XmlProvider+XmlProvider+X[] -> blahDataSomethingFoos:XmlProvider+XmlProvider+BlahDataSomethingFoo[] -> blahDataSomethingFoo2:XmlProvider+BlahDataSomethingFoo2 -> blahDataSomethingFoo3:XmlProvider+BlahDataSomethingFoo4 -> blahDataSomethingFoo4:XmlProvider+BlahDataSomethingFoo3 option -> XmlProvider+BlahData + XmlRuntime.CreateRecord("BlahData", + [| |], + [| ("X", + (x :> obj)) + ("BlahDataSomethingFoo", + (blahDataSomethingFoos :> obj)) + ("BlahDataSomethingFoo2", + (blahDataSomethingFoo2 :> obj)) + ("BlahDataSomethingFoo3", + (blahDataSomethingFoo3 :> obj)) + ("BlahDataSomethingFoo4", + (blahDataSomethingFoo4 :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+BlahData + XmlElement.Create(xElement) + + member BlahDataSomethingFoo2: XmlProvider+BlahDataSomethingFoo2 with get + XmlRuntime.GetChild(this, "BlahDataSomethingFoo2") + + member BlahDataSomethingFoo3: XmlProvider+BlahDataSomethingFoo4 with get + XmlRuntime.GetChild(this, "BlahDataSomethingFoo3") + + member BlahDataSomethingFoo4: XmlProvider+BlahDataSomethingFoo3 option with get + XmlRuntime.ConvertOptional(this, "BlahDataSomethingFoo4", new Func<_,_>(fun (t:XmlElement) -> XmlRuntime.GetJsonValue(t))) + + member BlahDataSomethingFoos: XmlProvider+XmlProvider+BlahDataSomethingFoo[] with get + XmlRuntime.ConvertArray(this, "BlahDataSomethingFoo", new Func<_,_>(fun (t:XmlElement) -> XmlRuntime.GetJsonValue(t))) + + member X: XmlProvider+XmlProvider+X[] with get + JsonRuntime.ConvertArray(XmlRuntime.GetJsonValue(XmlRuntime.GetChild(this, "X")), new Func<_,_>(id))) + + +class XmlProvider+BlahDataSomethingFoo : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> results:XmlProvider+Results -> XmlProvider+BlahDataSomethingFoo + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("results", + (results :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+BlahDataSomethingFoo + JsonDocument.Create(jsonValue, "") + + member Results: XmlProvider+Results with get + JsonRuntime.GetPropertyPacked(this, "results") + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+BlahDataSomethingFoo2 : FDR.BaseTypes.XmlElement + new : number:int -> XmlProvider+BlahDataSomethingFoo2 + XmlRuntime.CreateRecord("BlahDataSomethingFoo2", + [| |], + [| ("", + (number :> obj)) |], "") + + new : json:XmlProvider+BlahDataSomethingFoo3 -> XmlProvider+BlahDataSomethingFoo2 + XmlRuntime.CreateRecord("BlahDataSomethingFoo2", + [| |], + [| ("", + (json :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+BlahDataSomethingFoo2 + XmlElement.Create(xElement) + + member Json: XmlProvider+BlahDataSomethingFoo3 option with get + XmlRuntime.TryGetJsonValue(this) + + member Number: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetValue(this)) + + +class XmlProvider+BlahDataSomethingFoo3 : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> results:XmlProvider+Results2 -> XmlProvider+BlahDataSomethingFoo3 + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("results", + (results :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+BlahDataSomethingFoo3 + JsonDocument.Create(jsonValue, "") + + member Results: XmlProvider+Results2 with get + JsonRuntime.GetPropertyPacked(this, "results") + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+BlahDataSomethingFoo4 : FDR.BaseTypes.XmlElement + new : size:int -> value:XmlProvider+BlahDataSomethingFoo3 -> XmlProvider+BlahDataSomethingFoo4 + XmlRuntime.CreateRecord("BlahDataSomethingFoo3", + [| ("size", + (size :> obj)) |], + [| ("", + (value :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+BlahDataSomethingFoo4 + XmlElement.Create(xElement) + + member Size: int with get + let value = XmlRuntime.TryGetAttribute(this, "size") + TextRuntime.GetNonOptionalValue("Attribute size", TextRuntime.ConvertInteger("", value), value) + + member Value: XmlProvider+BlahDataSomethingFoo3 with get + XmlRuntime.GetJsonValue(this) + + +class XmlProvider+X : FDR.BaseTypes.IJsonDocument + new : t:int -> val:string -> XmlProvider+X + JsonRuntime.CreateRecord([| ("T", + (t :> obj)) + ("Val", + (val :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+X + JsonDocument.Create(jsonValue, "") + + member T: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "T") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Val: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Val") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+Results : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> query:string option -> XmlProvider+Results + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("Query", + (query :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+Results + JsonDocument.Create(jsonValue, "") + + member Query: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "Query")) + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+Results2 : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> query:string -> XmlProvider+Results2 + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("Query", + (query :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+Results2 + JsonDocument.Create(jsonValue, "") + + member Query: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Query") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..d6e715620 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,207 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+PropertyBag[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "JsonInXml.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+PropertyBag async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+PropertyBag[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "JsonInXml.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+PropertyBag + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+PropertyBag + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+PropertyBag + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+PropertyBag + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+PropertyBag : FDR.BaseTypes.XmlElement + new : blahData:XmlProvider+BlahData -> XmlProvider+PropertyBag + XmlRuntime.CreateRecord("PropertyBag", + [| |], + [| ("BlahDataArray|BlahData", + (blahData :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+PropertyBag + XmlElement.Create(xElement) + + member BlahData: XmlProvider+BlahData with get + XmlRuntime.GetChild(this, "BlahDataArray|BlahData") + + +class XmlProvider+BlahData : FDR.BaseTypes.XmlElement + new : x:XmlProvider+XmlProvider+X[] -> blahDataSomethingFoos:XmlProvider+XmlProvider+BlahDataSomethingFoo[] -> blahDataSomethingFoo2:XmlProvider+BlahDataSomethingFoo2 -> blahDataSomethingFoo3:XmlProvider+BlahDataSomethingFoo4 -> blahDataSomethingFoo4:XmlProvider+BlahDataSomethingFoo3 option -> XmlProvider+BlahData + XmlRuntime.CreateRecord("BlahData", + [| |], + [| ("X", + (x :> obj)) + ("BlahDataSomethingFoo", + (blahDataSomethingFoos :> obj)) + ("BlahDataSomethingFoo2", + (blahDataSomethingFoo2 :> obj)) + ("BlahDataSomethingFoo3", + (blahDataSomethingFoo3 :> obj)) + ("BlahDataSomethingFoo4", + (blahDataSomethingFoo4 :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+BlahData + XmlElement.Create(xElement) + + member BlahDataSomethingFoo2: XmlProvider+BlahDataSomethingFoo2 with get + XmlRuntime.GetChild(this, "BlahDataSomethingFoo2") + + member BlahDataSomethingFoo3: XmlProvider+BlahDataSomethingFoo4 with get + XmlRuntime.GetChild(this, "BlahDataSomethingFoo3") + + member BlahDataSomethingFoo4: XmlProvider+BlahDataSomethingFoo3 option with get + XmlRuntime.ConvertOptional(this, "BlahDataSomethingFoo4", new Func<_,_>(fun (t:XmlElement) -> XmlRuntime.GetJsonValue(t))) + + member BlahDataSomethingFoos: XmlProvider+XmlProvider+BlahDataSomethingFoo[] with get + XmlRuntime.ConvertArray(this, "BlahDataSomethingFoo", new Func<_,_>(fun (t:XmlElement) -> XmlRuntime.GetJsonValue(t))) + + member X: XmlProvider+XmlProvider+X[] with get + JsonRuntime.ConvertArray(XmlRuntime.GetJsonValue(XmlRuntime.GetChild(this, "X")), new Func<_,_>(id))) + + +class XmlProvider+BlahDataSomethingFoo : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> results:XmlProvider+Results -> XmlProvider+BlahDataSomethingFoo + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("results", + (results :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+BlahDataSomethingFoo + JsonDocument.Create(jsonValue, "") + + member Results: XmlProvider+Results with get + JsonRuntime.GetPropertyPacked(this, "results") + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+BlahDataSomethingFoo2 : FDR.BaseTypes.XmlElement + new : number:int -> XmlProvider+BlahDataSomethingFoo2 + XmlRuntime.CreateRecord("BlahDataSomethingFoo2", + [| |], + [| ("", + (number :> obj)) |], "") + + new : json:XmlProvider+BlahDataSomethingFoo3 -> XmlProvider+BlahDataSomethingFoo2 + XmlRuntime.CreateRecord("BlahDataSomethingFoo2", + [| |], + [| ("", + (json :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+BlahDataSomethingFoo2 + XmlElement.Create(xElement) + + member Json: XmlProvider+BlahDataSomethingFoo3 option with get + XmlRuntime.TryGetJsonValue(this) + + member Number: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetValue(this)) + + +class XmlProvider+BlahDataSomethingFoo3 : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> results:XmlProvider+Results2 -> XmlProvider+BlahDataSomethingFoo3 + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("results", + (results :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+BlahDataSomethingFoo3 + JsonDocument.Create(jsonValue, "") + + member Results: XmlProvider+Results2 with get + JsonRuntime.GetPropertyPacked(this, "results") + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+BlahDataSomethingFoo4 : FDR.BaseTypes.XmlElement + new : size:int -> value:XmlProvider+BlahDataSomethingFoo3 -> XmlProvider+BlahDataSomethingFoo4 + XmlRuntime.CreateRecord("BlahDataSomethingFoo3", + [| ("size", + (size :> obj)) |], + [| ("", + (value :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+BlahDataSomethingFoo4 + XmlElement.Create(xElement) + + member Size: int with get + let value = XmlRuntime.TryGetAttribute(this, "size") + TextRuntime.GetNonOptionalValue("Attribute size", TextRuntime.ConvertInteger("", value), value) + + member Value: XmlProvider+BlahDataSomethingFoo3 with get + XmlRuntime.GetJsonValue(this) + + +class XmlProvider+X : FDR.BaseTypes.IJsonDocument + new : t:int -> val:string -> XmlProvider+X + JsonRuntime.CreateRecord([| ("T", + (t :> obj)) + ("Val", + (val :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+X + JsonDocument.Create(jsonValue, "") + + member T: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "T") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Val: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Val") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+Results : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> query:string option -> XmlProvider+Results + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("Query", + (query :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+Results + JsonDocument.Create(jsonValue, "") + + member Query: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "Query")) + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+Results2 : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> query:string -> XmlProvider+Results2 + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("Query", + (query :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+Results2 + JsonDocument.Create(jsonValue, "") + + member Query: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Query") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..d6e715620 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,JsonInXml.xml,True,False,,True,,ValuesOnly.expected @@ -0,0 +1,207 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+PropertyBag[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "JsonInXml.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+PropertyBag async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+PropertyBag[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "JsonInXml.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+PropertyBag + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+PropertyBag + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+PropertyBag + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+PropertyBag + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+PropertyBag : FDR.BaseTypes.XmlElement + new : blahData:XmlProvider+BlahData -> XmlProvider+PropertyBag + XmlRuntime.CreateRecord("PropertyBag", + [| |], + [| ("BlahDataArray|BlahData", + (blahData :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+PropertyBag + XmlElement.Create(xElement) + + member BlahData: XmlProvider+BlahData with get + XmlRuntime.GetChild(this, "BlahDataArray|BlahData") + + +class XmlProvider+BlahData : FDR.BaseTypes.XmlElement + new : x:XmlProvider+XmlProvider+X[] -> blahDataSomethingFoos:XmlProvider+XmlProvider+BlahDataSomethingFoo[] -> blahDataSomethingFoo2:XmlProvider+BlahDataSomethingFoo2 -> blahDataSomethingFoo3:XmlProvider+BlahDataSomethingFoo4 -> blahDataSomethingFoo4:XmlProvider+BlahDataSomethingFoo3 option -> XmlProvider+BlahData + XmlRuntime.CreateRecord("BlahData", + [| |], + [| ("X", + (x :> obj)) + ("BlahDataSomethingFoo", + (blahDataSomethingFoos :> obj)) + ("BlahDataSomethingFoo2", + (blahDataSomethingFoo2 :> obj)) + ("BlahDataSomethingFoo3", + (blahDataSomethingFoo3 :> obj)) + ("BlahDataSomethingFoo4", + (blahDataSomethingFoo4 :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+BlahData + XmlElement.Create(xElement) + + member BlahDataSomethingFoo2: XmlProvider+BlahDataSomethingFoo2 with get + XmlRuntime.GetChild(this, "BlahDataSomethingFoo2") + + member BlahDataSomethingFoo3: XmlProvider+BlahDataSomethingFoo4 with get + XmlRuntime.GetChild(this, "BlahDataSomethingFoo3") + + member BlahDataSomethingFoo4: XmlProvider+BlahDataSomethingFoo3 option with get + XmlRuntime.ConvertOptional(this, "BlahDataSomethingFoo4", new Func<_,_>(fun (t:XmlElement) -> XmlRuntime.GetJsonValue(t))) + + member BlahDataSomethingFoos: XmlProvider+XmlProvider+BlahDataSomethingFoo[] with get + XmlRuntime.ConvertArray(this, "BlahDataSomethingFoo", new Func<_,_>(fun (t:XmlElement) -> XmlRuntime.GetJsonValue(t))) + + member X: XmlProvider+XmlProvider+X[] with get + JsonRuntime.ConvertArray(XmlRuntime.GetJsonValue(XmlRuntime.GetChild(this, "X")), new Func<_,_>(id))) + + +class XmlProvider+BlahDataSomethingFoo : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> results:XmlProvider+Results -> XmlProvider+BlahDataSomethingFoo + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("results", + (results :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+BlahDataSomethingFoo + JsonDocument.Create(jsonValue, "") + + member Results: XmlProvider+Results with get + JsonRuntime.GetPropertyPacked(this, "results") + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+BlahDataSomethingFoo2 : FDR.BaseTypes.XmlElement + new : number:int -> XmlProvider+BlahDataSomethingFoo2 + XmlRuntime.CreateRecord("BlahDataSomethingFoo2", + [| |], + [| ("", + (number :> obj)) |], "") + + new : json:XmlProvider+BlahDataSomethingFoo3 -> XmlProvider+BlahDataSomethingFoo2 + XmlRuntime.CreateRecord("BlahDataSomethingFoo2", + [| |], + [| ("", + (json :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+BlahDataSomethingFoo2 + XmlElement.Create(xElement) + + member Json: XmlProvider+BlahDataSomethingFoo3 option with get + XmlRuntime.TryGetJsonValue(this) + + member Number: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetValue(this)) + + +class XmlProvider+BlahDataSomethingFoo3 : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> results:XmlProvider+Results2 -> XmlProvider+BlahDataSomethingFoo3 + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("results", + (results :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+BlahDataSomethingFoo3 + JsonDocument.Create(jsonValue, "") + + member Results: XmlProvider+Results2 with get + JsonRuntime.GetPropertyPacked(this, "results") + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+BlahDataSomethingFoo4 : FDR.BaseTypes.XmlElement + new : size:int -> value:XmlProvider+BlahDataSomethingFoo3 -> XmlProvider+BlahDataSomethingFoo4 + XmlRuntime.CreateRecord("BlahDataSomethingFoo3", + [| ("size", + (size :> obj)) |], + [| ("", + (value :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+BlahDataSomethingFoo4 + XmlElement.Create(xElement) + + member Size: int with get + let value = XmlRuntime.TryGetAttribute(this, "size") + TextRuntime.GetNonOptionalValue("Attribute size", TextRuntime.ConvertInteger("", value), value) + + member Value: XmlProvider+BlahDataSomethingFoo3 with get + XmlRuntime.GetJsonValue(this) + + +class XmlProvider+X : FDR.BaseTypes.IJsonDocument + new : t:int -> val:string -> XmlProvider+X + JsonRuntime.CreateRecord([| ("T", + (t :> obj)) + ("Val", + (val :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+X + JsonDocument.Create(jsonValue, "") + + member T: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "T") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member Val: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Val") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+Results : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> query:string option -> XmlProvider+Results + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("Query", + (query :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+Results + JsonDocument.Create(jsonValue, "") + + member Query: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "Query")) + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + +class XmlProvider+Results2 : FDR.BaseTypes.IJsonDocument + new : somethingSchema:string -> query:string -> XmlProvider+Results2 + JsonRuntime.CreateRecord([| ("Something.Schema", + (somethingSchema :> obj)) + ("Query", + (query :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+Results2 + JsonDocument.Create(jsonValue, "") + + member Query: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Query") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member SomethingSchema: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "Something.Schema") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..9b2a565a8 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,104 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Philosophy.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Philosophy.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Authors + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Authors + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Authors + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Authors : FDR.BaseTypes.XmlElement + new : authors:XmlProvider+XmlProvider+Author[] -> XmlProvider+Authors + XmlRuntime.CreateRecord("authors", + [| |], + [| ("author", + (authors :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Authors + XmlElement.Create(xElement) + + member Authors: XmlProvider+XmlProvider+Author[] with get + XmlRuntime.ConvertArray(this, "author", new Func<_,_>(id))) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> surname:string -> birth:int option -> books:XmlProvider+XmlProvider+Book[] -> manuscript:XmlProvider+Manuscript option -> XmlProvider+Author + XmlRuntime.CreateRecord("author", + [| ("name", + (name :> obj)) + ("surname", + (surname :> obj)) + ("birth", + (birth :> obj)) |], + [| ("book", + (books :> obj)) + ("manuscript", + (manuscript :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Birth: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "birth")) + + member Books: XmlProvider+XmlProvider+Book[] with get + XmlRuntime.ConvertArray(this, "book", new Func<_,_>(id))) + + member Manuscript: XmlProvider+Manuscript option with get + XmlRuntime.ConvertOptional(this, "manuscript", new Func<_,_>(id))) + + member Name: string with get + let value = XmlRuntime.TryGetAttribute(this, "name") + TextRuntime.GetNonOptionalValue("Attribute name", TextRuntime.ConvertString(value), value) + + member Surname: string with get + let value = XmlRuntime.TryGetAttribute(this, "surname") + TextRuntime.GetNonOptionalValue("Attribute surname", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Book : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Book + XmlRuntime.CreateRecord("book", + [| ("title", + (title :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Book + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetAttribute(this, "title") + TextRuntime.GetNonOptionalValue("Attribute title", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Manuscript : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Manuscript + XmlRuntime.CreateRecord("manuscript", + [| ("title", + (title :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Manuscript + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetAttribute(this, "title") + TextRuntime.GetNonOptionalValue("Attribute title", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..9b2a565a8 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,104 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Philosophy.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Philosophy.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Authors + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Authors + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Authors + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Authors : FDR.BaseTypes.XmlElement + new : authors:XmlProvider+XmlProvider+Author[] -> XmlProvider+Authors + XmlRuntime.CreateRecord("authors", + [| |], + [| ("author", + (authors :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Authors + XmlElement.Create(xElement) + + member Authors: XmlProvider+XmlProvider+Author[] with get + XmlRuntime.ConvertArray(this, "author", new Func<_,_>(id))) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> surname:string -> birth:int option -> books:XmlProvider+XmlProvider+Book[] -> manuscript:XmlProvider+Manuscript option -> XmlProvider+Author + XmlRuntime.CreateRecord("author", + [| ("name", + (name :> obj)) + ("surname", + (surname :> obj)) + ("birth", + (birth :> obj)) |], + [| ("book", + (books :> obj)) + ("manuscript", + (manuscript :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Birth: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "birth")) + + member Books: XmlProvider+XmlProvider+Book[] with get + XmlRuntime.ConvertArray(this, "book", new Func<_,_>(id))) + + member Manuscript: XmlProvider+Manuscript option with get + XmlRuntime.ConvertOptional(this, "manuscript", new Func<_,_>(id))) + + member Name: string with get + let value = XmlRuntime.TryGetAttribute(this, "name") + TextRuntime.GetNonOptionalValue("Attribute name", TextRuntime.ConvertString(value), value) + + member Surname: string with get + let value = XmlRuntime.TryGetAttribute(this, "surname") + TextRuntime.GetNonOptionalValue("Attribute surname", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Book : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Book + XmlRuntime.CreateRecord("book", + [| ("title", + (title :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Book + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetAttribute(this, "title") + TextRuntime.GetNonOptionalValue("Attribute title", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Manuscript : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Manuscript + XmlRuntime.CreateRecord("manuscript", + [| ("title", + (title :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Manuscript + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetAttribute(this, "title") + TextRuntime.GetNonOptionalValue("Attribute title", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..9b2a565a8 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Philosophy.xml,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,104 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Philosophy.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Philosophy.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Authors + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Authors + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Authors + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Authors : FDR.BaseTypes.XmlElement + new : authors:XmlProvider+XmlProvider+Author[] -> XmlProvider+Authors + XmlRuntime.CreateRecord("authors", + [| |], + [| ("author", + (authors :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Authors + XmlElement.Create(xElement) + + member Authors: XmlProvider+XmlProvider+Author[] with get + XmlRuntime.ConvertArray(this, "author", new Func<_,_>(id))) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> surname:string -> birth:int option -> books:XmlProvider+XmlProvider+Book[] -> manuscript:XmlProvider+Manuscript option -> XmlProvider+Author + XmlRuntime.CreateRecord("author", + [| ("name", + (name :> obj)) + ("surname", + (surname :> obj)) + ("birth", + (birth :> obj)) |], + [| ("book", + (books :> obj)) + ("manuscript", + (manuscript :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Birth: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "birth")) + + member Books: XmlProvider+XmlProvider+Book[] with get + XmlRuntime.ConvertArray(this, "book", new Func<_,_>(id))) + + member Manuscript: XmlProvider+Manuscript option with get + XmlRuntime.ConvertOptional(this, "manuscript", new Func<_,_>(id))) + + member Name: string with get + let value = XmlRuntime.TryGetAttribute(this, "name") + TextRuntime.GetNonOptionalValue("Attribute name", TextRuntime.ConvertString(value), value) + + member Surname: string with get + let value = XmlRuntime.TryGetAttribute(this, "surname") + TextRuntime.GetNonOptionalValue("Attribute surname", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Book : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Book + XmlRuntime.CreateRecord("book", + [| ("title", + (title :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Book + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetAttribute(this, "title") + TextRuntime.GetNonOptionalValue("Attribute title", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Manuscript : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Manuscript + XmlRuntime.CreateRecord("manuscript", + [| ("title", + (title :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Manuscript + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetAttribute(this, "title") + TextRuntime.GetNonOptionalValue("Attribute title", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..422fe616c --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,123 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Locations async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "SampleAzureServiceManagement.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Locations async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Locations + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "SampleAzureServiceManagement.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Locations + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Locations + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Locations + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Locations + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Locations : FDR.BaseTypes.XmlElement + new : locations:XmlProvider+XmlProvider+Location[] -> XmlProvider+Locations + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}Locations", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}Location", + (locations :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Locations + XmlElement.Create(xElement) + + member Locations: XmlProvider+XmlProvider+Location[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}Location", new Func<_,_>(id))) + + +class XmlProvider+Location : FDR.BaseTypes.XmlElement + new : name:string -> displayName:string -> availableServices:string[] -> computeCapabilities:XmlProvider+ComputeCapabilities -> XmlProvider+Location + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}Location", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}Name", + (name :> obj)) + ("{http://schemas.microsoft.com/windowsazure}DisplayName", + (displayName :> obj)) + ("{http://schemas.microsoft.com/windowsazure}AvailableServices|{http://schemas.microsoft.com/windowsazure}AvailableService", + (availableServices :> obj)) + ("{http://schemas.microsoft.com/windowsazure}ComputeCapabilities", + (computeCapabilities :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Location + XmlElement.Create(xElement) + + member AvailableServices: string[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}AvailableServices|{http://schemas.microsoft.com/windowsazure}AvailableService", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member ComputeCapabilities: XmlProvider+ComputeCapabilities with get + XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}ComputeCapabilities") + + member DisplayName: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}DisplayName")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}Name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+ComputeCapabilities : FDR.BaseTypes.XmlElement + new : webWorkerRoleSizes:XmlProvider+WebWorkerRoleSizes -> virtualMachinesRoleSizes:XmlProvider+VirtualMachinesRoleSizes -> XmlProvider+ComputeCapabilities + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}ComputeCapabilities", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}WebWorkerRoleSizes", + (webWorkerRoleSizes :> obj)) + ("{http://schemas.microsoft.com/windowsazure}VirtualMachinesRoleSizes", + (virtualMachinesRoleSizes :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+ComputeCapabilities + XmlElement.Create(xElement) + + member VirtualMachinesRoleSizes: XmlProvider+VirtualMachinesRoleSizes with get + XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}VirtualMachinesRoleSizes") + + member WebWorkerRoleSizes: XmlProvider+WebWorkerRoleSizes with get + XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}WebWorkerRoleSizes") + + +class XmlProvider+VirtualMachinesRoleSizes : FDR.BaseTypes.XmlElement + new : roleSizes:string[] -> XmlProvider+VirtualMachinesRoleSizes + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}VirtualMachinesRoleSizes", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}RoleSize", + (roleSizes :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+VirtualMachinesRoleSizes + XmlElement.Create(xElement) + + member RoleSizes: string[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}RoleSize", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + +class XmlProvider+WebWorkerRoleSizes : FDR.BaseTypes.XmlElement + new : roleSizes:string[] -> XmlProvider+WebWorkerRoleSizes + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}WebWorkerRoleSizes", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}RoleSize", + (roleSizes :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+WebWorkerRoleSizes + XmlElement.Create(xElement) + + member RoleSizes: string[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}RoleSize", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..422fe616c --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,123 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Locations async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "SampleAzureServiceManagement.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Locations async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Locations + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "SampleAzureServiceManagement.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Locations + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Locations + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Locations + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Locations + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Locations : FDR.BaseTypes.XmlElement + new : locations:XmlProvider+XmlProvider+Location[] -> XmlProvider+Locations + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}Locations", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}Location", + (locations :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Locations + XmlElement.Create(xElement) + + member Locations: XmlProvider+XmlProvider+Location[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}Location", new Func<_,_>(id))) + + +class XmlProvider+Location : FDR.BaseTypes.XmlElement + new : name:string -> displayName:string -> availableServices:string[] -> computeCapabilities:XmlProvider+ComputeCapabilities -> XmlProvider+Location + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}Location", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}Name", + (name :> obj)) + ("{http://schemas.microsoft.com/windowsazure}DisplayName", + (displayName :> obj)) + ("{http://schemas.microsoft.com/windowsazure}AvailableServices|{http://schemas.microsoft.com/windowsazure}AvailableService", + (availableServices :> obj)) + ("{http://schemas.microsoft.com/windowsazure}ComputeCapabilities", + (computeCapabilities :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Location + XmlElement.Create(xElement) + + member AvailableServices: string[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}AvailableServices|{http://schemas.microsoft.com/windowsazure}AvailableService", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member ComputeCapabilities: XmlProvider+ComputeCapabilities with get + XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}ComputeCapabilities") + + member DisplayName: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}DisplayName")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}Name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+ComputeCapabilities : FDR.BaseTypes.XmlElement + new : webWorkerRoleSizes:XmlProvider+WebWorkerRoleSizes -> virtualMachinesRoleSizes:XmlProvider+VirtualMachinesRoleSizes -> XmlProvider+ComputeCapabilities + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}ComputeCapabilities", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}WebWorkerRoleSizes", + (webWorkerRoleSizes :> obj)) + ("{http://schemas.microsoft.com/windowsazure}VirtualMachinesRoleSizes", + (virtualMachinesRoleSizes :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+ComputeCapabilities + XmlElement.Create(xElement) + + member VirtualMachinesRoleSizes: XmlProvider+VirtualMachinesRoleSizes with get + XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}VirtualMachinesRoleSizes") + + member WebWorkerRoleSizes: XmlProvider+WebWorkerRoleSizes with get + XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}WebWorkerRoleSizes") + + +class XmlProvider+VirtualMachinesRoleSizes : FDR.BaseTypes.XmlElement + new : roleSizes:string[] -> XmlProvider+VirtualMachinesRoleSizes + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}VirtualMachinesRoleSizes", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}RoleSize", + (roleSizes :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+VirtualMachinesRoleSizes + XmlElement.Create(xElement) + + member RoleSizes: string[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}RoleSize", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + +class XmlProvider+WebWorkerRoleSizes : FDR.BaseTypes.XmlElement + new : roleSizes:string[] -> XmlProvider+WebWorkerRoleSizes + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}WebWorkerRoleSizes", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}RoleSize", + (roleSizes :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+WebWorkerRoleSizes + XmlElement.Create(xElement) + + member RoleSizes: string[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}RoleSize", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..422fe616c --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,SampleAzureServiceManagement.xml,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,123 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Locations async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "SampleAzureServiceManagement.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Locations async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Locations + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "SampleAzureServiceManagement.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Locations + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Locations + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Locations + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Locations + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Locations : FDR.BaseTypes.XmlElement + new : locations:XmlProvider+XmlProvider+Location[] -> XmlProvider+Locations + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}Locations", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}Location", + (locations :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Locations + XmlElement.Create(xElement) + + member Locations: XmlProvider+XmlProvider+Location[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}Location", new Func<_,_>(id))) + + +class XmlProvider+Location : FDR.BaseTypes.XmlElement + new : name:string -> displayName:string -> availableServices:string[] -> computeCapabilities:XmlProvider+ComputeCapabilities -> XmlProvider+Location + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}Location", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}Name", + (name :> obj)) + ("{http://schemas.microsoft.com/windowsazure}DisplayName", + (displayName :> obj)) + ("{http://schemas.microsoft.com/windowsazure}AvailableServices|{http://schemas.microsoft.com/windowsazure}AvailableService", + (availableServices :> obj)) + ("{http://schemas.microsoft.com/windowsazure}ComputeCapabilities", + (computeCapabilities :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Location + XmlElement.Create(xElement) + + member AvailableServices: string[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}AvailableServices|{http://schemas.microsoft.com/windowsazure}AvailableService", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member ComputeCapabilities: XmlProvider+ComputeCapabilities with get + XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}ComputeCapabilities") + + member DisplayName: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}DisplayName")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}Name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+ComputeCapabilities : FDR.BaseTypes.XmlElement + new : webWorkerRoleSizes:XmlProvider+WebWorkerRoleSizes -> virtualMachinesRoleSizes:XmlProvider+VirtualMachinesRoleSizes -> XmlProvider+ComputeCapabilities + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}ComputeCapabilities", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}WebWorkerRoleSizes", + (webWorkerRoleSizes :> obj)) + ("{http://schemas.microsoft.com/windowsazure}VirtualMachinesRoleSizes", + (virtualMachinesRoleSizes :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+ComputeCapabilities + XmlElement.Create(xElement) + + member VirtualMachinesRoleSizes: XmlProvider+VirtualMachinesRoleSizes with get + XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}VirtualMachinesRoleSizes") + + member WebWorkerRoleSizes: XmlProvider+WebWorkerRoleSizes with get + XmlRuntime.GetChild(this, "{http://schemas.microsoft.com/windowsazure}WebWorkerRoleSizes") + + +class XmlProvider+VirtualMachinesRoleSizes : FDR.BaseTypes.XmlElement + new : roleSizes:string[] -> XmlProvider+VirtualMachinesRoleSizes + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}VirtualMachinesRoleSizes", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}RoleSize", + (roleSizes :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+VirtualMachinesRoleSizes + XmlElement.Create(xElement) + + member RoleSizes: string[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}RoleSize", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + +class XmlProvider+WebWorkerRoleSizes : FDR.BaseTypes.XmlElement + new : roleSizes:string[] -> XmlProvider+WebWorkerRoleSizes + XmlRuntime.CreateRecord("{http://schemas.microsoft.com/windowsazure}WebWorkerRoleSizes", + [| |], + [| ("{http://schemas.microsoft.com/windowsazure}RoleSize", + (roleSizes :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+WebWorkerRoleSizes + XmlElement.Create(xElement) + + member RoleSizes: string[] with get + XmlRuntime.ConvertArray(this, "{http://schemas.microsoft.com/windowsazure}RoleSize", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..dc04a4f4e --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,64 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+TimeSpans async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TimeSpans.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+TimeSpans async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+TimeSpans + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TimeSpans.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+TimeSpans + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+TimeSpans + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+TimeSpans + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+TimeSpans + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+TimeSpans : FDR.BaseTypes.XmlElement + new : positiveWithDayWithFraction:System.TimeSpan -> positiveWithoutDayWithoutFraction:System.TimeSpan -> negativeWithDayWithFraction:System.TimeSpan -> timespanOneTickGreaterThanMaxValue:string -> timespanOneTickLessThanMinValue:string -> XmlProvider+TimeSpans + XmlRuntime.CreateRecord("TimeSpans", + [| |], + [| ("positiveWithDayWithFraction", + (positiveWithDayWithFraction :> obj)) + ("positiveWithoutDayWithoutFraction", + (positiveWithoutDayWithoutFraction :> obj)) + ("negativeWithDayWithFraction", + (negativeWithDayWithFraction :> obj)) + ("timespanOneTickGreaterThanMaxValue", + (timespanOneTickGreaterThanMaxValue :> obj)) + ("timespanOneTickLessThanMinValue", + (timespanOneTickLessThanMinValue :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+TimeSpans + XmlElement.Create(xElement) + + member NegativeWithDayWithFraction: System.TimeSpan with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "negativeWithDayWithFraction")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertTimeSpan("", value), value) + + member PositiveWithDayWithFraction: System.TimeSpan with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "positiveWithDayWithFraction")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertTimeSpan("", value), value) + + member PositiveWithoutDayWithoutFraction: System.TimeSpan with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "positiveWithoutDayWithoutFraction")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertTimeSpan("", value), value) + + member TimespanOneTickGreaterThanMaxValue: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "timespanOneTickGreaterThanMaxValue")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member TimespanOneTickLessThanMinValue: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "timespanOneTickLessThanMinValue")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..dc04a4f4e --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,64 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+TimeSpans async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TimeSpans.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+TimeSpans async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+TimeSpans + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TimeSpans.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+TimeSpans + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+TimeSpans + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+TimeSpans + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+TimeSpans + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+TimeSpans : FDR.BaseTypes.XmlElement + new : positiveWithDayWithFraction:System.TimeSpan -> positiveWithoutDayWithoutFraction:System.TimeSpan -> negativeWithDayWithFraction:System.TimeSpan -> timespanOneTickGreaterThanMaxValue:string -> timespanOneTickLessThanMinValue:string -> XmlProvider+TimeSpans + XmlRuntime.CreateRecord("TimeSpans", + [| |], + [| ("positiveWithDayWithFraction", + (positiveWithDayWithFraction :> obj)) + ("positiveWithoutDayWithoutFraction", + (positiveWithoutDayWithoutFraction :> obj)) + ("negativeWithDayWithFraction", + (negativeWithDayWithFraction :> obj)) + ("timespanOneTickGreaterThanMaxValue", + (timespanOneTickGreaterThanMaxValue :> obj)) + ("timespanOneTickLessThanMinValue", + (timespanOneTickLessThanMinValue :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+TimeSpans + XmlElement.Create(xElement) + + member NegativeWithDayWithFraction: System.TimeSpan with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "negativeWithDayWithFraction")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertTimeSpan("", value), value) + + member PositiveWithDayWithFraction: System.TimeSpan with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "positiveWithDayWithFraction")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertTimeSpan("", value), value) + + member PositiveWithoutDayWithoutFraction: System.TimeSpan with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "positiveWithoutDayWithoutFraction")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertTimeSpan("", value), value) + + member TimespanOneTickGreaterThanMaxValue: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "timespanOneTickGreaterThanMaxValue")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member TimespanOneTickLessThanMinValue: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "timespanOneTickLessThanMinValue")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..dc04a4f4e --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TimeSpans.xml,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,64 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+TimeSpans async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TimeSpans.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+TimeSpans async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+TimeSpans + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TimeSpans.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+TimeSpans + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+TimeSpans + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+TimeSpans + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+TimeSpans + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+TimeSpans : FDR.BaseTypes.XmlElement + new : positiveWithDayWithFraction:System.TimeSpan -> positiveWithoutDayWithoutFraction:System.TimeSpan -> negativeWithDayWithFraction:System.TimeSpan -> timespanOneTickGreaterThanMaxValue:string -> timespanOneTickLessThanMinValue:string -> XmlProvider+TimeSpans + XmlRuntime.CreateRecord("TimeSpans", + [| |], + [| ("positiveWithDayWithFraction", + (positiveWithDayWithFraction :> obj)) + ("positiveWithoutDayWithoutFraction", + (positiveWithoutDayWithoutFraction :> obj)) + ("negativeWithDayWithFraction", + (negativeWithDayWithFraction :> obj)) + ("timespanOneTickGreaterThanMaxValue", + (timespanOneTickGreaterThanMaxValue :> obj)) + ("timespanOneTickLessThanMinValue", + (timespanOneTickLessThanMinValue :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+TimeSpans + XmlElement.Create(xElement) + + member NegativeWithDayWithFraction: System.TimeSpan with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "negativeWithDayWithFraction")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertTimeSpan("", value), value) + + member PositiveWithDayWithFraction: System.TimeSpan with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "positiveWithDayWithFraction")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertTimeSpan("", value), value) + + member PositiveWithoutDayWithoutFraction: System.TimeSpan with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "positiveWithoutDayWithoutFraction")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertTimeSpan("", value), value) + + member TimespanOneTickGreaterThanMaxValue: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "timespanOneTickGreaterThanMaxValue")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member TimespanOneTickLessThanMinValue: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "timespanOneTickLessThanMinValue")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,False,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,False,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,False,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,False,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..7dfca9066 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,77 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Xs async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TypeInference.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Xs async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Xs + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TypeInference.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Xs + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Xs + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Xs + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Xs + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Xs : FDR.BaseTypes.XmlElement + new : xs:XmlProvider+XmlProvider+X[] -> XmlProvider+Xs + XmlRuntime.CreateRecord("XS", + [| |], + [| ("X", + (xs :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Xs + XmlElement.Create(xElement) + + member Xs: XmlProvider+XmlProvider+X[] with get + XmlRuntime.ConvertArray(this, "X", new Func<_,_>(id))) + + +class XmlProvider+X : FDR.BaseTypes.XmlElement + new : intLike:int -> boolLike:bool -> jsonLike:XmlProvider+JsonLike -> XmlProvider+X + XmlRuntime.CreateRecord("X", + [| ("intLike", + (intLike :> obj)) |], + [| ("boolLike", + (boolLike :> obj)) + ("jsonLike", + (jsonLike :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+X + XmlElement.Create(xElement) + + member BoolLike: bool with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "boolLike")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertBoolean(value), value) + + member IntLike: int with get + let value = XmlRuntime.TryGetAttribute(this, "intLike") + TextRuntime.GetNonOptionalValue("Attribute intLike", TextRuntime.ConvertInteger("", value), value) + + member JsonLike: XmlProvider+JsonLike with get + XmlRuntime.GetJsonValue(XmlRuntime.GetChild(this, "jsonLike")) + + +class XmlProvider+JsonLike : FDR.BaseTypes.IJsonDocument + new : a:int -> XmlProvider+JsonLike + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+JsonLike + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..7dfca9066 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,77 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Xs async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TypeInference.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Xs async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Xs + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TypeInference.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Xs + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Xs + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Xs + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Xs + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Xs : FDR.BaseTypes.XmlElement + new : xs:XmlProvider+XmlProvider+X[] -> XmlProvider+Xs + XmlRuntime.CreateRecord("XS", + [| |], + [| ("X", + (xs :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Xs + XmlElement.Create(xElement) + + member Xs: XmlProvider+XmlProvider+X[] with get + XmlRuntime.ConvertArray(this, "X", new Func<_,_>(id))) + + +class XmlProvider+X : FDR.BaseTypes.XmlElement + new : intLike:int -> boolLike:bool -> jsonLike:XmlProvider+JsonLike -> XmlProvider+X + XmlRuntime.CreateRecord("X", + [| ("intLike", + (intLike :> obj)) |], + [| ("boolLike", + (boolLike :> obj)) + ("jsonLike", + (jsonLike :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+X + XmlElement.Create(xElement) + + member BoolLike: bool with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "boolLike")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertBoolean(value), value) + + member IntLike: int with get + let value = XmlRuntime.TryGetAttribute(this, "intLike") + TextRuntime.GetNonOptionalValue("Attribute intLike", TextRuntime.ConvertInteger("", value), value) + + member JsonLike: XmlProvider+JsonLike with get + XmlRuntime.GetJsonValue(XmlRuntime.GetChild(this, "jsonLike")) + + +class XmlProvider+JsonLike : FDR.BaseTypes.IJsonDocument + new : a:int -> XmlProvider+JsonLike + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+JsonLike + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..7dfca9066 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,TypeInference.xml,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,77 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Xs async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TypeInference.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Xs async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Xs + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "TypeInference.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Xs + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Xs + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Xs + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Xs + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Xs : FDR.BaseTypes.XmlElement + new : xs:XmlProvider+XmlProvider+X[] -> XmlProvider+Xs + XmlRuntime.CreateRecord("XS", + [| |], + [| ("X", + (xs :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Xs + XmlElement.Create(xElement) + + member Xs: XmlProvider+XmlProvider+X[] with get + XmlRuntime.ConvertArray(this, "X", new Func<_,_>(id))) + + +class XmlProvider+X : FDR.BaseTypes.XmlElement + new : intLike:int -> boolLike:bool -> jsonLike:XmlProvider+JsonLike -> XmlProvider+X + XmlRuntime.CreateRecord("X", + [| ("intLike", + (intLike :> obj)) |], + [| ("boolLike", + (boolLike :> obj)) + ("jsonLike", + (jsonLike :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+X + XmlElement.Create(xElement) + + member BoolLike: bool with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "boolLike")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertBoolean(value), value) + + member IntLike: int with get + let value = XmlRuntime.TryGetAttribute(this, "intLike") + TextRuntime.GetNonOptionalValue("Attribute intLike", TextRuntime.ConvertInteger("", value), value) + + member JsonLike: XmlProvider+JsonLike with get + XmlRuntime.GetJsonValue(XmlRuntime.GetChild(this, "jsonLike")) + + +class XmlProvider+JsonLike : FDR.BaseTypes.IJsonDocument + new : a:int -> XmlProvider+JsonLike + JsonRuntime.CreateRecord([| ("a", + (a :> obj)) |], "") + + new : jsonValue:JsonValue -> XmlProvider+JsonLike + JsonDocument.Create(jsonValue, "") + + member A: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "a") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..382908b07 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,64 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Writers.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Writers.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Authors + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Authors + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Authors + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Authors : FDR.BaseTypes.XmlElement + new : topic:string -> authors:XmlProvider+XmlProvider+Author[] -> XmlProvider+Authors + XmlRuntime.CreateRecord("authors", + [| ("topic", + (topic :> obj)) |], + [| ("author", + (authors :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Authors + XmlElement.Create(xElement) + + member Authors: XmlProvider+XmlProvider+Author[] with get + XmlRuntime.ConvertArray(this, "author", new Func<_,_>(id))) + + member Topic: string with get + let value = XmlRuntime.TryGetAttribute(this, "topic") + TextRuntime.GetNonOptionalValue("Attribute topic", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> born:int option -> XmlProvider+Author + XmlRuntime.CreateRecord("author", + [| ("name", + (name :> obj)) + ("born", + (born :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Born: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "born")) + + member Name: string with get + let value = XmlRuntime.TryGetAttribute(this, "name") + TextRuntime.GetNonOptionalValue("Attribute name", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..382908b07 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,64 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Writers.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Writers.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Authors + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Authors + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Authors + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Authors : FDR.BaseTypes.XmlElement + new : topic:string -> authors:XmlProvider+XmlProvider+Author[] -> XmlProvider+Authors + XmlRuntime.CreateRecord("authors", + [| ("topic", + (topic :> obj)) |], + [| ("author", + (authors :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Authors + XmlElement.Create(xElement) + + member Authors: XmlProvider+XmlProvider+Author[] with get + XmlRuntime.ConvertArray(this, "author", new Func<_,_>(id))) + + member Topic: string with get + let value = XmlRuntime.TryGetAttribute(this, "topic") + TextRuntime.GetNonOptionalValue("Attribute topic", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> born:int option -> XmlProvider+Author + XmlRuntime.CreateRecord("author", + [| ("name", + (name :> obj)) + ("born", + (born :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Born: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "born")) + + member Name: string with get + let value = XmlRuntime.TryGetAttribute(this, "name") + TextRuntime.GetNonOptionalValue("Attribute name", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..382908b07 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,Writers.xml,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,64 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Writers.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Authors async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "Writers.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Authors + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Authors + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Authors + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Authors + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Authors : FDR.BaseTypes.XmlElement + new : topic:string -> authors:XmlProvider+XmlProvider+Author[] -> XmlProvider+Authors + XmlRuntime.CreateRecord("authors", + [| ("topic", + (topic :> obj)) |], + [| ("author", + (authors :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Authors + XmlElement.Create(xElement) + + member Authors: XmlProvider+XmlProvider+Author[] with get + XmlRuntime.ConvertArray(this, "author", new Func<_,_>(id))) + + member Topic: string with get + let value = XmlRuntime.TryGetAttribute(this, "topic") + TextRuntime.GetNonOptionalValue("Attribute topic", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> born:int option -> XmlProvider+Author + XmlRuntime.CreateRecord("author", + [| ("name", + (name :> obj)) + ("born", + (born :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Born: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "born")) + + member Name: string with get + let value = XmlRuntime.TryGetAttribute(this, "name") + TextRuntime.GetNonOptionalValue("Attribute name", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..9ed16c428 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,40 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Foo async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "emptyValue.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Foo async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Foo + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "emptyValue.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Foo + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Foo + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Foo + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Foo + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Foo : FDR.BaseTypes.XmlElement + new : a:string -> XmlProvider+Foo + XmlRuntime.CreateRecord("foo", + [| ("a", + (a :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Foo + XmlElement.Create(xElement) + + member A: string with get + let value = XmlRuntime.TryGetAttribute(this, "a") + TextRuntime.GetNonOptionalValue("Attribute a", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..9ed16c428 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,40 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Foo async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "emptyValue.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Foo async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Foo + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "emptyValue.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Foo + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Foo + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Foo + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Foo + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Foo : FDR.BaseTypes.XmlElement + new : a:string -> XmlProvider+Foo + XmlRuntime.CreateRecord("foo", + [| ("a", + (a :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Foo + XmlElement.Create(xElement) + + member A: string with get + let value = XmlRuntime.TryGetAttribute(this, "a") + TextRuntime.GetNonOptionalValue("Attribute a", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..9ed16c428 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,emptyValue.xml,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,40 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Foo async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "emptyValue.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Foo async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Foo + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "emptyValue.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Foo + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Foo + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Foo + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Foo + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Foo : FDR.BaseTypes.XmlElement + new : a:string -> XmlProvider+Foo + XmlRuntime.CreateRecord("foo", + [| ("a", + (a :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Foo + XmlElement.Create(xElement) + + member A: string with get + let value = XmlRuntime.TryGetAttribute(this, "a") + TextRuntime.GetNonOptionalValue("Attribute a", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..0e0275bb8 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,90 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Test async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "heterogeneous.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Test async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Test + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "heterogeneous.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Test + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Test + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Test + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Test + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Test : FDR.BaseTypes.XmlElement + new : options:XmlProvider+XmlProvider+Options[] -> XmlProvider+Test + XmlRuntime.CreateRecord("test", + [| |], + [| ("options", + (options :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Test + XmlElement.Create(xElement) + + member Options: XmlProvider+XmlProvider+Options[] with get + XmlRuntime.ConvertArray(this, "options", new Func<_,_>(id))) + + +class XmlProvider+Options : FDR.BaseTypes.XmlElement + new : node:XmlProvider+Node -> XmlProvider+Options + XmlRuntime.CreateRecord("options", + [| |], + [| ("node", + (node :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Options + XmlElement.Create(xElement) + + member Node: XmlProvider+Node with get + XmlRuntime.GetChild(this, "node") + + +class XmlProvider+Node : FDR.BaseTypes.XmlElement + new : set:XmlProvider+SetChoice -> XmlProvider+Node + XmlRuntime.CreateRecord("node", + [| ("set", + (set :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Node + XmlElement.Create(xElement) + + member Set: XmlProvider+SetChoice with get + XmlRuntime.TryGetAttribute(this, "set") + + +class XmlProvider+SetChoice : string option + new : value:int -> XmlProvider+SetChoice + Some TextRuntime.ConvertIntegerBack("", Some value) + + new : value:bool -> XmlProvider+SetChoice + Some TextRuntime.ConvertBooleanBack(Some value, false) + + new : value:string -> XmlProvider+SetChoice + Some TextRuntime.ConvertStringBack(Some value) + + new : () -> XmlProvider+SetChoice + None + + member Boolean: bool option with get + TextRuntime.ConvertBoolean(this) + + member Number: int option with get + TextRuntime.ConvertInteger("", this) + + member String: string option with get + TextRuntime.ConvertString(this) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..0e0275bb8 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,90 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Test async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "heterogeneous.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Test async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Test + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "heterogeneous.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Test + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Test + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Test + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Test + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Test : FDR.BaseTypes.XmlElement + new : options:XmlProvider+XmlProvider+Options[] -> XmlProvider+Test + XmlRuntime.CreateRecord("test", + [| |], + [| ("options", + (options :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Test + XmlElement.Create(xElement) + + member Options: XmlProvider+XmlProvider+Options[] with get + XmlRuntime.ConvertArray(this, "options", new Func<_,_>(id))) + + +class XmlProvider+Options : FDR.BaseTypes.XmlElement + new : node:XmlProvider+Node -> XmlProvider+Options + XmlRuntime.CreateRecord("options", + [| |], + [| ("node", + (node :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Options + XmlElement.Create(xElement) + + member Node: XmlProvider+Node with get + XmlRuntime.GetChild(this, "node") + + +class XmlProvider+Node : FDR.BaseTypes.XmlElement + new : set:XmlProvider+SetChoice -> XmlProvider+Node + XmlRuntime.CreateRecord("node", + [| ("set", + (set :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Node + XmlElement.Create(xElement) + + member Set: XmlProvider+SetChoice with get + XmlRuntime.TryGetAttribute(this, "set") + + +class XmlProvider+SetChoice : string option + new : value:int -> XmlProvider+SetChoice + Some TextRuntime.ConvertIntegerBack("", Some value) + + new : value:bool -> XmlProvider+SetChoice + Some TextRuntime.ConvertBooleanBack(Some value, false) + + new : value:string -> XmlProvider+SetChoice + Some TextRuntime.ConvertStringBack(Some value) + + new : () -> XmlProvider+SetChoice + None + + member Boolean: bool option with get + TextRuntime.ConvertBoolean(this) + + member Number: int option with get + TextRuntime.ConvertInteger("", this) + + member String: string option with get + TextRuntime.ConvertString(this) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..0e0275bb8 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,heterogeneous.xml,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,90 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Test async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "heterogeneous.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Test async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Test + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "heterogeneous.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Test + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Test + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Test + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Test + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Test : FDR.BaseTypes.XmlElement + new : options:XmlProvider+XmlProvider+Options[] -> XmlProvider+Test + XmlRuntime.CreateRecord("test", + [| |], + [| ("options", + (options :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Test + XmlElement.Create(xElement) + + member Options: XmlProvider+XmlProvider+Options[] with get + XmlRuntime.ConvertArray(this, "options", new Func<_,_>(id))) + + +class XmlProvider+Options : FDR.BaseTypes.XmlElement + new : node:XmlProvider+Node -> XmlProvider+Options + XmlRuntime.CreateRecord("options", + [| |], + [| ("node", + (node :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Options + XmlElement.Create(xElement) + + member Node: XmlProvider+Node with get + XmlRuntime.GetChild(this, "node") + + +class XmlProvider+Node : FDR.BaseTypes.XmlElement + new : set:XmlProvider+SetChoice -> XmlProvider+Node + XmlRuntime.CreateRecord("node", + [| ("set", + (set :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Node + XmlElement.Create(xElement) + + member Set: XmlProvider+SetChoice with get + XmlRuntime.TryGetAttribute(this, "set") + + +class XmlProvider+SetChoice : string option + new : value:int -> XmlProvider+SetChoice + Some TextRuntime.ConvertIntegerBack("", Some value) + + new : value:bool -> XmlProvider+SetChoice + Some TextRuntime.ConvertBooleanBack(Some value, false) + + new : value:string -> XmlProvider+SetChoice + Some TextRuntime.ConvertStringBack(Some value) + + new : () -> XmlProvider+SetChoice + None + + member Boolean: bool option with get + TextRuntime.ConvertBoolean(this) + + member Number: int option with get + TextRuntime.ConvertInteger("", this) + + member String: string option with get + TextRuntime.ConvertString(this) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,,ValuesAndInlineSchemasHints.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,,ValuesAndInlineSchemasHints.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..e598ea985 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,129 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> copyright:string -> items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) + ("copyright", + (copyright :> obj)) + ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Copyright: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "copyright")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> pubDate:System.DateTimeOffset -> description:string -> summary:string option -> creator:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("pubDate", + (pubDate :> obj)) + ("description", + (description :> obj)) + ("{http://tomasp.net/rss/extensions}summary", + (summary :> obj)) + ("{http://dublincore.org/documents/dcmi-namespace/}creator", + (creator :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Creator: string option with get + XmlRuntime.ConvertOptional(this, "{http://dublincore.org/documents/dcmi-namespace/}creator", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member PubDate: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "pubDate")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Summary: string option with get + XmlRuntime.ConvertOptional(this, "{http://tomasp.net/rss/extensions}summary", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..e598ea985 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,129 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> copyright:string -> items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) + ("copyright", + (copyright :> obj)) + ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Copyright: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "copyright")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> pubDate:System.DateTimeOffset -> description:string -> summary:string option -> creator:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("pubDate", + (pubDate :> obj)) + ("description", + (description :> obj)) + ("{http://tomasp.net/rss/extensions}summary", + (summary :> obj)) + ("{http://dublincore.org/documents/dcmi-namespace/}creator", + (creator :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Creator: string option with get + XmlRuntime.ConvertOptional(this, "{http://dublincore.org/documents/dcmi-namespace/}creator", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member PubDate: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "pubDate")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Summary: string option with get + XmlRuntime.ConvertOptional(this, "{http://tomasp.net/rss/extensions}summary", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,BackwardCompatible.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,BackwardCompatible.expected new file mode 100644 index 000000000..e598ea985 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,BackwardCompatible.expected @@ -0,0 +1,129 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> copyright:string -> items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) + ("copyright", + (copyright :> obj)) + ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Copyright: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "copyright")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> pubDate:System.DateTimeOffset -> description:string -> summary:string option -> creator:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("pubDate", + (pubDate :> obj)) + ("description", + (description :> obj)) + ("{http://tomasp.net/rss/extensions}summary", + (summary :> obj)) + ("{http://dublincore.org/documents/dcmi-namespace/}creator", + (creator :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Creator: string option with get + XmlRuntime.ConvertOptional(this, "{http://dublincore.org/documents/dcmi-namespace/}creator", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member PubDate: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "pubDate")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Summary: string option with get + XmlRuntime.ConvertOptional(this, "{http://tomasp.net/rss/extensions}summary", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..e598ea985 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,129 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> copyright:string -> items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) + ("copyright", + (copyright :> obj)) + ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Copyright: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "copyright")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> pubDate:System.DateTimeOffset -> description:string -> summary:string option -> creator:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("pubDate", + (pubDate :> obj)) + ("description", + (description :> obj)) + ("{http://tomasp.net/rss/extensions}summary", + (summary :> obj)) + ("{http://dublincore.org/documents/dcmi-namespace/}creator", + (creator :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Creator: string option with get + XmlRuntime.ConvertOptional(this, "{http://dublincore.org/documents/dcmi-namespace/}creator", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member PubDate: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "pubDate")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Summary: string option with get + XmlRuntime.ConvertOptional(this, "{http://tomasp.net/rss/extensions}summary", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..e598ea985 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,129 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> copyright:string -> items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) + ("copyright", + (copyright :> obj)) + ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Copyright: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "copyright")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> pubDate:System.DateTimeOffset -> description:string -> summary:string option -> creator:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("pubDate", + (pubDate :> obj)) + ("description", + (description :> obj)) + ("{http://tomasp.net/rss/extensions}summary", + (summary :> obj)) + ("{http://dublincore.org/documents/dcmi-namespace/}creator", + (creator :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Creator: string option with get + XmlRuntime.ConvertOptional(this, "{http://dublincore.org/documents/dcmi-namespace/}creator", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member PubDate: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "pubDate")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Summary: string option with get + XmlRuntime.ConvertOptional(this, "{http://tomasp.net/rss/extensions}summary", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,ValuesOnly.expected new file mode 100644 index 000000000..e598ea985 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,http_tomasp.net_blog_rss.aspx,False,True,,True,,ValuesOnly.expected @@ -0,0 +1,129 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "http://tomasp.net/blog/rss.aspx"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> description:string -> copyright:string -> items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("description", + (description :> obj)) + ("copyright", + (copyright :> obj)) + ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Copyright: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "copyright")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> link:string -> pubDate:System.DateTimeOffset -> description:string -> summary:string option -> creator:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("link", + (link :> obj)) + ("pubDate", + (pubDate :> obj)) + ("description", + (description :> obj)) + ("{http://tomasp.net/rss/extensions}summary", + (summary :> obj)) + ("{http://dublincore.org/documents/dcmi-namespace/}creator", + (creator :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Creator: string option with get + XmlRuntime.ConvertOptional(this, "{http://dublincore.org/documents/dcmi-namespace/}creator", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Description: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "description")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Link: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "link")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member PubDate: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "pubDate")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Summary: string option with get + XmlRuntime.ConvertOptional(this, "{http://tomasp.net/rss/extensions}summary", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..e57f347af --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,63 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Child[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Child async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Child[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Child + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Child + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Child + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Child + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Child : FDR.BaseTypes.XmlElement + new : a:int option -> b:string option -> inner:XmlProvider+Inner option -> XmlProvider+Child + XmlRuntime.CreateRecord("child", + [| ("a", + (a :> obj)) + ("b", + (b :> obj)) |], + [| ("inner", + (inner :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Child + XmlElement.Create(xElement) + + member A: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "a")) + + member B: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "b")) + + member Inner: XmlProvider+Inner option with get + XmlRuntime.ConvertOptional(this, "inner", new Func<_,_>(id))) + + +class XmlProvider+Inner : FDR.BaseTypes.XmlElement + new : c:string -> XmlProvider+Inner + XmlRuntime.CreateRecord("inner", + [| ("c", + (c :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Inner + XmlElement.Create(xElement) + + member C: string with get + let value = XmlRuntime.TryGetAttribute(this, "c") + TextRuntime.GetNonOptionalValue("Attribute c", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..e57f347af --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,False,,True,,ValuesOnly.expected @@ -0,0 +1,63 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Child[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Child async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Child[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Child + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Child + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Child + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Child + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Child : FDR.BaseTypes.XmlElement + new : a:int option -> b:string option -> inner:XmlProvider+Inner option -> XmlProvider+Child + XmlRuntime.CreateRecord("child", + [| ("a", + (a :> obj)) + ("b", + (b :> obj)) |], + [| ("inner", + (inner :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Child + XmlElement.Create(xElement) + + member A: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "a")) + + member B: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "b")) + + member Inner: XmlProvider+Inner option with get + XmlRuntime.ConvertOptional(this, "inner", new Func<_,_>(id))) + + +class XmlProvider+Inner : FDR.BaseTypes.XmlElement + new : c:string -> XmlProvider+Inner + XmlRuntime.CreateRecord("inner", + [| ("c", + (c :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Inner + XmlElement.Create(xElement) + + member C: string with get + let value = XmlRuntime.TryGetAttribute(this, "c") + TextRuntime.GetNonOptionalValue("Attribute c", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,BackwardCompatible.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,BackwardCompatible.expected new file mode 100644 index 000000000..e57f347af --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,BackwardCompatible.expected @@ -0,0 +1,63 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Child[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Child async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Child[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Child + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Child + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Child + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Child + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Child : FDR.BaseTypes.XmlElement + new : a:int option -> b:string option -> inner:XmlProvider+Inner option -> XmlProvider+Child + XmlRuntime.CreateRecord("child", + [| ("a", + (a :> obj)) + ("b", + (b :> obj)) |], + [| ("inner", + (inner :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Child + XmlElement.Create(xElement) + + member A: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "a")) + + member B: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "b")) + + member Inner: XmlProvider+Inner option with get + XmlRuntime.ConvertOptional(this, "inner", new Func<_,_>(id))) + + +class XmlProvider+Inner : FDR.BaseTypes.XmlElement + new : c:string -> XmlProvider+Inner + XmlRuntime.CreateRecord("inner", + [| ("c", + (c :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Inner + XmlElement.Create(xElement) + + member C: string with get + let value = XmlRuntime.TryGetAttribute(this, "c") + TextRuntime.GetNonOptionalValue("Attribute c", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..e57f347af --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,63 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Child[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Child async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Child[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Child + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Child + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Child + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Child + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Child : FDR.BaseTypes.XmlElement + new : a:int option -> b:string option -> inner:XmlProvider+Inner option -> XmlProvider+Child + XmlRuntime.CreateRecord("child", + [| ("a", + (a :> obj)) + ("b", + (b :> obj)) |], + [| ("inner", + (inner :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Child + XmlElement.Create(xElement) + + member A: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "a")) + + member B: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "b")) + + member Inner: XmlProvider+Inner option with get + XmlRuntime.ConvertOptional(this, "inner", new Func<_,_>(id))) + + +class XmlProvider+Inner : FDR.BaseTypes.XmlElement + new : c:string -> XmlProvider+Inner + XmlRuntime.CreateRecord("inner", + [| ("c", + (c :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Inner + XmlElement.Create(xElement) + + member C: string with get + let value = XmlRuntime.TryGetAttribute(this, "c") + TextRuntime.GetNonOptionalValue("Attribute c", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..e57f347af --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,63 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Child[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Child async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Child[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Child + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Child + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Child + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Child + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Child : FDR.BaseTypes.XmlElement + new : a:int option -> b:string option -> inner:XmlProvider+Inner option -> XmlProvider+Child + XmlRuntime.CreateRecord("child", + [| ("a", + (a :> obj)) + ("b", + (b :> obj)) |], + [| ("inner", + (inner :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Child + XmlElement.Create(xElement) + + member A: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "a")) + + member B: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "b")) + + member Inner: XmlProvider+Inner option with get + XmlRuntime.ConvertOptional(this, "inner", new Func<_,_>(id))) + + +class XmlProvider+Inner : FDR.BaseTypes.XmlElement + new : c:string -> XmlProvider+Inner + XmlRuntime.CreateRecord("inner", + [| ("c", + (c :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Inner + XmlElement.Create(xElement) + + member C: string with get + let value = XmlRuntime.TryGetAttribute(this, "c") + TextRuntime.GetNonOptionalValue("Attribute c", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,ValuesOnly.expected new file mode 100644 index 000000000..e57f347af --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,missingInnerValue.xml,True,True,,True,,ValuesOnly.expected @@ -0,0 +1,63 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Child[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Child async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Child[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "missingInnerValue.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Child + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Child + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Child + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Child + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Child : FDR.BaseTypes.XmlElement + new : a:int option -> b:string option -> inner:XmlProvider+Inner option -> XmlProvider+Child + XmlRuntime.CreateRecord("child", + [| ("a", + (a :> obj)) + ("b", + (b :> obj)) |], + [| ("inner", + (inner :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Child + XmlElement.Create(xElement) + + member A: int option with get + TextRuntime.ConvertInteger("", XmlRuntime.TryGetAttribute(this, "a")) + + member B: string option with get + TextRuntime.ConvertString(XmlRuntime.TryGetAttribute(this, "b")) + + member Inner: XmlProvider+Inner option with get + XmlRuntime.ConvertOptional(this, "inner", new Func<_,_>(id))) + + +class XmlProvider+Inner : FDR.BaseTypes.XmlElement + new : c:string -> XmlProvider+Inner + XmlRuntime.CreateRecord("inner", + [| ("c", + (c :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Inner + XmlElement.Create(xElement) + + member C: string with get + let value = XmlRuntime.TryGetAttribute(this, "c") + TextRuntime.GetNonOptionalValue("Attribute c", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..1eab0cb37 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,45 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Item[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals1.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Item async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Item[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals1.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Item + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Item + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Item + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Item + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> description:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("description", + (description :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: string option with get + XmlRuntime.ConvertOptional2(this, "description", new Func<_,_>(fun (t:XmlElement) -> TextRuntime.ConvertString(XmlRuntime.TryGetValue(t)))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..1eab0cb37 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,45 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Item[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals1.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Item async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Item[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals1.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Item + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Item + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Item + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Item + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> description:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("description", + (description :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: string option with get + XmlRuntime.ConvertOptional2(this, "description", new Func<_,_>(fun (t:XmlElement) -> TextRuntime.ConvertString(XmlRuntime.TryGetValue(t)))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..1eab0cb37 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals1.xml,True,False,,True,,ValuesOnly.expected @@ -0,0 +1,45 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Item[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals1.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Item async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Item[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals1.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Item + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Item + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Item + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Item + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string -> description:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("description", + (description :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: string option with get + XmlRuntime.ConvertOptional2(this, "description", new Func<_,_>(fun (t:XmlElement) -> TextRuntime.ConvertString(XmlRuntime.TryGetValue(t)))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..e5000a901 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,72 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Rss[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals2.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Rss[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals2.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : description:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("description", + (description :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: string option with get + XmlRuntime.ConvertOptional2(this, "description", new Func<_,_>(fun (t:XmlElement) -> TextRuntime.ConvertString(XmlRuntime.TryGetValue(t)))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..e5000a901 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,72 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Rss[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals2.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Rss[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals2.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : description:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("description", + (description :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: string option with get + XmlRuntime.ConvertOptional2(this, "description", new Func<_,_>(fun (t:XmlElement) -> TextRuntime.ConvertString(XmlRuntime.TryGetValue(t)))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..e5000a901 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals2.xml,True,False,,True,,ValuesOnly.expected @@ -0,0 +1,72 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Rss[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals2.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Rss[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals2.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : description:string option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("description", + (description :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: string option with get + XmlRuntime.ConvertOptional2(this, "description", new Func<_,_>(fun (t:XmlElement) -> TextRuntime.ConvertString(XmlRuntime.TryGetValue(t)))) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..b9090b751 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,104 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Rss[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals3.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Rss[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals3.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string option -> description:XmlProvider+Description option -> temp:XmlProvider+Temp option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("description", + (description :> obj)) + ("temp", + (temp :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: XmlProvider+Description option with get + XmlRuntime.ConvertOptional(this, "description", new Func<_,_>(id))) + + member Temp: XmlProvider+Temp option with get + XmlRuntime.ConvertOptional(this, "temp", new Func<_,_>(id))) + + member Title: string option with get + XmlRuntime.ConvertOptional(this, "title", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + +class XmlProvider+Description : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Description + XmlRuntime.CreateRecord("description", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Description + XmlElement.Create(xElement) + + +class XmlProvider+Temp : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Temp + XmlRuntime.CreateRecord("temp", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Temp + XmlElement.Create(xElement) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..b9090b751 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,104 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Rss[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals3.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Rss[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals3.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string option -> description:XmlProvider+Description option -> temp:XmlProvider+Temp option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("description", + (description :> obj)) + ("temp", + (temp :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: XmlProvider+Description option with get + XmlRuntime.ConvertOptional(this, "description", new Func<_,_>(id))) + + member Temp: XmlProvider+Temp option with get + XmlRuntime.ConvertOptional(this, "temp", new Func<_,_>(id))) + + member Title: string option with get + XmlRuntime.ConvertOptional(this, "title", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + +class XmlProvider+Description : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Description + XmlRuntime.CreateRecord("description", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Description + XmlElement.Create(xElement) + + +class XmlProvider+Temp : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Temp + XmlRuntime.CreateRecord("temp", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Temp + XmlElement.Create(xElement) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..b9090b751 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,optionals3.xml,True,False,,True,,ValuesOnly.expected @@ -0,0 +1,104 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Rss[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals3.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Rss async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Rss[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "optionals3.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Rss + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Rss + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Rss + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Rss + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Rss : FDR.BaseTypes.XmlElement + new : version:decimal -> channel:XmlProvider+Channel -> XmlProvider+Rss + XmlRuntime.CreateRecord("rss", + [| ("version", + (version :> obj)) |], + [| ("channel", + (channel :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Rss + XmlElement.Create(xElement) + + member Channel: XmlProvider+Channel with get + XmlRuntime.GetChild(this, "channel") + + member Version: decimal with get + let value = XmlRuntime.TryGetAttribute(this, "version") + TextRuntime.GetNonOptionalValue("Attribute version", TextRuntime.ConvertDecimal("", value), value) + + +class XmlProvider+Channel : FDR.BaseTypes.XmlElement + new : items:XmlProvider+XmlProvider+Item[] -> XmlProvider+Channel + XmlRuntime.CreateRecord("channel", + [| |], + [| ("item", + (items :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Channel + XmlElement.Create(xElement) + + member Items: XmlProvider+XmlProvider+Item[] with get + XmlRuntime.ConvertArray(this, "item", new Func<_,_>(id))) + + +class XmlProvider+Item : FDR.BaseTypes.XmlElement + new : title:string option -> description:XmlProvider+Description option -> temp:XmlProvider+Temp option -> XmlProvider+Item + XmlRuntime.CreateRecord("item", + [| |], + [| ("title", + (title :> obj)) + ("description", + (description :> obj)) + ("temp", + (temp :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Item + XmlElement.Create(xElement) + + member Description: XmlProvider+Description option with get + XmlRuntime.ConvertOptional(this, "description", new Func<_,_>(id))) + + member Temp: XmlProvider+Temp option with get + XmlRuntime.ConvertOptional(this, "temp", new Func<_,_>(id))) + + member Title: string option with get + XmlRuntime.ConvertOptional(this, "title", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + +class XmlProvider+Description : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Description + XmlRuntime.CreateRecord("description", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Description + XmlElement.Create(xElement) + + +class XmlProvider+Temp : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Temp + XmlRuntime.CreateRecord("temp", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Temp + XmlElement.Create(xElement) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..a3fcc6613 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,74 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Ordercontainer async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "projects.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Ordercontainer async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Ordercontainer + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "projects.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Ordercontainer + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Ordercontainer + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Ordercontainer + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Ordercontainer + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Ordercontainer : FDR.BaseTypes.XmlElement + new : background:XmlProvider+Background -> project:XmlProvider+Project -> XmlProvider+Ordercontainer + XmlRuntime.CreateRecord("ordercontainer", + [| |], + [| ("backgrounds|background", + (background :> obj)) + ("project", + (project :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Ordercontainer + XmlElement.Create(xElement) + + member Background: XmlProvider+Background with get + XmlRuntime.GetChild(this, "backgrounds|background") + + member Project: XmlProvider+Project with get + XmlRuntime.GetChild(this, "project") + + +class XmlProvider+Background : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Background + XmlRuntime.CreateRecord("background", + [| |], + [| ("title", + (title :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Background + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Project : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Project + XmlRuntime.CreateRecord("project", + [| |], + [| ("title", + (title :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Project + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..a3fcc6613 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,74 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Ordercontainer async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "projects.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Ordercontainer async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Ordercontainer + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "projects.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Ordercontainer + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Ordercontainer + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Ordercontainer + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Ordercontainer + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Ordercontainer : FDR.BaseTypes.XmlElement + new : background:XmlProvider+Background -> project:XmlProvider+Project -> XmlProvider+Ordercontainer + XmlRuntime.CreateRecord("ordercontainer", + [| |], + [| ("backgrounds|background", + (background :> obj)) + ("project", + (project :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Ordercontainer + XmlElement.Create(xElement) + + member Background: XmlProvider+Background with get + XmlRuntime.GetChild(this, "backgrounds|background") + + member Project: XmlProvider+Project with get + XmlRuntime.GetChild(this, "project") + + +class XmlProvider+Background : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Background + XmlRuntime.CreateRecord("background", + [| |], + [| ("title", + (title :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Background + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Project : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Project + XmlRuntime.CreateRecord("project", + [| |], + [| ("title", + (title :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Project + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..a3fcc6613 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,projects.xml,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,74 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Ordercontainer async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "projects.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Ordercontainer async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Ordercontainer + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "projects.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Ordercontainer + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Ordercontainer + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Ordercontainer + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Ordercontainer + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Ordercontainer : FDR.BaseTypes.XmlElement + new : background:XmlProvider+Background -> project:XmlProvider+Project -> XmlProvider+Ordercontainer + XmlRuntime.CreateRecord("ordercontainer", + [| |], + [| ("backgrounds|background", + (background :> obj)) + ("project", + (project :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Ordercontainer + XmlElement.Create(xElement) + + member Background: XmlProvider+Background with get + XmlRuntime.GetChild(this, "backgrounds|background") + + member Project: XmlProvider+Project with get + XmlRuntime.GetChild(this, "project") + + +class XmlProvider+Background : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Background + XmlRuntime.CreateRecord("background", + [| |], + [| ("title", + (title :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Background + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Project : FDR.BaseTypes.XmlElement + new : title:string -> XmlProvider+Project + XmlRuntime.CreateRecord("project", + [| |], + [| ("title", + (title :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Project + XmlElement.Create(xElement) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..ee1042886 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,263 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Feed async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Feed async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Feed + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Feed + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Feed + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Feed + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Feed + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Feed : FDR.BaseTypes.XmlElement + new : lang:string -> id:string -> links:XmlProvider+XmlProvider+Link[] -> title:string -> updated:System.DateTimeOffset -> itemsPerPage:int -> entries:XmlProvider+XmlProvider+Entry[] -> XmlProvider+Feed + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}feed", + [| ("{http://www.w3.org/XML/1998/namespace}lang", + (lang :> obj)) |], + [| ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage", + (itemsPerPage :> obj)) + ("{http://www.w3.org/2005/Atom}entry", + (entries :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Feed + XmlElement.Create(xElement) + + member Entries: XmlProvider+XmlProvider+Entry[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}entry", new Func<_,_>(id))) + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member ItemsPerPage: int with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertInteger("", value), value) + + member Lang: string with get + let value = XmlRuntime.TryGetAttribute(this, "{http://www.w3.org/XML/1998/namespace}lang") + TextRuntime.GetNonOptionalValue("Attribute lang", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Entry : FDR.BaseTypes.XmlElement + new : id:string -> published:System.DateTimeOffset -> links:XmlProvider+XmlProvider+Link2[] -> title:string -> content:XmlProvider+Content -> updated:System.DateTimeOffset -> geo:XmlProvider+Geo -> metadata:XmlProvider+Metadata -> source:string -> lang:string -> author:XmlProvider+Author -> XmlProvider+Entry + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}entry", + [| |], + [| ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}published", + (published :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}content", + (content :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://api.twitter.com/}geo", + (geo :> obj)) + ("{http://api.twitter.com/}metadata", + (metadata :> obj)) + ("{http://api.twitter.com/}source", + (source :> obj)) + ("{http://api.twitter.com/}lang", + (lang :> obj)) + ("{http://www.w3.org/2005/Atom}author", + (author :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Entry + XmlElement.Create(xElement) + + member Author: XmlProvider+Author with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}author") + + member Content: XmlProvider+Content with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}content") + + member Geo: XmlProvider+Geo with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}geo") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Lang: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}lang")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link2[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Metadata: XmlProvider+Metadata with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}metadata") + + member Published: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}published")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Source: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}source")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Link : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> uri:string -> XmlProvider+Author + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}author", + [| |], + [| ("{http://www.w3.org/2005/Atom}name", + (name :> obj)) + ("{http://www.w3.org/2005/Atom}uri", + (uri :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Uri: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}uri")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Content : FDR.BaseTypes.XmlElement + new : type:string -> value:string -> XmlProvider+Content + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}content", + [| ("type", + (type :> obj)) |], + [| ("", + (value :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Content + XmlElement.Create(xElement) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + member Value: string with get + let value = XmlRuntime.TryGetValue(this) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Geo : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Geo + XmlRuntime.CreateRecord("{http://api.twitter.com/}geo", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Geo + XmlElement.Create(xElement) + + +class XmlProvider+Link2 : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link2 + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link2 + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Metadata : FDR.BaseTypes.XmlElement + new : resultType:string -> XmlProvider+Metadata + XmlRuntime.CreateRecord("{http://api.twitter.com/}metadata", + [| |], + [| ("{http://api.twitter.com/}result_type", + (resultType :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Metadata + XmlElement.Create(xElement) + + member ResultType: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}result_type")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..ee1042886 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,263 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Feed async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Feed async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Feed + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Feed + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Feed + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Feed + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Feed + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Feed : FDR.BaseTypes.XmlElement + new : lang:string -> id:string -> links:XmlProvider+XmlProvider+Link[] -> title:string -> updated:System.DateTimeOffset -> itemsPerPage:int -> entries:XmlProvider+XmlProvider+Entry[] -> XmlProvider+Feed + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}feed", + [| ("{http://www.w3.org/XML/1998/namespace}lang", + (lang :> obj)) |], + [| ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage", + (itemsPerPage :> obj)) + ("{http://www.w3.org/2005/Atom}entry", + (entries :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Feed + XmlElement.Create(xElement) + + member Entries: XmlProvider+XmlProvider+Entry[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}entry", new Func<_,_>(id))) + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member ItemsPerPage: int with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertInteger("", value), value) + + member Lang: string with get + let value = XmlRuntime.TryGetAttribute(this, "{http://www.w3.org/XML/1998/namespace}lang") + TextRuntime.GetNonOptionalValue("Attribute lang", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Entry : FDR.BaseTypes.XmlElement + new : id:string -> published:System.DateTimeOffset -> links:XmlProvider+XmlProvider+Link2[] -> title:string -> content:XmlProvider+Content -> updated:System.DateTimeOffset -> geo:XmlProvider+Geo -> metadata:XmlProvider+Metadata -> source:string -> lang:string -> author:XmlProvider+Author -> XmlProvider+Entry + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}entry", + [| |], + [| ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}published", + (published :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}content", + (content :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://api.twitter.com/}geo", + (geo :> obj)) + ("{http://api.twitter.com/}metadata", + (metadata :> obj)) + ("{http://api.twitter.com/}source", + (source :> obj)) + ("{http://api.twitter.com/}lang", + (lang :> obj)) + ("{http://www.w3.org/2005/Atom}author", + (author :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Entry + XmlElement.Create(xElement) + + member Author: XmlProvider+Author with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}author") + + member Content: XmlProvider+Content with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}content") + + member Geo: XmlProvider+Geo with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}geo") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Lang: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}lang")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link2[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Metadata: XmlProvider+Metadata with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}metadata") + + member Published: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}published")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Source: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}source")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Link : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> uri:string -> XmlProvider+Author + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}author", + [| |], + [| ("{http://www.w3.org/2005/Atom}name", + (name :> obj)) + ("{http://www.w3.org/2005/Atom}uri", + (uri :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Uri: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}uri")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Content : FDR.BaseTypes.XmlElement + new : type:string -> value:string -> XmlProvider+Content + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}content", + [| ("type", + (type :> obj)) |], + [| ("", + (value :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Content + XmlElement.Create(xElement) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + member Value: string with get + let value = XmlRuntime.TryGetValue(this) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Geo : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Geo + XmlRuntime.CreateRecord("{http://api.twitter.com/}geo", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Geo + XmlElement.Create(xElement) + + +class XmlProvider+Link2 : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link2 + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link2 + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Metadata : FDR.BaseTypes.XmlElement + new : resultType:string -> XmlProvider+Metadata + XmlRuntime.CreateRecord("{http://api.twitter.com/}metadata", + [| |], + [| ("{http://api.twitter.com/}result_type", + (resultType :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Metadata + XmlElement.Create(xElement) + + member ResultType: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}result_type")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..ee1042886 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,False,False,,True,,ValuesOnly.expected @@ -0,0 +1,263 @@ +class XmlProvider : obj + static member AsyncGetSample: () -> XmlProvider+Feed async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Feed async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSample: () -> XmlProvider+Feed + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Feed + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Feed + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Feed + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Feed + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Feed : FDR.BaseTypes.XmlElement + new : lang:string -> id:string -> links:XmlProvider+XmlProvider+Link[] -> title:string -> updated:System.DateTimeOffset -> itemsPerPage:int -> entries:XmlProvider+XmlProvider+Entry[] -> XmlProvider+Feed + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}feed", + [| ("{http://www.w3.org/XML/1998/namespace}lang", + (lang :> obj)) |], + [| ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage", + (itemsPerPage :> obj)) + ("{http://www.w3.org/2005/Atom}entry", + (entries :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Feed + XmlElement.Create(xElement) + + member Entries: XmlProvider+XmlProvider+Entry[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}entry", new Func<_,_>(id))) + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member ItemsPerPage: int with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertInteger("", value), value) + + member Lang: string with get + let value = XmlRuntime.TryGetAttribute(this, "{http://www.w3.org/XML/1998/namespace}lang") + TextRuntime.GetNonOptionalValue("Attribute lang", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Entry : FDR.BaseTypes.XmlElement + new : id:string -> published:System.DateTimeOffset -> links:XmlProvider+XmlProvider+Link2[] -> title:string -> content:XmlProvider+Content -> updated:System.DateTimeOffset -> geo:XmlProvider+Geo -> metadata:XmlProvider+Metadata -> source:string -> lang:string -> author:XmlProvider+Author -> XmlProvider+Entry + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}entry", + [| |], + [| ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}published", + (published :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}content", + (content :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://api.twitter.com/}geo", + (geo :> obj)) + ("{http://api.twitter.com/}metadata", + (metadata :> obj)) + ("{http://api.twitter.com/}source", + (source :> obj)) + ("{http://api.twitter.com/}lang", + (lang :> obj)) + ("{http://www.w3.org/2005/Atom}author", + (author :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Entry + XmlElement.Create(xElement) + + member Author: XmlProvider+Author with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}author") + + member Content: XmlProvider+Content with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}content") + + member Geo: XmlProvider+Geo with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}geo") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Lang: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}lang")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link2[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Metadata: XmlProvider+Metadata with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}metadata") + + member Published: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}published")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Source: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}source")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Link : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> uri:string -> XmlProvider+Author + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}author", + [| |], + [| ("{http://www.w3.org/2005/Atom}name", + (name :> obj)) + ("{http://www.w3.org/2005/Atom}uri", + (uri :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Uri: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}uri")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Content : FDR.BaseTypes.XmlElement + new : type:string -> value:string -> XmlProvider+Content + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}content", + [| ("type", + (type :> obj)) |], + [| ("", + (value :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Content + XmlElement.Create(xElement) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + member Value: string with get + let value = XmlRuntime.TryGetValue(this) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Geo : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Geo + XmlRuntime.CreateRecord("{http://api.twitter.com/}geo", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Geo + XmlElement.Create(xElement) + + +class XmlProvider+Link2 : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link2 + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link2 + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Metadata : FDR.BaseTypes.XmlElement + new : resultType:string -> XmlProvider+Metadata + XmlRuntime.CreateRecord("{http://api.twitter.com/}metadata", + [| |], + [| ("{http://api.twitter.com/}result_type", + (resultType :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Metadata + XmlElement.Create(xElement) + + member ResultType: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}result_type")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,BackwardCompatible.expected similarity index 100% rename from tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,.expected rename to tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,BackwardCompatible.expected diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected new file mode 100644 index 000000000..dadb544d2 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,ValuesAndInlineSchemasHints.expected @@ -0,0 +1,264 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Choice[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Choice async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Choice[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Choice + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Choice + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Choice + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Choice + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Choice : FDR.BaseTypes.XmlElement + new : itemsPerPage:int -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage", (itemsPerPage :> obj), "") + + new : entry:XmlProvider+Entry -> XmlProvider+Choice + entry + + new : id:string -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://www.w3.org/2005/Atom}id", (id :> obj), "") + + new : link:XmlProvider+Link2 -> XmlProvider+Choice + link + + new : title:string -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://www.w3.org/2005/Atom}title", (title :> obj), "") + + new : updated:System.DateTimeOffset -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://www.w3.org/2005/Atom}updated", (updated :> obj), "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Choice + XmlElement.Create(xElement) + + member Entry: XmlProvider+Entry option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}entry", new Func<_,_>(id))) + + member Id: string option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}id", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member ItemsPerPage: int option with get + XmlRuntime.ConvertAsName(this, "{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertInteger("", value), value))) + + member Link: XmlProvider+Link2 option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Title: string option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}title", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Updated: System.DateTimeOffset option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}updated", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value))) + + +class XmlProvider+Entry : FDR.BaseTypes.XmlElement + new : id:string -> published:System.DateTimeOffset -> links:XmlProvider+XmlProvider+Link[] -> title:string -> content:XmlProvider+Content -> updated:System.DateTimeOffset -> geo:XmlProvider+Geo -> metadata:XmlProvider+Metadata -> source:string -> lang:string -> author:XmlProvider+Author -> XmlProvider+Entry + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}entry", + [| |], + [| ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}published", + (published :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}content", + (content :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://api.twitter.com/}geo", + (geo :> obj)) + ("{http://api.twitter.com/}metadata", + (metadata :> obj)) + ("{http://api.twitter.com/}source", + (source :> obj)) + ("{http://api.twitter.com/}lang", + (lang :> obj)) + ("{http://www.w3.org/2005/Atom}author", + (author :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Entry + XmlElement.Create(xElement) + + member Author: XmlProvider+Author with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}author") + + member Content: XmlProvider+Content with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}content") + + member Geo: XmlProvider+Geo with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}geo") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Lang: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}lang")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Metadata: XmlProvider+Metadata with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}metadata") + + member Published: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}published")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Source: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}source")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Link2 : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link2 + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link2 + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> uri:string -> XmlProvider+Author + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}author", + [| |], + [| ("{http://www.w3.org/2005/Atom}name", + (name :> obj)) + ("{http://www.w3.org/2005/Atom}uri", + (uri :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Uri: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}uri")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Content : FDR.BaseTypes.XmlElement + new : type:string -> value:string -> XmlProvider+Content + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}content", + [| ("type", + (type :> obj)) |], + [| ("", + (value :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Content + XmlElement.Create(xElement) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + member Value: string with get + let value = XmlRuntime.TryGetValue(this) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Geo : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Geo + XmlRuntime.CreateRecord("{http://api.twitter.com/}geo", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Geo + XmlElement.Create(xElement) + + +class XmlProvider+Link : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Metadata : FDR.BaseTypes.XmlElement + new : resultType:string -> XmlProvider+Metadata + XmlRuntime.CreateRecord("{http://api.twitter.com/}metadata", + [| |], + [| ("{http://api.twitter.com/}result_type", + (resultType :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Metadata + XmlElement.Create(xElement) + + member ResultType: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}result_type")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected new file mode 100644 index 000000000..dadb544d2 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,ValuesAndInlineSchemasOverrides.expected @@ -0,0 +1,264 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Choice[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Choice async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Choice[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Choice + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Choice + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Choice + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Choice + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Choice : FDR.BaseTypes.XmlElement + new : itemsPerPage:int -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage", (itemsPerPage :> obj), "") + + new : entry:XmlProvider+Entry -> XmlProvider+Choice + entry + + new : id:string -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://www.w3.org/2005/Atom}id", (id :> obj), "") + + new : link:XmlProvider+Link2 -> XmlProvider+Choice + link + + new : title:string -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://www.w3.org/2005/Atom}title", (title :> obj), "") + + new : updated:System.DateTimeOffset -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://www.w3.org/2005/Atom}updated", (updated :> obj), "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Choice + XmlElement.Create(xElement) + + member Entry: XmlProvider+Entry option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}entry", new Func<_,_>(id))) + + member Id: string option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}id", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member ItemsPerPage: int option with get + XmlRuntime.ConvertAsName(this, "{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertInteger("", value), value))) + + member Link: XmlProvider+Link2 option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Title: string option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}title", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Updated: System.DateTimeOffset option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}updated", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value))) + + +class XmlProvider+Entry : FDR.BaseTypes.XmlElement + new : id:string -> published:System.DateTimeOffset -> links:XmlProvider+XmlProvider+Link[] -> title:string -> content:XmlProvider+Content -> updated:System.DateTimeOffset -> geo:XmlProvider+Geo -> metadata:XmlProvider+Metadata -> source:string -> lang:string -> author:XmlProvider+Author -> XmlProvider+Entry + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}entry", + [| |], + [| ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}published", + (published :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}content", + (content :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://api.twitter.com/}geo", + (geo :> obj)) + ("{http://api.twitter.com/}metadata", + (metadata :> obj)) + ("{http://api.twitter.com/}source", + (source :> obj)) + ("{http://api.twitter.com/}lang", + (lang :> obj)) + ("{http://www.w3.org/2005/Atom}author", + (author :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Entry + XmlElement.Create(xElement) + + member Author: XmlProvider+Author with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}author") + + member Content: XmlProvider+Content with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}content") + + member Geo: XmlProvider+Geo with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}geo") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Lang: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}lang")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Metadata: XmlProvider+Metadata with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}metadata") + + member Published: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}published")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Source: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}source")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Link2 : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link2 + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link2 + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> uri:string -> XmlProvider+Author + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}author", + [| |], + [| ("{http://www.w3.org/2005/Atom}name", + (name :> obj)) + ("{http://www.w3.org/2005/Atom}uri", + (uri :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Uri: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}uri")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Content : FDR.BaseTypes.XmlElement + new : type:string -> value:string -> XmlProvider+Content + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}content", + [| ("type", + (type :> obj)) |], + [| ("", + (value :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Content + XmlElement.Create(xElement) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + member Value: string with get + let value = XmlRuntime.TryGetValue(this) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Geo : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Geo + XmlRuntime.CreateRecord("{http://api.twitter.com/}geo", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Geo + XmlElement.Create(xElement) + + +class XmlProvider+Link : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Metadata : FDR.BaseTypes.XmlElement + new : resultType:string -> XmlProvider+Metadata + XmlRuntime.CreateRecord("{http://api.twitter.com/}metadata", + [| |], + [| ("{http://api.twitter.com/}result_type", + (resultType :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Metadata + XmlElement.Create(xElement) + + member ResultType: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}result_type")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,ValuesOnly.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,ValuesOnly.expected new file mode 100644 index 000000000..dadb544d2 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Xml,search.atom.xml,True,False,,True,,ValuesOnly.expected @@ -0,0 +1,264 @@ +class XmlProvider : obj + static member AsyncGetSamples: () -> XmlProvider+XmlProvider+Choice[] async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.CreateList(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"), f) + + static member AsyncLoad: uri:string -> XmlProvider+Choice async + let f = new Func<_,_>(fun (t:TextReader) -> XmlElement.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri), f) + + static member GetSamples: () -> XmlProvider+XmlProvider+Choice[] + XmlElement.CreateList(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "XML" "" "search.atom.xml"))) + + static member Load: stream:System.IO.Stream -> XmlProvider+Choice + XmlElement.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> XmlProvider+Choice + XmlElement.Create(reader) + + static member Load: uri:string -> XmlProvider+Choice + XmlElement.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "XML" "" uri))) + + static member Parse: text:string -> XmlProvider+Choice + XmlElement.Create(((new StringReader(text)) :> TextReader)) + + +class XmlProvider+Choice : FDR.BaseTypes.XmlElement + new : itemsPerPage:int -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage", (itemsPerPage :> obj), "") + + new : entry:XmlProvider+Entry -> XmlProvider+Choice + entry + + new : id:string -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://www.w3.org/2005/Atom}id", (id :> obj), "") + + new : link:XmlProvider+Link2 -> XmlProvider+Choice + link + + new : title:string -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://www.w3.org/2005/Atom}title", (title :> obj), "") + + new : updated:System.DateTimeOffset -> XmlProvider+Choice + XmlRuntime.CreateValue("{http://www.w3.org/2005/Atom}updated", (updated :> obj), "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Choice + XmlElement.Create(xElement) + + member Entry: XmlProvider+Entry option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}entry", new Func<_,_>(id))) + + member Id: string option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}id", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member ItemsPerPage: int option with get + XmlRuntime.ConvertAsName(this, "{http://a9.com/-/spec/opensearch/1.1/}itemsPerPage", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertInteger("", value), value))) + + member Link: XmlProvider+Link2 option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Title: string option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}title", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value))) + + member Updated: System.DateTimeOffset option with get + XmlRuntime.ConvertAsName(this, "{http://www.w3.org/2005/Atom}updated", new Func<_,_>(fun (t:XmlElement) -> + let value = XmlRuntime.TryGetValue(t) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value))) + + +class XmlProvider+Entry : FDR.BaseTypes.XmlElement + new : id:string -> published:System.DateTimeOffset -> links:XmlProvider+XmlProvider+Link[] -> title:string -> content:XmlProvider+Content -> updated:System.DateTimeOffset -> geo:XmlProvider+Geo -> metadata:XmlProvider+Metadata -> source:string -> lang:string -> author:XmlProvider+Author -> XmlProvider+Entry + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}entry", + [| |], + [| ("{http://www.w3.org/2005/Atom}id", + (id :> obj)) + ("{http://www.w3.org/2005/Atom}published", + (published :> obj)) + ("{http://www.w3.org/2005/Atom}link", + (links :> obj)) + ("{http://www.w3.org/2005/Atom}title", + (title :> obj)) + ("{http://www.w3.org/2005/Atom}content", + (content :> obj)) + ("{http://www.w3.org/2005/Atom}updated", + (updated :> obj)) + ("{http://api.twitter.com/}geo", + (geo :> obj)) + ("{http://api.twitter.com/}metadata", + (metadata :> obj)) + ("{http://api.twitter.com/}source", + (source :> obj)) + ("{http://api.twitter.com/}lang", + (lang :> obj)) + ("{http://www.w3.org/2005/Atom}author", + (author :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Entry + XmlElement.Create(xElement) + + member Author: XmlProvider+Author with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}author") + + member Content: XmlProvider+Content with get + XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}content") + + member Geo: XmlProvider+Geo with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}geo") + + member Id: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}id")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Lang: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}lang")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Links: XmlProvider+XmlProvider+Link[] with get + XmlRuntime.ConvertArray(this, "{http://www.w3.org/2005/Atom}link", new Func<_,_>(id))) + + member Metadata: XmlProvider+Metadata with get + XmlRuntime.GetChild(this, "{http://api.twitter.com/}metadata") + + member Published: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}published")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + member Source: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}source")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Title: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}title")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Updated: System.DateTimeOffset with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}updated")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertDateTimeOffset("", value), value) + + +class XmlProvider+Link2 : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link2 + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link2 + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Author : FDR.BaseTypes.XmlElement + new : name:string -> uri:string -> XmlProvider+Author + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}author", + [| |], + [| ("{http://www.w3.org/2005/Atom}name", + (name :> obj)) + ("{http://www.w3.org/2005/Atom}uri", + (uri :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Author + XmlElement.Create(xElement) + + member Name: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}name")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + member Uri: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://www.w3.org/2005/Atom}uri")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Content : FDR.BaseTypes.XmlElement + new : type:string -> value:string -> XmlProvider+Content + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}content", + [| ("type", + (type :> obj)) |], + [| ("", + (value :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Content + XmlElement.Create(xElement) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + member Value: string with get + let value = XmlRuntime.TryGetValue(this) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Geo : FDR.BaseTypes.XmlElement + new : () -> XmlProvider+Geo + XmlRuntime.CreateRecord("{http://api.twitter.com/}geo", + [| |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Geo + XmlElement.Create(xElement) + + +class XmlProvider+Link : FDR.BaseTypes.XmlElement + new : type:string -> href:string -> rel:string -> XmlProvider+Link + XmlRuntime.CreateRecord("{http://www.w3.org/2005/Atom}link", + [| ("type", + (type :> obj)) + ("href", + (href :> obj)) + ("rel", + (rel :> obj)) |], + [| |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Link + XmlElement.Create(xElement) + + member Href: string with get + let value = XmlRuntime.TryGetAttribute(this, "href") + TextRuntime.GetNonOptionalValue("Attribute href", TextRuntime.ConvertString(value), value) + + member Rel: string with get + let value = XmlRuntime.TryGetAttribute(this, "rel") + TextRuntime.GetNonOptionalValue("Attribute rel", TextRuntime.ConvertString(value), value) + + member Type: string with get + let value = XmlRuntime.TryGetAttribute(this, "type") + TextRuntime.GetNonOptionalValue("Attribute type", TextRuntime.ConvertString(value), value) + + +class XmlProvider+Metadata : FDR.BaseTypes.XmlElement + new : resultType:string -> XmlProvider+Metadata + XmlRuntime.CreateRecord("{http://api.twitter.com/}metadata", + [| |], + [| ("{http://api.twitter.com/}result_type", + (resultType :> obj)) |], "") + + new : xElement:System.Xml.Linq.XElement -> XmlProvider+Metadata + XmlElement.Create(xElement) + + member ResultType: string with get + let value = XmlRuntime.TryGetValue(XmlRuntime.GetChild(this, "{http://api.twitter.com/}result_type")) + TextRuntime.GetNonOptionalValue("Value", TextRuntime.ConvertString(value), value) + + diff --git a/tests/FSharp.Data.Tests/CsvProvider.fs b/tests/FSharp.Data.Tests/CsvProvider.fs index 326f813bb..36a69d037 100644 --- a/tests/FSharp.Data.Tests/CsvProvider.fs +++ b/tests/FSharp.Data.Tests/CsvProvider.fs @@ -7,6 +7,7 @@ open System.IO open FSharp.Data.UnitSystems.SI.UnitNames open FSharp.Data open FSharp.Data.Runtime.CsvInference +open FSharp.Data.Runtime open System.Globalization let [] simpleCsv = """ @@ -633,7 +634,7 @@ let ``Parses timespan less than min as string`` () = [] let ``InferColumnTypes shall infer empty string as Double``() = let csv = CsvFile.Load(Path.Combine(__SOURCE_DIRECTORY__, "Data/emptyMissingValue.csv")) - let types = csv.InferColumnTypes(2,[|""|],System.Globalization.CultureInfo.GetCultureInfo(""), null, false, false) + let types = csv.InferColumnTypes(2,[|""|], StructuralInference.InferenceMode'.ValuesOnly, System.Globalization.CultureInfo.GetCultureInfo(""), null, false, false, StructuralInference.defaultUnitsOfMeasureProvider) let expected = "Double" let actual = types.[3].Value.InferedType.Name actual |> should equal expected diff --git a/tests/FSharp.Data.Tests/HtmlParser.fs b/tests/FSharp.Data.Tests/HtmlParser.fs index 90c55e21e..b22feb528 100644 --- a/tests/FSharp.Data.Tests/HtmlParser.fs +++ b/tests/FSharp.Data.Tests/HtmlParser.fs @@ -14,7 +14,8 @@ let getTables includeLayoutTables = { MissingValues = TextConversions.DefaultMissingValues CultureInfo = CultureInfo.InvariantCulture UnitsOfMeasureProvider = StructuralInference.defaultUnitsOfMeasureProvider - PreferOptionals = false } + PreferOptionals = false + InferenceMode = StructuralInference.InferenceMode'.ValuesOnly } HtmlRuntime.getTables (Some parameters) includeLayoutTables [] diff --git a/tests/FSharp.Data.Tests/JsonProvider.fs b/tests/FSharp.Data.Tests/JsonProvider.fs index 4ae96e320..caa3f15ff 100644 --- a/tests/FSharp.Data.Tests/JsonProvider.fs +++ b/tests/FSharp.Data.Tests/JsonProvider.fs @@ -776,3 +776,77 @@ let ``Can control dictionary inference`` () = inferred.Rec.Values |> should equal [|111; 222|] inferred.Rec.Keys |> should equal [|false; true|] + +open FSharp.Data.Runtime.StructuralInference +open FSharp.Data.UnitSystems.SI.UnitNames + +[] +let ambiguousJsonWithInlineSchemas = """ +[ + { "Code": "typeof", "Enabled": true, "Date": "typeof", "Length": "typeof>", "Obj": { "X": "typeof" } }, + { "Code": "123", "Enabled": true, "Date": "2022-06-11", "Length": 1.83, "Obj": { "X": "0" } }, + { "Code": "000", "Enabled": false, "Obj": null }, + { "Code": "4E5", "Enabled": true, "Date": "2022-06-12T01:02:03", "Length": 2.00, "Obj": { "X": "1" } } +] +""" + +type InlineSchemasJsonDefaultInference = JsonProvider +type InlineSchemasJsonNoInference = JsonProvider +type InlineSchemasJsonInlineSchemasHints = JsonProvider +type InlineSchemasJsonInlineSchemasOverrides = JsonProvider + +[] +let ``Inline schemas are disabled by default and are recognized as strings`` () = + // For backward compat, inline schemas are disabled by default. + let sample = InlineSchemasJsonDefaultInference.GetSamples() + sample[1].Code.String.GetType() |> should equal (typeof) + sample[1].Code.Number.GetType() |> should equal (typeof) + sample[1].Enabled.GetType() |> should equal (typeof) + sample[1].Date.String.GetType() |> should equal (typeof) + sample[1].Date.DateTime.GetType() |> should equal (typeof) + sample[1].Length.String.GetType() |> should equal (typeof) + sample[1].Length.Number.GetType() |> should equal (typeof) + sample[1].Obj.Value.X.String.GetType() |> should equal (typeof) + sample[1].Obj.Value.X.Number.GetType() |> should equal (typeof) // (There is probably a little but here. The property should be called Boolean) + +[] +let ``"No inference" mode disables type inference`` () = + let sample = InlineSchemasJsonNoInference.GetSamples() + sample[1].Code.GetType() |> should equal (typeof) + sample[1].Enabled.GetType() |> should equal (typeof) // bool is a json type so it's detected even when inference is disabled. + sample[1].Date.GetType() |> should equal (typeof) + sample[1].Length.String.GetType() |> should equal (typeof) + sample[1].Length.Number.GetType() |> should equal (typeof) // number is also a json type so it's detected as well. + sample[1].Obj.Value.X.GetType() |> should equal (typeof) + +[] +let ``Inline schemas as hints add new types to the value-based inference`` () = + let sample = InlineSchemasJsonInlineSchemasHints.GetSamples() + // Same as with only value inference because the inline schemas define string types: + sample[1].Code.String.GetType() |> should equal (typeof) + sample[1].Code.Number.GetType() |> should equal (typeof) + sample[1].Enabled.GetType() |> should equal (typeof) + sample[1].Date.String.GetType() |> should equal (typeof) + sample[1].Date.DateTime.GetType() |> should equal (typeof) + // This one is inferred as a float instead of a decimal. + // We specified a unit but it cannot be reconciled with other values that don't have it so it's ignored. + sample[1].Length.GetType() |> should equal (typeof) + // This one is now inferred as an int and not a bool: + sample[1].Obj.Value.X.GetType() |> should equal (typeof) + +[] +let ``Inline schemas as overrides replace value-based inference when present`` () = + let sample = InlineSchemasJsonInlineSchemasOverrides.GetSamples() + // We know the Code property can contain letters even though our sample only contain numbers, + // so we added an overriding inline schema. + // With the inline schema, the value is no longer inferred as maybe a float: + sample[1].Code.GetType() |> should equal (typeof) + // Value inference is still used when there is no inline schema: + sample[1].Enabled.GetType() |> should equal (typeof) + // Let's say we want to parse dates ourselves, so we want the provider to always give us strings: + sample[1].Date.GetType() |> should equal (typeof) + // We now have a unit! + sample[1].Length.GetType() |> should equal (typeof option>) + sample[1].Obj.Value.X.GetType() |> should equal (typeof) + // (Note the types in the inline schemas are automatically transformed to options as needed + // when another node does not define any value for the given property) diff --git a/tests/FSharp.Data.Tests/XmlProvider.fs b/tests/FSharp.Data.Tests/XmlProvider.fs index a4174608b..a13028d6e 100644 --- a/tests/FSharp.Data.Tests/XmlProvider.fs +++ b/tests/FSharp.Data.Tests/XmlProvider.fs @@ -1,4 +1,4 @@ -module FSharp.Data.Tests.XmlProvider +module FSharp.Data.Tests.XmlProvider open System open System.Xml.Linq @@ -1246,3 +1246,76 @@ let ``Parses timespan greater than max as string`` () = let ``Parses timespan less than min as string`` () = let span = TimeSpanXML.GetSample().TimespanOneTickLessThanMinValue span.GetType() |> should equal (typeof) + +open FSharp.Data.Runtime.StructuralInference +open FSharp.Data.UnitSystems.SI.UnitNames + +[] +let ambiguousXmlWithInlineSchemas = """ + + typeof{int} + 0 + + 1 + +""" + +type InlineSchemasXmlDefaultInference = XmlProvider +type InlineSchemasXmlNoInference = XmlProvider +type InlineSchemasXmlInlineSchemasHints = XmlProvider +type InlineSchemasXmlInlineSchemasOverrides = XmlProvider + +[] +let ``Inline schemas are disabled by default and are recognized as strings`` () = + // For backward compat, inline schemas are disabled by default. + let sample = InlineSchemasXmlDefaultInference.GetSamples() + sample[1].Code.String.GetType() |> should equal (typeof) + sample[1].Code.Number.GetType() |> should equal (typeof) + sample[1].Enabled.GetType() |> should equal (typeof) + sample[1].Date.String.GetType() |> should equal (typeof) + sample[1].Date.DateTime.GetType() |> should equal (typeof) + sample[1].Length.String.GetType() |> should equal (typeof) + sample[1].Length.Number.GetType() |> should equal (typeof) + sample[1].String.GetType() |> should equal (typeof) + sample[1].Number.GetType() |> should equal (typeof) // (There is probably a little but here. The property should be called Boolean) + +[] +let ``"No inference" mode disables type inference`` () = + let sample = InlineSchemasXmlNoInference.GetSamples() + sample[1].Code.GetType() |> should equal (typeof) + sample[1].Enabled.GetType() |> should equal (typeof) + sample[1].Date.GetType() |> should equal (typeof) + sample[1].Length.GetType() |> should equal (typeof) + sample[1].Value.GetType() |> should equal (typeof) + +[] +let ``Inline schemas as hints add new types to the value-based inference`` () = + let sample = InlineSchemasXmlInlineSchemasHints.GetSamples() + // Same as with only value inference because the inline schemas define string types: + sample[1].Code.String.GetType() |> should equal (typeof) + sample[1].Code.Number.GetType() |> should equal (typeof) + sample[1].Enabled.GetType() |> should equal (typeof) + sample[1].Date.String.GetType() |> should equal (typeof) + sample[1].Date.DateTime.GetType() |> should equal (typeof) + // This one is inferred as a float instead of a decimal. + // We specified a unit but it cannot be reconciled with other values that don't have it so it's ignored. + sample[1].Length.GetType() |> should equal (typeof) + // This one is now inferred as an int and not a bool: + sample[1].Value.GetType() |> should equal (typeof) + +[] +let ``Inline schemas as overrides replace value-based inference when present`` () = + let sample = InlineSchemasXmlInlineSchemasOverrides.GetSamples() + // We know the Code property can contain letters even though our sample only contain numbers, + // so we added an overriding inline schema. + // With the inline schema, the value is no longer inferred as maybe a float: + sample[1].Code.GetType() |> should equal (typeof) + // Value inference is still used when there is no inline schema: + sample[1].Enabled.GetType() |> should equal (typeof) + // Let's say we want to parse dates ourselves, so we want the provider to always give us strings: + sample[1].Date.GetType() |> should equal (typeof) + // We now have a unit! + sample[1].Length.GetType() |> should equal (typeof option>) + sample[1].Value.GetType() |> should equal (typeof) + // (Note the types in the inline schemas are automatically transformed to options as needed + // when another node does not define any value for the given property)