From 42bc2a320880d5adf02e9282bb2fd110f1498aa1 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 2 Jun 2022 19:16:13 +0100 Subject: [PATCH] pre-format --- build.fsx | 24 ++- src/CommonProviderImplementation/Helpers.fs | 149 +++++++++--------- src/CommonRuntime/IO.fs | 41 ++--- src/CommonRuntime/StructuralInference.fs | 2 +- src/CommonRuntime/StructuralTypes.fs | 3 +- src/CommonRuntime/TextRuntime.fs | 2 +- src/Csv/CsvExtensions.fs | 6 +- src/Csv/CsvGenerator.fs | 18 ++- src/Csv/CsvInference.fs | 12 +- src/Csv/CsvProvider.fs | 25 +-- src/Html/HtmlGenerator.fs | 3 +- src/Html/HtmlProvider.fs | 10 +- src/Json/JsonConversionsGenerator.fs | 6 +- src/Json/JsonExtensions.fs | 18 +-- src/Json/JsonGenerator.fs | 89 +++++++---- src/Json/JsonInference.fs | 2 +- src/Json/JsonProvider.fs | 38 ++--- src/Json/JsonRuntime.fs | 8 +- src/Json/JsonValue.fs | 2 +- src/Net/Http.fs | 51 +++--- src/WorldBank/WorldBankProvider.fs | 15 +- src/WorldBank/WorldBankRuntime.fs | 14 +- src/Xml/XmlGenerator.fs | 42 ++--- src/Xml/XmlProvider.fs | 87 +++++----- .../InferenceTests.fs | 2 +- tests/FSharp.Data.Tests/JsonProvider.fs | 27 ++-- tests/FSharp.Data.Tests/JsonValue.fs | 89 ++++++----- 27 files changed, 422 insertions(+), 363 deletions(-) diff --git a/build.fsx b/build.fsx index 6dc2ff0d7..b82f7505e 100644 --- a/build.fsx +++ b/build.fsx @@ -52,7 +52,7 @@ let release = ReleaseNotes.load "RELEASE_NOTES.md" // -------------------------------------------------------------------------------------- // Generate assembly info files with the right version & up-to-date information -Target.create "AssemblyInfo" <| fun _ -> +Target.create "AssemblyInfo" (fun _ -> for file in !! "src/AssemblyInfo*.fs" do let replace (oldValue:string) newValue (str:string) = str.Replace(oldValue, newValue) let title = @@ -66,43 +66,49 @@ Target.create "AssemblyInfo" <| fun _ -> AssemblyInfo.Description summary AssemblyInfo.Version version AssemblyInfo.FileVersion version] +) // -------------------------------------------------------------------------------------- // Clean build results -Target.create "Clean" <| fun _ -> +Target.create "Clean" (fun _ -> seq { yield! !!"**/bin" yield! !!"**/obj" } |> Shell.cleanDirs +) -Target.create "CleanDocs" <| fun _ -> +Target.create "CleanDocs" (fun _ -> Shell.cleanDirs ["docs/output"] +) let internetCacheFolder = Environment.GetFolderPath(Environment.SpecialFolder.InternetCache) -Target.create "CleanInternetCaches" <| fun _ -> +Target.create "CleanInternetCaches" (fun _ -> Shell.cleanDirs [ internetCacheFolder @@ "DesignTimeURIs" internetCacheFolder @@ "WorldBankSchema" internetCacheFolder @@ "WorldBankRuntime"] +) // -------------------------------------------------------------------------------------- // Build library & test projects -Target.create "Build" <| fun _ -> +Target.create "Build" (fun _ -> "FSharp.Data.sln" |> DotNet.build (fun o -> { o with Configuration = DotNet.BuildConfiguration.Release }) +) -Target.create "RunTests" <| fun _ -> +Target.create "RunTests" (fun _ -> "FSharp.Data.sln" |> DotNet.test (fun o -> { o with Configuration = DotNet.BuildConfiguration.Release }) +) // -------------------------------------------------------------------------------------- // Build a NuGet package -Target.create "NuGet" <| fun _ -> +Target.create "NuGet" (fun _ -> // Format the release notes let releaseNotes = release.Notes |> String.concat "\n" @@ -131,6 +137,7 @@ Target.create "NuGet" <| fun _ -> MSBuildParams = { p.MSBuildParams with Properties = properties} } ) "src/FSharp.Data/FSharp.Data.fsproj" +) // -------------------------------------------------------------------------------------- // Generate the documentation @@ -142,7 +149,7 @@ Target.create "GenerateDocs" (fun _ -> // -------------------------------------------------------------------------------------- // Help -Target.create "Help" <| fun _ -> +Target.create "Help" (fun _ -> printfn "" printfn " Please specify the target by calling 'build -t '" printfn "" @@ -156,6 +163,7 @@ Target.create "Help" <| fun _ -> printfn " Other targets:" printfn " * CleanInternetCaches" printfn "" +) Target.create "All" ignore diff --git a/src/CommonProviderImplementation/Helpers.fs b/src/CommonProviderImplementation/Helpers.fs index 4e6eabe58..4f34e8053 100644 --- a/src/CommonProviderImplementation/Helpers.fs +++ b/src/CommonProviderImplementation/Helpers.fs @@ -9,6 +9,7 @@ open System open System.Collections.Generic open System.Reflection open System.Text +open System.Runtime.CompilerServices open FSharp.Core.CompilerServices open FSharp.Quotations open FSharp.Data.Runtime @@ -82,38 +83,41 @@ type DisposableTypeProviderForNamespaces(config, ?assemblyReplacementMap) as x = do idCount <- idCount + 1 let dispose typeNameOpt = - lock disposeActions <| fun () -> + lock disposeActions (fun () -> for i = disposeActions.Count-1 downto 0 do let disposeAction = disposeActions.[i] let discard = disposeAction typeNameOpt if discard then disposeActions.RemoveAt(i) + ) do log (sprintf "Creating TypeProviderForNamespaces %O [%d]" x id) - x.Disposing.Add <| fun _ -> - using (logTime "DisposingEvent" (sprintf "%O [%d]" x id)) <| fun _ -> - dispose None + x.Disposing.Add (fun _ -> + use _holder = logTime "DisposingEvent" (sprintf "%O [%d]" x id) + dispose None) member __.Id = id member __.SetFileToWatch(fullTypeName, path) = - lock filesToWatch <| fun () -> - filesToWatch.[fullTypeName] <- path + lock filesToWatch (fun () -> + filesToWatch.[fullTypeName] <- path) member __.GetFileToWath(fullTypeName) = - lock filesToWatch <| fun () -> + lock filesToWatch (fun () -> match filesToWatch.TryGetValue(fullTypeName) with | true, path -> Some path - | _ -> None + | _ -> None) member __.AddDisposeAction action = - lock disposeActions <| fun () -> disposeActions.Add action + lock disposeActions (fun () -> disposeActions.Add action) member __.InvalidateOneType typeName = - using (logTime "InvalidateOneType" (sprintf "%s in %O [%d]" typeName x id)) <| fun _ -> + begin + use _holder = logTime "InvalidateOneType" (sprintf "%s in %O [%d]" typeName x id) dispose (Some typeName) log (sprintf "Calling invalidate for %O [%d]" x id) + end base.Invalidate() #if LOGGING_ENABLED @@ -205,7 +209,7 @@ module internal ProviderHelpers = let private parseTextAtDesignTime valueToBeParsedOrItsUri parseFunc formatName (tp:DisposableTypeProviderForNamespaces) (cfg:TypeProviderConfig) encodingStr resolutionFolder resource fullTypeName maxNumberOfRows = - using (logTime "LoadingTextToBeParsed" valueToBeParsedOrItsUri) <| fun _ -> + use _holder = logTime "LoadingTextToBeParsed" valueToBeParsedOrItsUri let tryGetResource() = if resource = "" then None else readResource(tp, resource) @@ -250,14 +254,14 @@ module internal ProviderHelpers = | None -> reader.ReadToEnd() | Some max -> let sb = StringBuilder() - let max = ref max - while !max > 0 do + let mutable max = max + while max > 0 do let line = reader.ReadLine() if line = null then - max := 0 + max <- 0 else line |> sb.AppendLine |> ignore - decr max + max <- max - 1 sb.ToString() try @@ -300,7 +304,7 @@ module internal ProviderHelpers = // Also cache temporarily during partial invalidation since the invalidation of one TP always causes invalidation of all TPs let internal getOrCreateProvidedType (cfg: TypeProviderConfig) (tp:DisposableTypeProviderForNamespaces) (fullTypeName:string) f = - using (logTime "GeneratingProvidedType" (sprintf "%s [%d]" fullTypeName tp.Id)) <| fun _ -> + use _holder = logTime "GeneratingProvidedType" (sprintf "%s [%d]" fullTypeName tp.Id) let fullKey = (fullTypeName, cfg.RuntimeAssembly, cfg.ResolutionFolder, cfg.SystemRuntimeAssemblyVersion) @@ -325,7 +329,7 @@ module internal ProviderHelpers = | None -> None // On disposal of one of the types, remove that type from the cache, and add all others to the cache - tp.AddDisposeAction <| fun typeNameBeingDisposedOpt -> + tp.AddDisposeAction (fun typeNameBeingDisposedOpt -> // might be called more than once for each watcher, but the Dispose action is a NOP the second time watcher |> Option.iter (fun watcher -> watcher.Dispose()) @@ -346,7 +350,7 @@ module internal ProviderHelpers = // there will be two invalidations: A and B // when the dispose action is called with A, B is added to the cache // so we need to keep the dispose action around so it will be called with B and the cache is removed - false + false) match providedTypesCache.TryRetrieve(fullTypeName, true) with | Some (providedType, fullKey2, watchedFile) when fullKey = fullKey2 -> @@ -381,7 +385,7 @@ module internal ProviderHelpers = (tp:DisposableTypeProviderForNamespaces) (cfg:TypeProviderConfig) encodingStr resolutionFolder resource fullTypeName maxNumberOfRows = - getOrCreateProvidedType cfg tp fullTypeName <| fun () -> + getOrCreateProvidedType cfg tp fullTypeName (fun () -> let isRunningInFSI = cfg.IsHostedExecution let defaultResolutionFolder = cfg.ResolutionFolder @@ -400,15 +404,16 @@ module internal ProviderHelpers = let resultType = spec.RepresentationType let resultTypeAsync = typedefof>.MakeGenericType(resultType) - using (logTime "CommonTypeGeneration" valueToBeParsedOrItsUri) <| fun _ -> + use _holder = logTime "CommonTypeGeneration" valueToBeParsedOrItsUri [ // Generate static Parse method let args = [ ProvidedParameter("text", typeof) ] - let m = ProvidedMethod("Parse", args, resultType, isStatic = true, - invokeCode = fun (Singleton text) -> - <@ new StringReader(%%text) :> TextReader @> - |> spec.CreateFromTextReader ) - m.AddXmlDoc <| sprintf "Parses the specified %s string" formatName + let m = + let parseCode (Singleton text: Expr list) = + <@ new StringReader(%%text) :> TextReader @> + |> spec.CreateFromTextReader + ProvidedMethod("Parse", args, resultType, isStatic = true, invokeCode = parseCode) + m.AddXmlDoc (sprintf "Parses the specified %s string" formatName) yield m :> MemberInfo match spec.CreateListFromTextReader with @@ -416,47 +421,47 @@ module internal ProviderHelpers = | Some listParser -> let resultTypeList = resultType.MakeArrayType() let args = [ ProvidedParameter("text", typeof) ] - let m = ProvidedMethod("ParseList", args, resultTypeList, isStatic = true, - invokeCode = fun (Singleton text) -> - <@ new StringReader(%%text) :> TextReader @> - |> listParser ) - m.AddXmlDoc <| sprintf "Parses the specified %s string" formatName + let parseListCode (Singleton text: Expr list) = + <@ new StringReader(%%text) :> TextReader @> + |> listParser + let m = ProvidedMethod("ParseList", args, resultTypeList, isStatic = true, invokeCode = parseListCode) + m.AddXmlDoc (sprintf "Parses the specified %s string" formatName) yield m :> _ // Generate static Load stream method let args = [ ProvidedParameter("stream", typeof) ] - let m = ProvidedMethod("Load", args, resultType, isStatic = true, - invokeCode = fun (Singleton stream) -> - <@ new StreamReader(%%stream:Stream) :> TextReader @> - |> spec.CreateFromTextReader) - m.AddXmlDoc <| sprintf "Loads %s from the specified stream" formatName + let loadCode1 (Singleton stream: Expr list) = + <@ new StreamReader(%%stream:Stream) :> TextReader @> + |> spec.CreateFromTextReader + let m = ProvidedMethod("Load", args, resultType, isStatic = true, invokeCode = loadCode1) + m.AddXmlDoc (sprintf "Loads %s from the specified stream" formatName) yield m :> _ // Generate static Load reader method let args = [ ProvidedParameter("reader", typeof) ] - let m = ProvidedMethod("Load", args, resultType, isStatic = true, - invokeCode = fun (Singleton reader) -> - let reader = reader |> Expr.Cast - reader |> spec.CreateFromTextReader) - m.AddXmlDoc <| sprintf "Loads %s from the specified reader" formatName + let loadCode2 (Singleton reader: Expr list) = + let reader = reader |> Expr.Cast + reader |> spec.CreateFromTextReader + let m = ProvidedMethod("Load", args, resultType, isStatic = true, invokeCode = loadCode2) + m.AddXmlDoc (sprintf "Loads %s from the specified reader" formatName) yield m :> _ // Generate static Load uri method let args = [ ProvidedParameter("uri", typeof) ] - let m = ProvidedMethod("Load", args, resultType, isStatic = true, - invokeCode = fun (Singleton uri) -> - <@ Async.RunSynchronously(asyncReadTextAtRuntime isRunningInFSI defaultResolutionFolder resolutionFolder formatName encodingStr %%uri) @> - |> spec.CreateFromTextReader) - m.AddXmlDoc <| sprintf "Loads %s from the specified uri" formatName + let loadCode3 (Singleton uri: Expr list) = + <@ Async.RunSynchronously(asyncReadTextAtRuntime isRunningInFSI defaultResolutionFolder resolutionFolder formatName encodingStr %%uri) @> + |> spec.CreateFromTextReader + let m = ProvidedMethod("Load", args, resultType, isStatic = true, invokeCode = loadCode3) + m.AddXmlDoc (sprintf "Loads %s from the specified uri" formatName) yield m :> _ // Generate static AsyncLoad uri method let args = [ ProvidedParameter("uri", typeof) ] - let m = ProvidedMethod("AsyncLoad", args, resultTypeAsync, isStatic = true, - invokeCode = fun (Singleton uri) -> - let readerAsync = <@ asyncReadTextAtRuntime isRunningInFSI defaultResolutionFolder resolutionFolder formatName encodingStr %%uri @> - asyncMap resultType readerAsync spec.CreateFromTextReader) - m.AddXmlDoc <| sprintf "Loads %s from the specified uri" formatName + let asyncLoadCode (Singleton uri: Expr list) = + let readerAsync = <@ asyncReadTextAtRuntime isRunningInFSI defaultResolutionFolder resolutionFolder formatName encodingStr %%uri @> + asyncMap resultType readerAsync spec.CreateFromTextReader + let m = ProvidedMethod("AsyncLoad", args, resultTypeAsync, isStatic = true, invokeCode = asyncLoadCode) + m.AddXmlDoc (sprintf "Loads %s from the specified uri" formatName) yield m :> _ // Generate static Load value method @@ -464,11 +469,11 @@ module internal ProviderHelpers = | None -> () | Some (valueType, valueMapper) -> let args = [ ProvidedParameter("value", valueType) ] - let m = ProvidedMethod("Load", args, resultType, isStatic = true, - invokeCode = fun (Singleton value) -> - let value = value |> Expr.Cast - <@ %value @> |> valueMapper) - m.AddXmlDoc <| sprintf "Loads %s from the specified value" formatName + let loadCode (Singleton value: Expr list) = + let value = value |> Expr.Cast + <@ %value @> |> valueMapper + let m = ProvidedMethod("Load", args, resultType, isStatic = true, invokeCode = loadCode) + m.AddXmlDoc (sprintf "Loads %s from the specified value" formatName) yield m :> _ if not parseResult.IsResource then @@ -483,21 +488,21 @@ module internal ProviderHelpers = let resultTypeArrayAsync = typedefof>.MakeGenericType(resultTypeArray) // Generate static GetSamples method - let m = ProvidedMethod("GetSamples", [], resultTypeArray, isStatic = true, - invokeCode = fun _ -> - if parseResult.IsUri - then <@ Async.RunSynchronously(asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr valueToBeParsedOrItsUri) @> - else <@ new StringReader(valueToBeParsedOrItsUri) :> TextReader @> - |> spec.CreateFromTextReaderForSampleList) + let getSamplesCode _ = + if parseResult.IsUri + then <@ Async.RunSynchronously(asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr valueToBeParsedOrItsUri) @> + else <@ new StringReader(valueToBeParsedOrItsUri) :> TextReader @> + |> spec.CreateFromTextReaderForSampleList + let m = ProvidedMethod("GetSamples", [], resultTypeArray, isStatic = true, invokeCode = getSamplesCode) yield m :> _ if parseResult.IsUri then // Generate static AsyncGetSamples method - let m = ProvidedMethod("AsyncGetSamples", [], resultTypeArrayAsync, isStatic = true, - invokeCode = fun _ -> - let readerAsync = <@ asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr valueToBeParsedOrItsUri @> - spec.CreateFromTextReaderForSampleList - |> asyncMap resultTypeArray readerAsync) + let methCode _ = + let readerAsync = <@ asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr valueToBeParsedOrItsUri @> + spec.CreateFromTextReaderForSampleList + |> asyncMap resultTypeArray readerAsync + let m = ProvidedMethod("AsyncGetSamples", [], resultTypeArrayAsync, isStatic = true, invokeCode = methCode) yield m :> _ | Sample _ -> @@ -518,10 +523,10 @@ module internal ProviderHelpers = if parseResult.IsUri then // Generate static AsyncGetSample method - let m = ProvidedMethod("Async" + name, [], resultTypeAsync, isStatic = true, - invokeCode = fun _ -> - let readerAsync = <@ asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr valueToBeParsedOrItsUri @> - asyncMap resultType readerAsync spec.CreateFromTextReader) + let asyncGetSampleCode _ = + let readerAsync = <@ asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr valueToBeParsedOrItsUri @> + asyncMap resultType readerAsync spec.CreateFromTextReader + let m = ProvidedMethod("Async" + name, [], resultTypeAsync, isStatic = true, invokeCode = asyncGetSampleCode) yield m :> _ | Schema _ -> @@ -538,9 +543,7 @@ module internal ProviderHelpers = ] |> spec.GeneratedType.AddMembers - spec.GeneratedType - -open System.Runtime.CompilerServices + spec.GeneratedType) [] do() diff --git a/src/CommonRuntime/IO.fs b/src/CommonRuntime/IO.fs index 29b8c3e2a..4f2bb3ed1 100644 --- a/src/CommonRuntime/IO.fs +++ b/src/CommonRuntime/IO.fs @@ -60,13 +60,14 @@ type internal UriResolver = let private logLock = obj() let mutable private indentation = 0 -let private appendToLogMultiple logFile lines = lock logLock <| fun () -> - let path = __SOURCE_DIRECTORY__ + "/../../" + logFile - use stream = File.Open(path, FileMode.Append, FileAccess.Write, FileShare.ReadWrite) - use writer = new StreamWriter(stream) - for (line:string) in lines do - writer.WriteLine(line.Replace("\r", null).Replace("\n","\\n")) - writer.Flush() +let private appendToLogMultiple logFile lines = + lock logLock (fun () -> + let path = __SOURCE_DIRECTORY__ + "/../../" + logFile + use stream = File.Open(path, FileMode.Append, FileAccess.Write, FileShare.ReadWrite) + use writer = new StreamWriter(stream) + for (line:string) in lines do + writer.WriteLine(line.Replace("\r", null).Replace("\n","\\n")) + writer.Flush()) let private appendToLog logFile line = appendToLogMultiple logFile [line] @@ -168,7 +169,7 @@ let watchForChanges path (owner, onChange) = let watcher = - lock watchers <| fun () -> + lock watchers (fun () -> match watchers.TryGetValue(path) with | true, watcher -> @@ -184,12 +185,14 @@ let watchForChanges path (owner, onChange) = watcher.Subscribe(owner, onChange) watchers.Add(path, watcher) watcher + ) { new IDisposable with member __.Dispose() = - lock watchers <| fun () -> + lock watchers (fun () -> if watcher.Unsubscribe(owner) then - watchers.Remove(path) |> ignore + watchers.Remove(path) |> ignore + ) } /// Opens a stream to the uri using the uriResolver resolution rules @@ -221,21 +224,21 @@ let internal asyncRead (uriResolver:UriResolver) formatName encodingStr (uri:Uri return new StreamReader(file, encoding) :> TextReader }, Some path -let private withUri uri f = +let private withUri uri = match Uri.TryCreate(uri, UriKind.RelativeOrAbsolute) with | false, _ -> failwithf "Invalid uri: %s" uri - | true, uri -> f uri + | true, uri -> uri /// Returns a TextReader for the uri using the runtime resolution rules let asyncReadTextAtRuntime forFSI defaultResolutionFolder resolutionFolder formatName encodingStr uri = - withUri uri <| fun uri -> - let resolver = UriResolver.Create((if forFSI then RuntimeInFSI else Runtime), - defaultResolutionFolder, resolutionFolder) - asyncRead resolver formatName encodingStr uri |> fst + let uri = withUri uri + let resolver = UriResolver.Create((if forFSI then RuntimeInFSI else Runtime), + defaultResolutionFolder, resolutionFolder) + asyncRead resolver formatName encodingStr uri |> fst /// Returns a TextReader for the uri using the designtime resolution rules let asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr uri = - withUri uri <| fun uri -> - let resolver = UriResolver.Create(DesignTime, defaultResolutionFolder, resolutionFolder) - asyncRead resolver formatName encodingStr uri |> fst + let uri = withUri uri + let resolver = UriResolver.Create(DesignTime, defaultResolutionFolder, resolutionFolder) + asyncRead resolver formatName encodingStr uri |> fst diff --git a/src/CommonRuntime/StructuralInference.fs b/src/CommonRuntime/StructuralInference.fs index fd4beacd1..1a8f43c7c 100644 --- a/src/CommonRuntime/StructuralInference.fs +++ b/src/CommonRuntime/StructuralInference.fs @@ -269,7 +269,7 @@ let inferPrimitiveType (cultureInfo:CultureInfo) (value : string) = | 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 [| |] (*useNoneForMissingValues*)false) _ -> typeof + | Parse (TextConversions.AsFloat [| |] false) _ -> typeof | Parse asGuid _ -> typeof | _ -> typeof diff --git a/src/CommonRuntime/StructuralTypes.fs b/src/CommonRuntime/StructuralTypes.fs index 5bf4e0b4a..6d2d7a2ff 100644 --- a/src/CommonRuntime/StructuralTypes.fs +++ b/src/CommonRuntime/StructuralTypes.fs @@ -88,7 +88,8 @@ type InferedType = | Record(name, props, false) -> Record(name, props, true) | Json(typ, false) -> Json(typ, true) | Collection (order, types) -> - Collection (order, Map.map (fun _ (mult, typ) -> (if mult = Single then OptionalSingle else mult), typ) types) + let typesR = types |> Map.map (fun _ (mult, typ) -> (if mult = Single then OptionalSingle else mult), typ) + Collection (order, typesR) | Top -> failwith "EnsuresHandlesMissingValues: unexpected InferedType.Top" member x.DropOptionality() = diff --git a/src/CommonRuntime/TextRuntime.fs b/src/CommonRuntime/TextRuntime.fs index 178b5fed1..36e3af90f 100644 --- a/src/CommonRuntime/TextRuntime.fs +++ b/src/CommonRuntime/TextRuntime.fs @@ -50,7 +50,7 @@ type TextRuntime = static member ConvertFloat(cultureStr, missingValuesStr, text) = text |> Option.bind (TextConversions.AsFloat (TextRuntime.GetMissingValues missingValuesStr) - (*useNoneForMissingValues*)true + true (TextRuntime.GetCulture cultureStr)) static member ConvertBoolean(text) = diff --git a/src/Csv/CsvExtensions.fs b/src/Csv/CsvExtensions.fs index dd0452449..80edb8088 100644 --- a/src/Csv/CsvExtensions.fs +++ b/src/Csv/CsvExtensions.fs @@ -9,8 +9,8 @@ open System.Runtime.InteropServices open FSharp.Data open FSharp.Data.Runtime -[] /// Extension methods with conversions from strings to other types +[] type StringExtensions = [] @@ -38,7 +38,7 @@ type StringExtensions = static member AsFloat(x:String, [] ?cultureInfo, [] ?missingValues) = let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues - match TextConversions.AsFloat missingValues (*useNoneForMissingValues*)false cultureInfo x with + match TextConversions.AsFloat missingValues false cultureInfo x with | Some f -> f | _ -> failwithf "Not a float: %s" x @@ -75,8 +75,8 @@ type StringExtensions = | Some g -> g | _ -> failwithf "Not a guid: %s" x -[] /// Provides the dynamic operator for getting column values by name from CSV rows +[] module CsvExtensions = /// Get the value of a column by name from a CSV row diff --git a/src/Csv/CsvGenerator.fs b/src/Csv/CsvGenerator.fs index f7321e931..6c989472e 100644 --- a/src/Csv/CsvGenerator.fs +++ b/src/Csv/CsvGenerator.fs @@ -30,13 +30,16 @@ module internal CsvTypeBuilder = let fields = inferredFields |> List.mapi (fun index field -> let typ, typWithoutMeasure, conv, convBack = ConversionsGenerator.convertStringValue missingValuesStr cultureStr field let propertyName = NameUtils.capitalizeFirstLetter field.Name - { TypeForTuple = typWithoutMeasure - ProvidedProperty = ProvidedProperty(propertyName, typ, getterCode = fun (Singleton row) -> + let prop = ProvidedProperty(propertyName, typ, getterCode = fun (Singleton row) -> match inferredFields with | [ _ ] -> row | _ -> Expr.TupleGet(row, index)) - Convert = fun rowVarExpr -> conv <@ TextConversions.AsString((%%rowVarExpr:string[]).[index]) @> - ConvertBack = fun rowVarExpr -> convBack (match inferredFields with [ _ ] -> rowVarExpr | _ -> Expr.TupleGet(rowVarExpr, index)) + let convert rowVarExpr = conv <@ TextConversions.AsString((%%rowVarExpr:string[]).[index]) @> + let convertBack rowVarExpr = convBack (match inferredFields with [ _ ] -> rowVarExpr | _ -> Expr.TupleGet(rowVarExpr, index)) + { TypeForTuple = typWithoutMeasure + ProvidedProperty = prop + Convert = convert + ConvertBack = convertBack ProvidedParameter = ProvidedParameter(NameUtils.niceCamelName propertyName, typ) } ) // The erased row type will be a tuple of all the field types (without the units of measure). If there is a single column then it is just the column type. @@ -48,10 +51,13 @@ module internal CsvTypeBuilder = let rowType = ProvidedTypeDefinition("Row", Some rowErasedType, hideObjectMethods = true, nonNullable = true) let ctor = - ProvidedConstructor([ for field in fields -> field.ProvidedParameter ], invokeCode = fun args -> + let parameters = [ for field in fields -> field.ProvidedParameter ] + let invoke args = match args with | [ arg ] -> arg - | _ -> Expr.NewTuple(args)) + | _ -> Expr.NewTuple(args) + ProvidedConstructor(parameters, invokeCode = invoke) + rowType.AddMember ctor // Each property of the generated row type will simply be a tuple get diff --git a/src/Csv/CsvInference.fs b/src/Csv/CsvInference.fs index adf340e8a..e94167eaa 100644 --- a/src/Csv/CsvInference.fs +++ b/src/Csv/CsvInference.fs @@ -50,11 +50,11 @@ let private overrideByNameRegex = lazy Regex(@"^(?.+)(->(?.+)(=(? [] type private SchemaParseResult = - | Name of string - | NameAndUnit of string * Type - | Full of PrimitiveInferedProperty - | FullByName of PrimitiveInferedProperty * (*originalName*)string - | Rename of (*name*)string * (*originalName*)string + | Name of name: string + | NameAndUnit of name: string * unitOfMeasure: Type + | Full of property: PrimitiveInferedProperty + | FullByName of property: PrimitiveInferedProperty * originalName: string + | Rename of name: string * originalName: string let private asOption = function true, x -> Some x | false, _ -> None @@ -263,7 +263,7 @@ let internal inferType (headerNamesAndUnits:_[]) schema (rows:seq<_>) inferRows // all the columns types are already set, so all the rows will be the same types |> List.head else - List.reduce (StructuralInference.subtypeInfered ((*allowEmptyValues*)not preferOptionals)) types + List.reduce (StructuralInference.subtypeInfered (not preferOptionals)) types inferedType, schema diff --git a/src/Csv/CsvProvider.fs b/src/Csv/CsvProvider.fs index 82584a7e9..965cd8cc5 100644 --- a/src/Csv/CsvProvider.fs +++ b/src/Csv/CsvProvider.fs @@ -54,7 +54,8 @@ type public CsvProvider(cfg:TypeProviderConfig) as this = let getSpec (extension:string) value = - use sampleCsv = using (IO.logTime "Parsing" sample) <| fun _ -> + use sampleCsv = + use _holder = IO.logTime "Parsing" sample let separators = if String.IsNullOrEmpty separators && extension.ToLowerInvariant() = ".tsv" then "\t" else separators @@ -72,11 +73,12 @@ type public CsvProvider(cfg:TypeProviderConfig) as this = let separators = sampleCsv.Separators - let inferredFields = using (IO.logTime "Inference" sample) <| fun _ -> + let inferredFields = + use _holder = IO.logTime "Inference" sample sampleCsv.InferColumnTypes(inferRows, TextRuntime.GetMissingValues missingValuesStr, TextRuntime.GetCulture cultureStr, schema, assumeMissingValues, preferOptionals, ProviderHelpers.unitsOfMeasureProvider) - using (IO.logTime "TypeGeneration" sample) <| fun _ -> + use _holder = IO.logTime "TypeGeneration" sample let csvType, csvErasedType, rowType, stringArrayToRow, rowToStringArray = inferredFields @@ -91,22 +93,21 @@ type public CsvProvider(cfg:TypeProviderConfig) as this = | None -> <@@ None: string[] option @@> | Some headers -> Expr.NewArray(typeof, headers |> Array.map (fun h -> Expr.Value(h)) |> List.ofArray) |> (fun x-> <@@ Some (%%x : string[]) @@>) - let ctor = - ProvidedConstructor( - [ ProvidedParameter("rows", paramType) ], - invokeCode = (fun (Singleton paramValue) -> - let body = csvErasedType?CreateEmpty () (Expr.Var rowToStringArrayVar, paramValue, headers, sampleCsv.NumberOfColumns, separators, quote) - Expr.Let(rowToStringArrayVar, rowToStringArray, body))) + let ctorCode (Singleton paramValue: Expr list) = + let body = csvErasedType?CreateEmpty () (Expr.Var rowToStringArrayVar, paramValue, headers, sampleCsv.NumberOfColumns, separators, quote) + Expr.Let(rowToStringArrayVar, rowToStringArray, body) + let ctor = ProvidedConstructor([ ProvidedParameter("rows", paramType) ], invokeCode = ctorCode) csvType.AddMember(ctor) + let parseRowsCode (Singleton text: Expr list) = + let body = csvErasedType?ParseRows () (text, Expr.Var stringArrayToRowVar, separators, quote, ignoreErrors) + Expr.Let(stringArrayToRowVar, stringArrayToRow, body) let parseRows = ProvidedMethod("ParseRows", [ProvidedParameter("text", typeof)], rowType.MakeArrayType(), isStatic = true, - invokeCode = fun (Singleton text) -> - let body = csvErasedType?ParseRows () (text, Expr.Var stringArrayToRowVar, separators, quote, ignoreErrors) - Expr.Let(stringArrayToRowVar, stringArrayToRow, body)) + invokeCode = parseRowsCode) csvType.AddMember parseRows { GeneratedType = csvType diff --git a/src/Html/HtmlGenerator.fs b/src/Html/HtmlGenerator.fs index 489c944d8..d3f0e747a 100644 --- a/src/Html/HtmlGenerator.fs +++ b/src/Html/HtmlGenerator.fs @@ -26,9 +26,10 @@ module internal HtmlGenerator = let private getPropertyName = NameUtils.capitalizeFirstLetter let private typeNameGenerator() = - NameUtils.uniqueGenerator <| fun s -> + NameUtils.uniqueGenerator (fun s -> HtmlParser.invalidTypeNameRegex.Value.Replace(s, " ") |> NameUtils.nicePascalName + ) let private createTableType getTableTypeName (inferenceParameters, missingValuesStr, cultureStr) (table:HtmlTable) = diff --git a/src/Html/HtmlProvider.fs b/src/Html/HtmlProvider.fs index 0fd0bc591..03762b7d1 100644 --- a/src/Html/HtmlProvider.fs +++ b/src/Html/HtmlProvider.fs @@ -36,10 +36,12 @@ type public HtmlProvider(cfg:TypeProviderConfig) as this = let getSpec _ value = - let doc = using (IO.logTime "Parsing" sample) <| fun _ -> + let doc = + use _holder = IO.logTime "Parsing" sample HtmlDocument.Parse value - let htmlType = using (IO.logTime "Inference" sample) <| fun _ -> + let htmlType = + use _holder = IO.logTime "Inference" sample let inferenceParameters : HtmlInference.Parameters = { MissingValues = TextRuntime.GetMissingValues missingValuesStr CultureInfo = TextRuntime.GetCulture cultureStr @@ -49,7 +51,7 @@ type public HtmlProvider(cfg:TypeProviderConfig) as this = |> HtmlRuntime.getHtmlObjects (Some inferenceParameters) includeLayoutTables |> HtmlGenerator.generateTypes asm ns typeName (inferenceParameters, missingValuesStr, cultureStr) - using (IO.logTime "TypeGeneration" sample) <| fun _ -> + use _holder = IO.logTime "TypeGeneration" sample { GeneratedType = htmlType RepresentationType = htmlType @@ -59,7 +61,7 @@ type public HtmlProvider(cfg:TypeProviderConfig) as this = CreateFromValue = None } - generateType "HTML" (Sample sample) getSpec this cfg encodingStr resolutionFolder resource typeName (*maxNumberOfRows*)None + generateType "HTML" (Sample sample) getSpec this cfg encodingStr resolutionFolder resource typeName None // Add static parameter that specifies the API we want to get (compile-time) let parameters = diff --git a/src/Json/JsonConversionsGenerator.fs b/src/Json/JsonConversionsGenerator.fs index 4d8c0cfd7..f49660a6e 100644 --- a/src/Json/JsonConversionsGenerator.fs +++ b/src/Json/JsonConversionsGenerator.fs @@ -59,11 +59,13 @@ let convertJsonValue missingValuesStr cultureStr canPassAllConversionCallingType getConversionQuotation missingValuesStr cultureStr field.InferedType value match field.TypeWrapper, canPassAllConversionCallingTypes with | TypeWrapper.None, true -> - wrapInLetIfNeeded value <| fun (varExpr:Expr) -> + wrapInLetIfNeeded value (fun (varExpr:Expr) -> typeof?GetNonOptionalValue (field.RuntimeType) (<@ (%varExpr).Path @>, convert <@ (%varExpr).JsonOpt @>, <@ (%varExpr).JsonOpt @>) + ) | TypeWrapper.None, false -> - wrapInLetIfNeeded value <| fun (varExpr:Expr) -> + wrapInLetIfNeeded value (fun (varExpr:Expr) -> typeof?GetNonOptionalValue (field.RuntimeType) (<@ (%varExpr).Path() @>, convert <@ Some (%varExpr).JsonValue @>, <@ Some (%varExpr).JsonValue @>) + ) | TypeWrapper.Option, true -> convert <@ (%%value:JsonValue option) @> | TypeWrapper.Option, false -> diff --git a/src/Json/JsonExtensions.fs b/src/Json/JsonExtensions.fs index 9166f3a07..53ddfcb6c 100644 --- a/src/Json/JsonExtensions.fs +++ b/src/Json/JsonExtensions.fs @@ -11,8 +11,8 @@ open FSharp.Data open FSharp.Data.Runtime open FSharp.Core -[] /// Extension methods with operations on JSON values +[] type JsonExtensions = /// Get a sequence of key-value pairs representing the properties of an object @@ -67,7 +67,7 @@ type JsonExtensions = [] static member AsString(x, [] ?cultureInfo) = let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match JsonConversions.AsString (*useNoneForNullOrEmpty*)false cultureInfo x with + match JsonConversions.AsString false cultureInfo x with | Some s -> s | _ -> failwithf "Not a string: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) @@ -100,7 +100,7 @@ type JsonExtensions = static member AsFloat(x, [] ?cultureInfo, [] ?missingValues) = let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues - match JsonConversions.AsFloat missingValues (*useNoneForMissingValues*)false cultureInfo x with + match JsonConversions.AsFloat missingValues false cultureInfo x with | Some f -> f | _ -> failwithf "Not a float: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) @@ -148,12 +148,12 @@ type JsonExtensions = /// Get inner text of an element [] static member InnerText(x) = - match JsonConversions.AsString (*useNoneForNullOrEmpty*)false CultureInfo.InvariantCulture x with + match JsonConversions.AsString false CultureInfo.InvariantCulture x with | Some str -> str | None -> JsonExtensions.AsArray(x) |> Array.map (fun e -> JsonExtensions.InnerText(e)) |> String.Concat -[] /// Provides the dynamic operator for getting a property of a JSON object +[] module JsonExtensions = /// Get a property of a JSON object @@ -210,7 +210,7 @@ module Options = /// Get the string value of an element (assuming that the value is a scalar) member x.AsString(?cultureInfo) = let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - JsonConversions.AsString (*useNoneForNullOrEmpty*)false cultureInfo x + JsonConversions.AsString false cultureInfo x /// Get a number as an integer (assuming that the value fits in integer) member x.AsInteger(?cultureInfo) = @@ -231,7 +231,7 @@ module Options = member x.AsFloat(?cultureInfo, [] ?missingValues) = let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues - JsonConversions.AsFloat missingValues (*useNoneForMissingValues*)true cultureInfo x + JsonConversions.AsFloat missingValues true cultureInfo x /// Get the boolean value of an element (assuming that the value is a boolean) member x.AsBoolean(?cultureInfo) = @@ -311,7 +311,7 @@ module Options = [] static member AsString(x, [] ?cultureInfo) = let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - x |> Option.bind (JsonConversions.AsString (*useNoneForNullOrEmpty*)false cultureInfo) + x |> Option.bind (JsonConversions.AsString false cultureInfo) /// Get a number as an integer (assuming that the value fits in integer) [] @@ -336,7 +336,7 @@ module Options = static member AsFloat(x, [] ?cultureInfo, [] ?missingValues) = let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues - x |> Option.bind (JsonConversions.AsFloat missingValues (*useNoneForMissingValues*)true cultureInfo) + x |> Option.bind (JsonConversions.AsFloat missingValues true cultureInfo) /// Get the boolean value of an element (assuming that the value is a boolean) [] diff --git a/src/Json/JsonGenerator.fs b/src/Json/JsonGenerator.fs index 94a464cd3..61488afa6 100644 --- a/src/Json/JsonGenerator.fs +++ b/src/Json/JsonGenerator.fs @@ -171,7 +171,7 @@ module JsonTypeBuilder = let members = [ for tag, multiplicity, inferedType in types -> - let result = generateJsonType ctx (*canPassAllConversionCallingTypes*)false (*optionalityHandledByParent*)false "" inferedType + let result = generateJsonType ctx false false "" inferedType let propName = match tag with @@ -206,29 +206,35 @@ module JsonTypeBuilder = let cultureStr = ctx.CultureStr if forCollection then - let ctor = ProvidedConstructor(parameters, invokeCode = fun args -> + let ctorCode (args: Expr list) = let elements = Expr.NewArray(typeof, args |> List.map (fun a -> Expr.Coerce(a, typeof))) let cultureStr = ctx.CultureStr - <@@ JsonRuntime.CreateArray(%%elements, cultureStr) @@>) + <@@ JsonRuntime.CreateArray(%%elements, cultureStr) @@> + let ctor = ProvidedConstructor(parameters, invokeCode = ctorCode) objectTy.AddMember ctor else for param in parameters do + let ctorCode (Singleton arg: Expr list) = + let arg = Expr.Coerce(arg, typeof) + <@@ JsonRuntime.CreateValue((%%arg:obj), cultureStr) @@> let ctor = - ProvidedConstructor([param], invokeCode = fun (Singleton arg) -> - let arg = Expr.Coerce(arg, typeof) - <@@ JsonRuntime.CreateValue((%%arg:obj), cultureStr) @@>) + ProvidedConstructor([param], invokeCode = ctorCode) objectTy.AddMember ctor let defaultCtor = - ProvidedConstructor([], invokeCode = fun _ -> - <@@ JsonRuntime.CreateValue(null :> obj, cultureStr) @@>) + let ctorCode _ = + <@@ JsonRuntime.CreateValue(null :> obj, cultureStr) @@> + ProvidedConstructor([], invokeCode = ctorCode) objectTy.AddMember defaultCtor - objectTy.AddMember <| + let ctorCode (Singleton arg) = + <@@ JsonDocument.Create((%%arg:JsonValue), "") @@> + let ctor = ProvidedConstructor( [ProvidedParameter("jsonValue", ctx.JsonValueType)], - invokeCode = fun (Singleton arg) -> - <@@ JsonDocument.Create((%%arg:JsonValue), "") @@>) + invokeCode = ctorCode) + + objectTy.AddMember ctor objectTy @@ -265,7 +271,7 @@ module JsonTypeBuilder = | InferedType.Collection (_, SingletonMap(_, (_, typ))) | InferedType.Collection (_, EmptyMap InferedType.Top typ) -> - let elementResult = generateJsonType ctx (*canPassAllConversionCallingTypes*)false (*optionalityHandledByParent*)false nameOverride typ + let elementResult = generateJsonType ctx false false nameOverride typ let conv = fun (jDoc:Expr) -> ctx.JsonRuntimeType?ConvertArray (elementResult.ConvertedTypeErased ctx) (jDoc, elementResult.ConverterFunc ctx) @@ -274,7 +280,8 @@ module JsonTypeBuilder = OptionalConverter = Some conv ConversionCallingType = JsonDocument } - | InferedType.Record(name, props, optional) -> getOrCreateType ctx inferedType <| fun () -> + | InferedType.Record(name, props, optional) -> + getOrCreateType ctx inferedType (fun () -> if optional && not optionalityHandledByParent then failwithf "generateJsonType: optionality not handled for %A" inferedType @@ -318,8 +325,8 @@ module JsonTypeBuilder = // Add all record fields as dictionary items let valueName = name + "Value" - let keyResult = generateJsonType ctx (*canPassAllConversionCallingTypes*)false (*optionalityHandledByParent*)true "" inferedKeyType - let valueResult = generateJsonType ctx (*canPassAllConversionCallingTypes*)false (*optionalityHandledByParent*)true valueName inferedValueType + let keyResult = generateJsonType ctx false true "" inferedKeyType + let valueResult = generateJsonType ctx false true valueName inferedValueType let valueConvertedTypeErased = valueResult.ConvertedTypeErased ctx let tupleType = Microsoft.FSharp.Reflection.FSharpType.MakeTupleType([|keyResult.ConvertedType; valueResult.ConvertedType|]) @@ -359,29 +366,35 @@ module JsonTypeBuilder = ProvidedProperty("Count", typeof, getterCode = countGetter) ProvidedProperty("IsEmpty", typeof, getterCode = isEmptyGetter) ] |> objectTy.AddMembers + [ ProvidedMethod("TryFind", [ProvidedParameter("key", keyResult.ConvertedType)], valueResult.ConvertedType |> ctx.MakeOptionType, tryFindCode) ProvidedMethod("ContainsKey", [ProvidedParameter("key", keyResult.ConvertedType)], typeof, containsKeyCode) ] |> objectTy.AddMembers + if ctx.GenerateConstructors then - objectTy.AddMember <| - ProvidedConstructor([ProvidedParameter("items", itemsSeqType)], invokeCode = fun args -> - let kvSeq = args.Head - let conv (value: Expr) = + let conv (value: Expr) = let value = ProviderHelpers.some keyResult.ConvertedType value ConversionsGenerator.getBackConversionQuotation "" ctx.CultureStr keyResult.ConvertedType value :> Expr + + let ctorCode (args: Expr list) = + let kvSeq = args.Head let convFunc = ReflectionHelpers.makeDelegate conv keyResult.ConvertedType let cultureStr = ctx.CultureStr - ctx.JsonRuntimeType?CreateRecordFromDictionary (keyResult.ConvertedType, valueConvertedTypeErased) (kvSeq, cultureStr, convFunc) ) + ctx.JsonRuntimeType?CreateRecordFromDictionary (keyResult.ConvertedType, valueConvertedTypeErased) (kvSeq, cultureStr, convFunc) + let ctor = + ProvidedConstructor([ProvidedParameter("items", itemsSeqType)], ctorCode ) + objectTy.AddMember ctor + () | None -> // Add all record fields as properties let members = [for prop in props -> - let propResult = generateJsonType ctx (*canPassAllConversionCallingTypes*)true (*optionalityHandledByParent*)true "" prop.Type + let propResult = generateJsonType ctx true true "" prop.Type let propName = prop.Name let optionalityHandledByProperty = propResult.ConversionCallingType <> JsonDocument @@ -430,29 +443,33 @@ module JsonTypeBuilder = objectTy.AddMembers properties if ctx.GenerateConstructors then - objectTy.AddMember <| - ProvidedConstructor(parameters, invokeCode = fun args -> + let ctorCode (args: Expr list) = let properties = Expr.NewArray(typeof, args |> List.mapi (fun i a -> Expr.NewTuple [ Expr.Value names.[i]; Expr.Coerce(a, typeof) ])) let cultureStr = ctx.CultureStr - <@@ JsonRuntime.CreateRecord(%%properties, cultureStr) @@>) + <@@ JsonRuntime.CreateRecord(%%properties, cultureStr) @@> + let ctor = + ProvidedConstructor(parameters, invokeCode = ctorCode) + objectTy.AddMember ctor () if ctx.GenerateConstructors then - objectTy.AddMember <| - ProvidedConstructor( - [ProvidedParameter("jsonValue", ctx.JsonValueType)], - invokeCode = fun (Singleton arg) -> - <@@ JsonDocument.Create((%%arg:JsonValue), "") @@> ) + let ctorCode (Singleton arg: Expr list) = + <@@ JsonDocument.Create((%%arg:JsonValue), "") @@> + let ctorParams = [ProvidedParameter("jsonValue", ctx.JsonValueType)] + let ctor = ProvidedConstructor(ctorParams, ctorCode) + objectTy.AddMember ctor objectTy + ) - | InferedType.Collection (_, types) -> getOrCreateType ctx inferedType <| fun () -> + | InferedType.Collection (_, types) -> + getOrCreateType ctx inferedType (fun () -> // Generate a choice type that calls either `GetArrayChildrenByTypeTag` // or `GetArrayChildByTypeTag`, depending on the multiplicity of the item - generateMultipleChoiceType ctx types (*forCollection*)true nameOverride (fun multiplicity result tagCode -> + generateMultipleChoiceType ctx types true nameOverride (fun multiplicity result tagCode -> match multiplicity with | InferedMultiplicity.Single -> fun (Singleton jDoc) -> // Generate method that calls `GetArrayChildByTypeTag` @@ -470,14 +487,18 @@ module JsonTypeBuilder = // Similar to the previous case, but call `TryGetArrayChildByTypeTag` let cultureStr = ctx.CultureStr ctx.JsonRuntimeType?TryGetArrayChildByTypeTag (result.ConvertedTypeErased ctx) (jDoc, cultureStr, tagCode, result.ConverterFunc ctx)) + ) - | InferedType.Heterogeneous types -> getOrCreateType ctx inferedType <| fun () -> + | InferedType.Heterogeneous types -> + getOrCreateType ctx inferedType (fun () -> // Generate a choice type that always calls `TryGetValueByTypeTag` let types = types |> Map.map (fun _ v -> InferedMultiplicity.OptionalSingle, v) - generateMultipleChoiceType ctx types (*forCollection*)false nameOverride (fun multiplicity result tagCode -> fun (Singleton jDoc) -> + generateMultipleChoiceType ctx types false nameOverride (fun multiplicity result tagCode -> fun (Singleton jDoc) -> assert (multiplicity = InferedMultiplicity.OptionalSingle) let cultureStr = ctx.CultureStr - ctx.JsonRuntimeType?TryGetValueByTypeTag (result.ConvertedTypeErased ctx) (jDoc, cultureStr, tagCode, result.ConverterFunc ctx)) + ctx.JsonRuntimeType?TryGetValueByTypeTag (result.ConvertedTypeErased ctx) (jDoc, cultureStr, tagCode, result.ConverterFunc ctx) + ) + ) | InferedType.Json _ -> failwith "Json type not supported" diff --git a/src/Json/JsonInference.fs b/src/Json/JsonInference.fs index dba7f3b1f..9ba57d6e1 100644 --- a/src/Json/JsonInference.fs +++ b/src/Json/JsonInference.fs @@ -35,7 +35,7 @@ let rec inferType inferTypesFromValues cultureInfo parentName json = | JsonValue.Float f when inferTypesFromValues && inRangeFloat Int64.MinValue Int64.MaxValue f && isIntegerFloat f -> InferedType.Primitive(typeof, None, false) | JsonValue.Float _ -> InferedType.Primitive(typeof, None, false) // More interesting types - | JsonValue.Array ar -> StructuralInference.inferCollectionType (*allowEmptyValues*)false (Seq.map (inferType inferTypesFromValues cultureInfo (NameUtils.singularize parentName)) ar) + | JsonValue.Array ar -> StructuralInference.inferCollectionType false (Seq.map (inferType inferTypesFromValues cultureInfo (NameUtils.singularize parentName)) ar) | JsonValue.Record properties -> let name = if String.IsNullOrEmpty parentName diff --git a/src/Json/JsonProvider.fs b/src/Json/JsonProvider.fs index 935df2205..fb78e6c8d 100644 --- a/src/Json/JsonProvider.fs +++ b/src/Json/JsonProvider.fs @@ -45,33 +45,35 @@ type public JsonProvider(cfg:TypeProviderConfig) as this = let getSpec _ value = - let samples = using (IO.logTime "Parsing" sample) <| fun _ -> + let samples = + use _holder = IO.logTime "Parsing" sample if sampleIsList then JsonDocument.CreateList(new StringReader(value)) |> Array.map (fun doc -> doc.JsonValue) else [| JsonValue.Parse(value) |] - let inferedType = using (IO.logTime "Inference" sample) <| fun _ -> + let inferedType = + use _holder = IO.logTime "Inference" sample samples |> Array.map (fun sampleJson -> JsonInference.inferType inferTypesFromValues cultureInfo "" sampleJson) - |> Array.fold (StructuralInference.subtypeInfered (*allowEmptyValues*)false) InferedType.Top + |> Array.fold (StructuralInference.subtypeInfered false) InferedType.Top - using (IO.logTime "TypeGeneration" sample) <| fun _ -> + use _holder = IO.logTime "TypeGeneration" sample - let ctx = JsonGenerationContext.Create(cultureStr, tpType, ?preferDictionaries = Some preferDictionaries) - let result = JsonTypeBuilder.generateJsonType ctx (*canPassAllConversionCallingTypes*)false (*optionalityHandledByParent*)false rootName inferedType - - { GeneratedType = tpType - RepresentationType = result.ConvertedType - CreateFromTextReader = fun reader -> - result.Convert <@@ JsonDocument.Create(%reader) @@> - CreateListFromTextReader = Some (fun reader -> - result.Convert <@@ JsonDocument.CreateList(%reader) @@>) - CreateFromTextReaderForSampleList = fun reader -> - result.Convert <@@ JsonDocument.CreateList(%reader) @@> - CreateFromValue = Some (typeof, fun value -> result.Convert <@@ JsonDocument.Create(%value, "") @@>) - } + let ctx = JsonGenerationContext.Create(cultureStr, tpType, ?preferDictionaries = Some preferDictionaries) + let result = JsonTypeBuilder.generateJsonType ctx false false rootName inferedType + + { GeneratedType = tpType + RepresentationType = result.ConvertedType + CreateFromTextReader = fun reader -> + result.Convert <@@ JsonDocument.Create(%reader) @@> + CreateListFromTextReader = Some (fun reader -> + result.Convert <@@ JsonDocument.CreateList(%reader) @@>) + CreateFromTextReaderForSampleList = fun reader -> + result.Convert <@@ JsonDocument.CreateList(%reader) @@> + CreateFromValue = Some (typeof, fun value -> result.Convert <@@ JsonDocument.Create(%value, "") @@>) + } let source = if sampleIsList then @@ -79,7 +81,7 @@ type public JsonProvider(cfg:TypeProviderConfig) as this = else Sample sample - generateType "JSON" source getSpec this cfg encodingStr resolutionFolder resource typeName (*maxNumberOfRows*)None + generateType "JSON" source getSpec this cfg encodingStr resolutionFolder resource typeName None // Add static parameter that specifies the API we want to get (compile-time) let parameters = diff --git a/src/Json/JsonRuntime.fs b/src/Json/JsonRuntime.fs index 9d4cbd788..840d56f03 100644 --- a/src/Json/JsonRuntime.fs +++ b/src/Json/JsonRuntime.fs @@ -97,7 +97,7 @@ type JsonRuntime = // json option -> type static member ConvertString(cultureStr, json) = - json |> Option.bind (JsonConversions.AsString (*useNoneForNullOrEmpty*)true (TextRuntime.GetCulture cultureStr)) + json |> Option.bind (JsonConversions.AsString true (TextRuntime.GetCulture cultureStr)) static member ConvertInteger(cultureStr, json) = json |> Option.bind (JsonConversions.AsInteger (TextRuntime.GetCulture cultureStr)) @@ -110,7 +110,7 @@ type JsonRuntime = static member ConvertFloat(cultureStr, missingValuesStr, json) = json |> Option.bind (JsonConversions.AsFloat (TextRuntime.GetMissingValues missingValuesStr) - (*useNoneForMissingValues*)true + true (TextRuntime.GetCulture cultureStr)) static member ConvertBoolean(json) = @@ -244,11 +244,11 @@ type JsonRuntime = | InferedTypeTag.Number -> let cultureInfo = TextRuntime.GetCulture cultureStr fun json -> (JsonConversions.AsDecimal cultureInfo json).IsSome || - (JsonConversions.AsFloat [| |] (*useNoneForMissingValues*)true cultureInfo json).IsSome + (JsonConversions.AsFloat [| |] true cultureInfo json).IsSome | InferedTypeTag.Boolean -> JsonConversions.AsBoolean >> Option.isSome | InferedTypeTag.String -> - JsonConversions.AsString (*useNoneForNullOrEmpty*)true (TextRuntime.GetCulture cultureStr) + JsonConversions.AsString true (TextRuntime.GetCulture cultureStr) >> Option.isSome | InferedTypeTag.DateTime -> let cultureInfo = TextRuntime.GetCulture cultureStr diff --git a/src/Json/JsonValue.fs b/src/Json/JsonValue.fs index dcb27278d..e66051145 100644 --- a/src/Json/JsonValue.fs +++ b/src/Json/JsonValue.fs @@ -240,7 +240,7 @@ type private JsonParser(jsonText:string) = match TextConversions.AsDecimal CultureInfo.InvariantCulture sub with | Some x -> JsonValue.Number x | _ -> - match TextConversions.AsFloat [| |] (*useNoneForMissingValues*)false CultureInfo.InvariantCulture sub with + match TextConversions.AsFloat [| |] false CultureInfo.InvariantCulture sub with | Some x -> JsonValue.Float x | _ -> throw() diff --git a/src/Net/Http.fs b/src/Net/Http.fs index cf66853bf..013e81b34 100644 --- a/src/Net/Http.fs +++ b/src/Net/Http.fs @@ -1748,35 +1748,38 @@ type Http private() = else HttpEncodings.PostDefaultEncoding - let body = body |> Option.map (fun body -> - - let defaultContentType, (bytes: Encoding -> Stream) = - match body with - | TextRequest text -> HttpContentTypes.Text, (fun e -> new MemoryStream(e.GetBytes(text)) :> _) - | BinaryUpload bytes -> HttpContentTypes.Binary, (fun _ -> new MemoryStream(bytes) :> _) - | FormValues values -> - let bytes (e:Encoding) = - [ for k, v in values -> Http.EncodeFormData k + "=" + Http.EncodeFormData v ] - |> String.concat "&" - |> e.GetBytes - HttpContentTypes.FormValues, (fun e -> new MemoryStream(bytes e) :> _) - | Multipart (boundary, parts) -> HttpContentTypes.Multipart(boundary), writeMultipart boundary parts - - // Set default content type if it is not specified by the user - let encoding = - if not hasContentType then - req.ContentType <- defaultContentType + let body = + match body with + | None -> None + | Some body -> + + let defaultContentType, (bytes: Encoding -> Stream) = + match body with + | TextRequest text -> HttpContentTypes.Text, (fun e -> new MemoryStream(e.GetBytes(text)) :> _) + | BinaryUpload bytes -> HttpContentTypes.Binary, (fun _ -> new MemoryStream(bytes) :> _) + | FormValues values -> + let bytes (e:Encoding) = + [ for k, v in values -> Http.EncodeFormData k + "=" + Http.EncodeFormData v ] + |> String.concat "&" + |> e.GetBytes + HttpContentTypes.FormValues, (fun e -> new MemoryStream(bytes e) :> _) + | Multipart (boundary, parts) -> HttpContentTypes.Multipart(boundary), writeMultipart boundary parts + + // Set default content type if it is not specified by the user + let encoding = + if not hasContentType then + req.ContentType <- defaultContentType - getEncoding req.ContentType + getEncoding req.ContentType - bytes encoding) + Some (bytes encoding) match timeout with | Some timeout -> req.Timeout <- timeout | None -> () // Send the request and get the response - augmentWebExceptionsWithDetails <| fun () -> async { + augmentWebExceptionsWithDetails (fun () -> async { let req = match customizeHttpRequest with @@ -1809,7 +1812,7 @@ type Http private() = let stream = resp.GetResponseStream() return! toHttpResponse resp.ResponseUri.OriginalString statusCode contentType characterSet responseEncodingOverride cookies headers stream - } + }) /// Download an HTTP web resource from the specified URL asynchronously /// (allows specifying query string parameters and HTTP headers including @@ -1831,7 +1834,7 @@ type Http private() = [] ?customizeHttpRequest, [] ?timeout ) = - Http.InnerRequest(url, toHttpResponse (*forceText*)false, ?query=query, ?headers=headers, ?httpMethod=httpMethod, ?body=body, ?cookies=cookies, ?cookieContainer=cookieContainer, ?silentCookieErrors=silentCookieErrors, + Http.InnerRequest(url, toHttpResponse false, ?query=query, ?headers=headers, ?httpMethod=httpMethod, ?body=body, ?cookies=cookies, ?cookieContainer=cookieContainer, ?silentCookieErrors=silentCookieErrors, ?silentHttpErrors=silentHttpErrors, ?responseEncodingOverride=responseEncodingOverride, ?customizeHttpRequest=customizeHttpRequest, ?timeout = timeout) /// Download an HTTP web resource from the specified URL asynchronously @@ -1855,7 +1858,7 @@ type Http private() = [] ?timeout ) = async { - let! response = Http.InnerRequest(url, toHttpResponse (*forceText*)true, ?query=query, ?headers=headers, ?httpMethod=httpMethod, ?body=body, ?cookies=cookies, ?cookieContainer=cookieContainer, ?silentCookieErrors = silentCookieErrors, + let! response = Http.InnerRequest(url, toHttpResponse true, ?query=query, ?headers=headers, ?httpMethod=httpMethod, ?body=body, ?cookies=cookies, ?cookieContainer=cookieContainer, ?silentCookieErrors = silentCookieErrors, ?silentHttpErrors=silentHttpErrors, ?responseEncodingOverride=responseEncodingOverride, ?customizeHttpRequest=customizeHttpRequest, ?timeout = timeout) return match response.Body with diff --git a/src/WorldBank/WorldBankProvider.fs b/src/WorldBank/WorldBankProvider.fs index 60545772e..96fbbe143 100644 --- a/src/WorldBank/WorldBankProvider.fs +++ b/src/WorldBank/WorldBankProvider.fs @@ -30,7 +30,7 @@ type public WorldBankProvider(cfg:TypeProviderConfig) as this = let createTypesForSources(sources, worldBankTypeName, asynchronous, addAttributes) = - ProviderHelpers.getOrCreateProvidedType cfg this worldBankTypeName <| fun () -> + ProviderHelpers.getOrCreateProvidedType cfg this worldBankTypeName (fun () -> let connection = ServiceConnection(restCache, defaultServiceUrl, sources) @@ -152,27 +152,28 @@ type public WorldBankProvider(cfg:TypeProviderConfig) as this = ( topic.Name, topicType, getterCode = (fun (Singleton arg) -> <@@ ((%%arg : TopicCollection) :> ITopicCollection).GetTopic(topicIdVal) @@>)) if not (String.IsNullOrEmpty topic.Description) then prop.AddXmlDoc(topic.Description) - yield prop ]) + prop ]) serviceTypesType.AddMember t t let worldBankDataServiceType = let t = ProvidedTypeDefinition("WorldBankDataService", Some typeof, hideObjectMethods = true, nonNullable = true) t.AddMembersDelayed (fun () -> - [ yield ProvidedProperty("Countries", countriesType, getterCode = (fun (Singleton arg) -> <@@ ((%%arg : WorldBankData) :> IWorldBankData).GetCountries() @@>)) - yield ProvidedProperty("Regions", regionsType, getterCode = (fun (Singleton arg) -> <@@ ((%%arg : WorldBankData) :> IWorldBankData).GetRegions() @@>)) - yield ProvidedProperty("Topics", topicsType, getterCode = (fun (Singleton arg) -> <@@ ((%%arg : WorldBankData) :> IWorldBankData).GetTopics() @@>)) ]) + [ ProvidedProperty("Countries", countriesType, getterCode = (fun (Singleton arg) -> <@@ ((%%arg : WorldBankData) :> IWorldBankData).GetCountries() @@>)) + ProvidedProperty("Regions", regionsType, getterCode = (fun (Singleton arg) -> <@@ ((%%arg : WorldBankData) :> IWorldBankData).GetRegions() @@>)) + ProvidedProperty("Topics", topicsType, getterCode = (fun (Singleton arg) -> <@@ ((%%arg : WorldBankData) :> IWorldBankData).GetTopics() @@>)) ]) serviceTypesType.AddMember t t resTy.AddMembersDelayed (fun () -> [ let urlVal = defaultServiceUrl let sourcesVal = sources |> String.concat ";" - yield ProvidedMethod ("GetDataContext", [], worldBankDataServiceType, isStatic=true, - invokeCode = (fun _ -> <@@ WorldBankData(urlVal, sourcesVal) @@>)) + let gdcCode _ = <@@ WorldBankData(urlVal, sourcesVal) @@> + ProvidedMethod ("GetDataContext", [], worldBankDataServiceType, isStatic=true, invokeCode = gdcCode) ]) resTy + ) // ASSUMPTION: Follow www.worldbank.org and only show these sources by default. The others are very sparsely populated. let defaultSources = [ "World Development Indicators"; "Global Financial Development" ] diff --git a/src/WorldBank/WorldBankRuntime.fs b/src/WorldBank/WorldBankRuntime.fs index d5ee09ecb..41630b1fb 100644 --- a/src/WorldBank/WorldBankRuntime.fs +++ b/src/WorldBank/WorldBankRuntime.fs @@ -13,8 +13,8 @@ open FSharp.Data open FSharp.Data.JsonExtensions open FSharp.Data.Runtime.Caching -[] /// +[] module Implementation = let private retryCount = 5 @@ -197,12 +197,12 @@ module Implementation = x.GetDataAsync(countryOrRegionCode, indicatorCode) |> Async.RunSynchronously member internal __.GetCountriesInRegion region = getCountries ["region", region] |> Async.RunSynchronously -[] -[] /// Indicator data /// /// Support types for the WorldBank type provider. /// +[] +[] type Indicator internal (connection:ServiceConnection, countryOrRegionCode:string, indicatorCode:string) = let data = connection.GetData(countryOrRegionCode, indicatorCode) |> Seq.cache let dataDict = lazy (dict data) @@ -244,9 +244,9 @@ type Indicator internal (connection:ServiceConnection, countryOrRegionCode:strin interface seq with member x.GetEnumerator() = data.GetEnumerator() interface IEnumerable with member x.GetEnumerator() = (data.GetEnumerator() :> _) +/// Metadata for an Indicator [] [] -/// Metadata for an Indicator type IndicatorDescription internal (connection:ServiceConnection, topicCode:string, indicatorCode:string) = /// Get the code for the topic of the indicator member x.Code = topicCode @@ -288,9 +288,9 @@ type IndicatorsDescriptions internal (connection:ServiceConnection, topicCode) = type ICountry = abstract GetIndicators : unit -> Indicators +/// Metadata for a Country [] [] -/// Metadata for a Country type Country internal (connection:ServiceConnection, countryCode:string) = let indicators = new Indicators(connection, countryCode) /// Get the WorldBank code of the country @@ -326,9 +326,9 @@ type IRegion = abstract GetCountries<'T when 'T :> Country> : unit -> CountryCollection<'T> abstract GetIndicators : unit -> Indicators +/// Metadata for a Region [] [] -/// Metadata for a Region type Region internal (connection:ServiceConnection, regionCode:string) = let indicators = new Indicators(connection, regionCode) /// Get the WorldBank code for the region @@ -354,9 +354,9 @@ type RegionCollection<'T when 'T :> Region> internal (connection: ServiceConnect type ITopic = abstract GetIndicators : unit -> IndicatorsDescriptions +/// Metadata for a Topic [] [] -/// Metadata for a Topic type Topic internal (connection:ServiceConnection, topicCode:string) = let indicatorsDescriptions = new IndicatorsDescriptions(connection, topicCode) /// Get the WorldBank code of the topic diff --git a/src/Xml/XmlGenerator.fs b/src/Xml/XmlGenerator.fs index 5e48c2027..72f6da49a 100644 --- a/src/Xml/XmlGenerator.fs +++ b/src/Xml/XmlGenerator.fs @@ -120,7 +120,7 @@ module internal XmlTypeBuilder = let cultureStr = ctx.CultureStr let ctx = JsonGenerationContext.Create(cultureStr, ctx.ProvidedType, ctx.UniqueNiceName, ctx.JsonTypeCache) - let result = JsonTypeBuilder.generateJsonType ctx (*canPassAllConversionCallingTypes*)false (*optionalityHandledByParent*)true "" typ + let result = JsonTypeBuilder.generateJsonType ctx false true "" typ let optional = optional || forceOptional let optionalJustBecauseThereAreMultiple = primitives.Length > 1 && not optional @@ -198,18 +198,21 @@ module internal XmlTypeBuilder = let cultureStr = ctx.CultureStr for nameWithNS, param in parameters do - let ctor = ProvidedConstructor([param], invokeCode = fun (Singleton arg) -> + let ctorCode (Singleton arg: Expr list) = if nameWithNS = "" then arg else let arg = Expr.Coerce(arg, typeof) - <@@ XmlRuntime.CreateValue(nameWithNS, %%arg, cultureStr) @@>) + <@@ XmlRuntime.CreateValue(nameWithNS, %%arg, cultureStr) @@> + let ctor = + ProvidedConstructor([param], ctorCode) objectTy.AddMember ctor - objectTy.AddMember <| - ProvidedConstructor( - [ProvidedParameter("xElement",typeof)], - invokeCode = fun (Singleton arg) -> <@@ XmlElement.Create(%%arg:XElement) @@>) + let ctorCode (Singleton arg: Expr list) = + <@@ XmlElement.Create(%%arg:XElement) @@> + let ctor = + ProvidedConstructor([ProvidedParameter("xElement",typeof)], ctorCode) + objectTy.AddMember ctor { ConvertedType = objectTy Converter = id } @@ -278,10 +281,12 @@ module internal XmlTypeBuilder = attrVal |> Expr.Cast |> conv) let typ, convBack = ctx.ConvertValueBack <| PrimitiveInferedProperty.Create(tag.NiceName, primTyp, false, unit) - choiceTy.AddMember <| + let valueCode (Singleton arg: Expr list) = + arg |> convBack |> ProviderHelpers.some typeof + let valueCtor = let parameter = ProvidedParameter("value", typ) - ProvidedConstructor([parameter], invokeCode = fun (Singleton arg) -> - arg |> convBack |> ProviderHelpers.some typeof ) + ProvidedConstructor([parameter], invokeCode = valueCode) + choiceTy.AddMember valueCtor | _ -> failwithf "generateXmlType: A choice type of an attribute can only contain primitive types, got %A" typ @@ -396,8 +401,7 @@ module internal XmlTypeBuilder = let parameters = match primitiveParam with | Some primitiveParam -> attrParameters @ [primitiveParam] @ childElemParameters | None -> attrParameters @ childElemParameters - objectTy.AddMember <| - ProvidedConstructor(parameters, invokeCode = fun args -> + let ctorCode (args: Expr list) = let attributes = Expr.NewArray(typeof, args @@ -422,7 +426,8 @@ module internal XmlTypeBuilder = let cultureStr = ctx.CultureStr <@@ XmlRuntime.CreateRecord(nameWithNS, %%attributes, %%elements, cultureStr) @@> - ) + let ctor = ProvidedConstructor(parameters, invokeCode = ctorCode) + objectTy.AddMember ctor if primitiveElemParameters.Length = 0 then createConstrutor None @@ -430,11 +435,12 @@ module internal XmlTypeBuilder = for primitiveParam in primitiveElemParameters do createConstrutor (Some primitiveParam) - objectTy.AddMember <| - ProvidedConstructor( - [ProvidedParameter("xElement", typeof)], - invokeCode = fun (Singleton arg) -> - <@@ XmlElement.Create(%%arg:XElement) @@>) + let ctorCode (Singleton arg: Expr list) = + <@@ XmlElement.Create(%%arg:XElement) @@> + let ctorParams = [ProvidedParameter("xElement", typeof)] + let ctor = + ProvidedConstructor(ctorParams, ctorCode) + objectTy.AddMember ctor { ConvertedType = objectTy Converter = id } diff --git a/src/Xml/XmlProvider.fs b/src/Xml/XmlProvider.fs index 343b7ca62..42fcc63c7 100644 --- a/src/Xml/XmlProvider.fs +++ b/src/Xml/XmlProvider.fs @@ -50,62 +50,63 @@ type public XmlProvider(cfg:TypeProviderConfig) as this = if schema <> "" then - let schemaSet = using (IO.logTime "Parsing" sample) <| fun _ -> + let schemaSet = + use _holder = IO.logTime "Parsing" sample XmlSchema.parseSchema resolutionFolder value let inferedType = - using (IO.logTime "Inference" sample) <| fun _ -> - schemaSet - |> XsdParsing.getElements - |> List.ofSeq - |> XsdInference.inferElements + use _holder = IO.logTime "Inference" sample + schemaSet + |> XsdParsing.getElements + |> List.ofSeq + |> XsdInference.inferElements - using (IO.logTime "TypeGeneration" sample) <| fun _ -> + use _holder = IO.logTime "TypeGeneration" sample - let ctx = XmlGenerationContext.Create(cultureStr, tpType, globalInference || schema <> "") - let result = XmlTypeBuilder.generateXmlType ctx inferedType - - { GeneratedType = tpType - RepresentationType = result.ConvertedType - CreateFromTextReader = fun reader -> - result.Converter <@@ XmlElement.Create(%reader) @@> - CreateListFromTextReader = None - CreateFromTextReaderForSampleList = fun reader -> // hack: this will actually parse the schema - <@@ XmlSchema.parseSchemaFromTextReader resolutionFolder %reader @@> - CreateFromValue = None - } + let ctx = XmlGenerationContext.Create(cultureStr, tpType, globalInference || schema <> "") + let result = XmlTypeBuilder.generateXmlType ctx inferedType + + { GeneratedType = tpType + RepresentationType = result.ConvertedType + CreateFromTextReader = fun reader -> + result.Converter <@@ XmlElement.Create(%reader) @@> + CreateListFromTextReader = None + CreateFromTextReaderForSampleList = fun reader -> // hack: this will actually parse the schema + <@@ XmlSchema.parseSchemaFromTextReader resolutionFolder %reader @@> + CreateFromValue = None + } - else + else let samples = - using (IO.logTime "Parsing" sample) <| fun _ -> - if sampleIsList then - XmlElement.CreateList(new StringReader(value)) - |> Array.map (fun doc -> doc.XElement) - else - [| XDocument.Parse(value).Root |] + use _holder = IO.logTime "Parsing" sample + if sampleIsList then + XmlElement.CreateList(new StringReader(value)) + |> Array.map (fun doc -> doc.XElement) + else + [| XDocument.Parse(value).Root |] let inferedType = - using (IO.logTime "Inference" sample) <| fun _ -> - samples - |> XmlInference.inferType inferTypesFromValues (TextRuntime.GetCulture cultureStr) (*allowEmptyValues*)false globalInference - |> Array.fold (StructuralInference.subtypeInfered (*allowEmptyValues*)false) InferedType.Top + use _holder = IO.logTime "Inference" sample + samples + |> XmlInference.inferType inferTypesFromValues (TextRuntime.GetCulture cultureStr) false globalInference + |> Array.fold (StructuralInference.subtypeInfered false) InferedType.Top - using (IO.logTime "TypeGeneration" sample) <| fun _ -> + use _holder = IO.logTime "TypeGeneration" sample - let ctx = XmlGenerationContext.Create(cultureStr, tpType, globalInference || schema <> "") - let result = XmlTypeBuilder.generateXmlType ctx inferedType - - { GeneratedType = tpType - RepresentationType = result.ConvertedType - CreateFromTextReader = fun reader -> - result.Converter <@@ XmlElement.Create(%reader) @@> - CreateListFromTextReader = None - CreateFromTextReaderForSampleList = fun reader -> - result.Converter <@@ XmlElement.CreateList(%reader) @@> - CreateFromValue = None - } + let ctx = XmlGenerationContext.Create(cultureStr, tpType, globalInference || schema <> "") + let result = XmlTypeBuilder.generateXmlType ctx inferedType + + { GeneratedType = tpType + RepresentationType = result.ConvertedType + CreateFromTextReader = fun reader -> + result.Converter <@@ XmlElement.Create(%reader) @@> + CreateListFromTextReader = None + CreateFromTextReaderForSampleList = fun reader -> + result.Converter <@@ XmlElement.CreateList(%reader) @@> + CreateFromValue = None + } let source = if schema <> "" then diff --git a/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs b/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs index 2b220e899..198f16149 100644 --- a/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs +++ b/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs @@ -402,7 +402,7 @@ let getInferedTypeFromSamples samples = samples |> Array.map XElement.Parse |> XmlInference.inferType true culture false false - |> Seq.fold (subtypeInfered (*allowEmptyValues*)false) InferedType.Top + |> Seq.fold (subtypeInfered false) InferedType.Top let getInferedTypeFromSchema xsd = diff --git a/tests/FSharp.Data.Tests/JsonProvider.fs b/tests/FSharp.Data.Tests/JsonProvider.fs index b3dd00e8d..4ae96e320 100644 --- a/tests/FSharp.Data.Tests/JsonProvider.fs +++ b/tests/FSharp.Data.Tests/JsonProvider.fs @@ -492,27 +492,26 @@ let ``Can parse UTC dates``() = let dates = DateJSON.GetSample() dates.UtcTime |> should equal (new DateTimeOffset(1997, 7, 16, 19, 50, 30, TimeSpan.Zero)) -let withCulture (cultureName: string) test = +let withCulture (cultureName: string) = let originalCulture = CultureInfo.CurrentCulture; - try - CultureInfo.CurrentCulture <- CultureInfo cultureName - test() - finally - CultureInfo.CurrentCulture <- originalCulture + CultureInfo.CurrentCulture <- CultureInfo cultureName + { new IDisposable with + member _.Dispose() = + CultureInfo.CurrentCulture <- originalCulture } [] let ``Can parse ISO 8601 dates in the correct culture``() = - withCulture "zh-CN" <| fun () -> - let dates = DateJSON.GetSample() - dates.NoTimeZone |> should equal (new DateTime(1997, 7, 16, 19, 20, 30, 00, System.DateTimeKind.Local)) + use _holder = withCulture "zh-CN" + let dates = DateJSON.GetSample() + dates.NoTimeZone |> should equal (new DateTime(1997, 7, 16, 19, 20, 30, 00, System.DateTimeKind.Local)) [] let ``Can parse ISO 8601 dates in the specified culture``() = - withCulture "pt-PT" <| fun () -> - let dates = JsonProvider<"""{"birthdate": "01/02/2000"}""">.GetSample() - dates.Birthdate.Month |> should equal 1 - let dates = JsonProvider<"""{"birthdate": "01/02/2000"}""", Culture="pt-PT">.GetSample() - dates.Birthdate.Month |> should equal 2 + use _holder = withCulture "pt-PT" + let dates = JsonProvider<"""{"birthdate": "01/02/2000"}""">.GetSample() + dates.Birthdate.Month |> should equal 1 + let dates = JsonProvider<"""{"birthdate": "01/02/2000"}""", Culture="pt-PT">.GetSample() + dates.Birthdate.Month |> should equal 2 type TimeSpanJSON = JsonProvider<"Data/TimeSpans.json"> diff --git a/tests/FSharp.Data.Tests/JsonValue.fs b/tests/FSharp.Data.Tests/JsonValue.fs index 42eb643e0..2c240fe65 100644 --- a/tests/FSharp.Data.Tests/JsonValue.fs +++ b/tests/FSharp.Data.Tests/JsonValue.fs @@ -42,20 +42,19 @@ let ``Can parse document with iso date``() = j?anniversary.AsDateTime() |> should equal (new DateTime(2009, 05, 19, 14, 39, 22, 500, DateTimeKind.Local)) j?anniversary.AsDateTime().Kind |> should equal DateTimeKind.Local -let withCulture (cultureName: string) test = +let withCulture (cultureName: string) = let originalCulture = CultureInfo.CurrentCulture; - try - CultureInfo.CurrentCulture <- CultureInfo cultureName - test() - finally - CultureInfo.CurrentCulture <- originalCulture + CultureInfo.CurrentCulture <- CultureInfo cultureName + { new IDisposable with + member _.Dispose() = + CultureInfo.CurrentCulture <- originalCulture } [] let ``Can parse document with iso date in local culture``() = - withCulture "zh-CN" <| fun () -> - let j = JsonValue.Parse "{\"anniversary\": \"2009-05-19 14:39:22.500\"}" - j?anniversary.AsDateTime() |> should equal (new DateTime(2009, 05, 19, 14, 39, 22, 500, DateTimeKind.Local)) - j?anniversary.AsDateTime().Kind |> should equal DateTimeKind.Local + use _holder = withCulture "zh-CN" + let j = JsonValue.Parse "{\"anniversary\": \"2009-05-19 14:39:22.500\"}" + j?anniversary.AsDateTime() |> should equal (new DateTime(2009, 05, 19, 14, 39, 22, 500, DateTimeKind.Local)) + j?anniversary.AsDateTime().Kind |> should equal DateTimeKind.Local [] let ``Can parse document with partial iso date``() = @@ -135,9 +134,9 @@ let ``Can parse negative time span with days and fraction``() = [] let ``Can parse time span in different culture``() = - withCulture "fr" <| fun () -> - let j = JsonValue.Parse("{\"duration\": \"1:3:16:50,5\"}") - j?duration.AsTimeSpan CultureInfo.CurrentCulture |> should equal (TimeSpan(1, 3, 16, 50, 500)) + use _holder = withCulture "fr" + let j = JsonValue.Parse("{\"duration\": \"1:3:16:50,5\"}") + j?duration.AsTimeSpan CultureInfo.CurrentCulture |> should equal (TimeSpan(1, 3, 16, 50, 500)) [] let ``Can parse UTF-32 unicode characters`` () = @@ -146,35 +145,35 @@ let ``Can parse UTF-32 unicode characters`` () = [] let ``Can parse floats in different cultures``() = - withCulture "pt-PT" <| fun () -> - let j = JsonValue.Parse "{ \"age\": 25.5}" - j?age.AsFloat() |> should equal 25.5 - let j = JsonValue.Parse "{ \"age\": \"25.5\"}" - j?age.AsFloat() |> should equal 25.5 - let j = JsonValue.TryParse("{ \"age\": 25,5}") - j |> should equal None - let j = JsonValue.Parse("{ \"age\": \"25,5\"}") - j?age.AsFloat(CultureInfo.CurrentCulture) |> should equal 25.5 + use _holder = withCulture "pt-PT" + let j = JsonValue.Parse "{ \"age\": 25.5}" + j?age.AsFloat() |> should equal 25.5 + let j = JsonValue.Parse "{ \"age\": \"25.5\"}" + j?age.AsFloat() |> should equal 25.5 + let j = JsonValue.TryParse("{ \"age\": 25,5}") + j |> should equal None + let j = JsonValue.Parse("{ \"age\": \"25,5\"}") + j?age.AsFloat(CultureInfo.CurrentCulture) |> should equal 25.5 [] let ``Can parse decimals in different cultures``() = - withCulture "pt-PT" <| fun () -> - let j = JsonValue.Parse "{ \"age\": 25.5}" - j?age.AsDecimal() |> should equal 25.5m - let j = JsonValue.Parse "{ \"age\": \"25.5\"}" - j?age.AsDecimal() |> should equal 25.5m - let j = JsonValue.TryParse("{ \"age\": 25,5}") - j |> should equal None - let j = JsonValue.Parse("{ \"age\": \"25,5\"}") - j?age.AsDecimal(CultureInfo.CurrentCulture) |> should equal 25.5m + use _holder = withCulture "pt-PT" + let j = JsonValue.Parse "{ \"age\": 25.5}" + j?age.AsDecimal() |> should equal 25.5m + let j = JsonValue.Parse "{ \"age\": \"25.5\"}" + j?age.AsDecimal() |> should equal 25.5m + let j = JsonValue.TryParse("{ \"age\": 25,5}") + j |> should equal None + let j = JsonValue.Parse("{ \"age\": \"25,5\"}") + j?age.AsDecimal(CultureInfo.CurrentCulture) |> should equal 25.5m [] let ``Can parse dates in different cultures``() = - withCulture "pt-PT" <| fun () -> - let j = JsonValue.Parse "{ \"birthdate\": \"01/02/2000\"}" - j?birthdate.AsDateTime().Month |> should equal 1 - let j = JsonValue.Parse("{ \"birthdate\": \"01/02/2000\"}") - j?birthdate.AsDateTime(CultureInfo.CurrentCulture).Month |> should equal 2 + use _holder = withCulture "pt-PT" + let j = JsonValue.Parse "{ \"birthdate\": \"01/02/2000\"}" + j?birthdate.AsDateTime().Month |> should equal 1 + let j = JsonValue.Parse("{ \"birthdate\": \"01/02/2000\"}") + j?birthdate.AsDateTime(CultureInfo.CurrentCulture).Month |> should equal 2 [] let ``Can parse nested document`` () = @@ -225,13 +224,13 @@ let ``Can parse array of numbers``() = [] let ``Can parse array of numbers when culture is using comma as decimal separator``() = - withCulture "de-DE" <| fun () -> - CultureInfo.CurrentCulture.NumberFormat.CurrencyDecimalSeparator |> should equal "," - let j = JsonValue.Parse("[25,5,5,25]") - j.[0] |> should equal (JsonValue.Number 25m) - j.[1] |> should equal (JsonValue.Number 5m) - j.[2] |> should equal (JsonValue.Number 5m) - j.[3] |> should equal (JsonValue.Number 25m) + use _holder = withCulture "de-DE" + CultureInfo.CurrentCulture.NumberFormat.CurrencyDecimalSeparator |> should equal "," + let j = JsonValue.Parse("[25,5,5,25]") + j.[0] |> should equal (JsonValue.Number 25m) + j.[1] |> should equal (JsonValue.Number 5m) + j.[2] |> should equal (JsonValue.Number 5m) + j.[3] |> should equal (JsonValue.Number 25m) [] let ``Quotes in strings are properly escaped``() = @@ -456,8 +455,8 @@ let ``Can parse various JSON documents``() = let result = JsonValue.Parse json match expected with | Some exp when IsJsonEqual exp result -> () - | Some exp -> failure <| sprintf "Parse succeeded but didn't produce expected value\nJSON:\n%s\nExpected:\n%A\nActual:\n%A" json exp result - | None -> failure <| sprintf "Parse succeeded but expected to fail\nJSON:\n%s\nActual:\n%A" json result + | Some exp -> failure (sprintf "Parse succeeded but didn't produce expected value\nJSON:\n%s\nExpected:\n%A\nActual:\n%A" json exp result) + | None -> failure (sprintf "Parse succeeded but expected to fail\nJSON:\n%s\nActual:\n%A" json result) with | e -> match expected with