diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index f6aa1f3ac..7cbb4e1a8 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -27,4 +27,4 @@ ] } } -} +} \ No newline at end of file diff --git a/.editorconfig b/.editorconfig index c308ed0c0..f21606656 100644 --- a/.editorconfig +++ b/.editorconfig @@ -11,3 +11,8 @@ insert_final_newline = true [*.md] trim_trailing_whitespace = false + +[*.fs] +fsharp_max_array_or_list_number_of_items=5 +fsharp_max_if_then_else_short_width=60 +fsharp_max_dot_get_expression_width=80 diff --git a/build.fsx b/build.fsx index b82f7505e..297e39c73 100644 --- a/build.fsx +++ b/build.fsx @@ -22,7 +22,9 @@ open Fake.Core.TargetOperators open Fake.Tools.Git Environment.CurrentDirectory <- __SOURCE_DIRECTORY__ -let (!!) includes = (!! includes).SetBaseDirectory __SOURCE_DIRECTORY__ + +let (!!) includes = + (!!includes).SetBaseDirectory __SOURCE_DIRECTORY__ // -------------------------------------------------------------------------------------- // Information about the project to be used at NuGet and in AssemblyInfo files @@ -31,11 +33,15 @@ let (!!) includes = (!! includes).SetBaseDirectory __SOURCE_DIRECTORY__ let project = "FSharp.Data" let authors = "Tomas Petricek;Gustavo Guerra;Colin Bull;fsprojects contributors" let summary = "Library of F# type providers and data access tools" -let description = """ + +let description = + """ The FSharp.Data package contains type providers and utilities to access common data formats (CSV, HTML, JSON and XML in your F# applications and scripts. It also contains helpers for parsing CSV, HTML and JSON files and for sending HTTP requests.""" -let tags = "F# fsharp data typeprovider WorldBank CSV HTML CSS JSON XML HTTP linqpad-samples" + +let tags = + "F# fsharp data typeprovider WorldBank CSV HTML CSS JSON XML HTTP linqpad-samples" let gitOwner = "fsprojects" let gitHome = "https://github.com/" + gitOwner @@ -54,56 +60,54 @@ let release = ReleaseNotes.load "RELEASE_NOTES.md" Target.create "AssemblyInfo" (fun _ -> for file in !! "src/AssemblyInfo*.fs" do - let replace (oldValue:string) newValue (str:string) = str.Replace(oldValue, newValue) + let replace (oldValue: string) newValue (str: string) = str.Replace(oldValue, newValue) + let title = Path.GetFileNameWithoutExtension file |> replace "AssemblyInfo" "FSharp.Data" - let versionSuffix =".0" + + let versionSuffix = ".0" let version = release.AssemblyVersion + versionSuffix - AssemblyInfoFile.createFSharp file - [ AssemblyInfo.Title title - AssemblyInfo.Product project - AssemblyInfo.Description summary - AssemblyInfo.Version version - AssemblyInfo.FileVersion version] -) + + AssemblyInfoFile.createFSharp + file + [ AssemblyInfo.Title title + AssemblyInfo.Product project + AssemblyInfo.Description summary + AssemblyInfo.Version version + AssemblyInfo.FileVersion version ]) // -------------------------------------------------------------------------------------- // Clean build results Target.create "Clean" (fun _ -> seq { - yield! !!"**/bin" - yield! !!"**/obj" - } |> Shell.cleanDirs -) + yield! !! "**/bin" + yield! !! "**/obj" + } + |> Shell.cleanDirs) -Target.create "CleanDocs" (fun _ -> - Shell.cleanDirs ["docs/output"] -) +Target.create "CleanDocs" (fun _ -> Shell.cleanDirs [ "docs/output" ]) -let internetCacheFolder = Environment.GetFolderPath(Environment.SpecialFolder.InternetCache) +let internetCacheFolder = + Environment.GetFolderPath(Environment.SpecialFolder.InternetCache) Target.create "CleanInternetCaches" (fun _ -> - Shell.cleanDirs [ internetCacheFolder @@ "DesignTimeURIs" - internetCacheFolder @@ "WorldBankSchema" - internetCacheFolder @@ "WorldBankRuntime"] -) + Shell.cleanDirs + [ internetCacheFolder @@ "DesignTimeURIs" + internetCacheFolder @@ "WorldBankSchema" + internetCacheFolder @@ "WorldBankRuntime" ]) // -------------------------------------------------------------------------------------- // Build library & test projects Target.create "Build" (fun _ -> "FSharp.Data.sln" - |> DotNet.build (fun o -> - { o with Configuration = DotNet.BuildConfiguration.Release }) -) + |> DotNet.build (fun o -> { o with Configuration = DotNet.BuildConfiguration.Release })) Target.create "RunTests" (fun _ -> "FSharp.Data.sln" - |> DotNet.test (fun o -> - { o with Configuration = DotNet.BuildConfiguration.Release }) -) + |> DotNet.test (fun o -> { o with Configuration = DotNet.BuildConfiguration.Release })) // -------------------------------------------------------------------------------------- // Build a NuGet package @@ -112,39 +116,42 @@ Target.create "NuGet" (fun _ -> // Format the release notes let releaseNotes = release.Notes |> String.concat "\n" - let properties = [ - ("Version", release.NugetVersion) - ("Authors", authors) - ("PackageProjectUrl", packageProjectUrl) - ("PackageTags", tags) - ("RepositoryType", repositoryType) - ("RepositoryUrl", repositoryUrl) - ("PackageLicenseExpression", license) - ("PackageReleaseNotes", releaseNotes) - ("Summary", summary) - ("PackageDescription", description) - ("EnableSourceLink", "true") - ("PublishRepositoryUrl", "true") - ("EmbedUntrackedSources", "true") - ("IncludeSymbols", "true") - ("SymbolPackageFormat", "snupkg") - ] - - DotNet.pack (fun p -> - { p with - Configuration = DotNet.BuildConfiguration.Release - OutputPath = Some "bin" - MSBuildParams = { p.MSBuildParams with Properties = properties} - } - ) "src/FSharp.Data/FSharp.Data.fsproj" -) + let properties = + [ ("Version", release.NugetVersion) + ("Authors", authors) + ("PackageProjectUrl", packageProjectUrl) + ("PackageTags", tags) + ("RepositoryType", repositoryType) + ("RepositoryUrl", repositoryUrl) + ("PackageLicenseExpression", license) + ("PackageReleaseNotes", releaseNotes) + ("Summary", summary) + ("PackageDescription", description) + ("EnableSourceLink", "true") + ("PublishRepositoryUrl", "true") + ("EmbedUntrackedSources", "true") + ("IncludeSymbols", "true") + ("SymbolPackageFormat", "snupkg") ] + + DotNet.pack + (fun p -> + { p with + Configuration = DotNet.BuildConfiguration.Release + OutputPath = Some "bin" + MSBuildParams = { p.MSBuildParams with Properties = properties } }) + "src/FSharp.Data/FSharp.Data.fsproj") // -------------------------------------------------------------------------------------- // Generate the documentation Target.create "GenerateDocs" (fun _ -> Shell.cleanDir ".fsdocs" - DotNet.exec id "fsdocs" ("build --properties Configuration=Release --strict --eval --clean --parameters fsdocs-package-version " + release.NugetVersion) |> ignore -) + + DotNet.exec + id + "fsdocs" + ("build --properties Configuration=Release --strict --eval --clean --parameters fsdocs-package-version " + + release.NugetVersion) + |> ignore) // -------------------------------------------------------------------------------------- // Help @@ -162,13 +169,51 @@ Target.create "Help" (fun _ -> printfn "" printfn " Other targets:" printfn " * CleanInternetCaches" - printfn "" -) + printfn "") + +let sourceFiles = + !! "src/**/*.fs" ++ "src/**/*.fsi" ++ "build.fsx" + -- "src/**/obj/**/*.fs" + -- "src/AssemblyInfo*.fs" + +Target.create "Format" (fun _ -> + let result = + sourceFiles + |> Seq.map (sprintf "\"%s\"") + |> String.concat " " + |> DotNet.exec id "fantomas" + + if not result.OK then + printfn "Errors while formatting all files: %A" result.Messages) + +Target.create "CheckFormat" (fun _ -> + let result = + sourceFiles + |> Seq.map (sprintf "\"%s\"") + |> String.concat " " + |> sprintf "%s --check" + |> DotNet.exec id "fantomas" + + if result.ExitCode = 0 then + Trace.log "No files need formatting" + elif result.ExitCode = 99 then + failwith "Some files need formatting, run `dotnet fake build -t Format` to format them" + else + Trace.logf "Errors while formatting: %A" result.Errors + failwith "Unknown errors while formatting") Target.create "All" ignore -"Clean" ==> "AssemblyInfo" ==> "Build" -"Build" ==> "CleanDocs" ==> "GenerateDocs" ==> "All" +"Clean" +==> "AssemblyInfo" +==> "CheckFormat" +==> "Build" + +"Build" +==> "CleanDocs" +==> "GenerateDocs" +==> "All" + "Build" ==> "NuGet" ==> "All" "Build" ==> "All" "Build" ==> "RunTests" ==> "All" diff --git a/src/CommonProviderImplementation/AssemblyResolver.fs b/src/CommonProviderImplementation/AssemblyResolver.fs index cb4101d35..74b15a848 100644 --- a/src/CommonProviderImplementation/AssemblyResolver.fs +++ b/src/CommonProviderImplementation/AssemblyResolver.fs @@ -13,13 +13,15 @@ open FSharp.Core.CompilerServices open ProviderImplementation open ProviderImplementation.ProvidedTypes -let mutable private initialized = false +let mutable private initialized = false -let init () = +let init () = if not initialized then initialized <- true + if WebRequest.DefaultWebProxy <> null then WebRequest.DefaultWebProxy.Credentials <- CredentialCache.DefaultNetworkCredentials - ProvidedTypes.ProvidedTypeDefinition.Logger := Some FSharp.Data.Runtime.IO.log + ProvidedTypes.ProvidedTypeDefinition.Logger + := Some FSharp.Data.Runtime.IO.log diff --git a/src/CommonProviderImplementation/ConversionsGenerator.fs b/src/CommonProviderImplementation/ConversionsGenerator.fs index 3f082e4ee..7cfb8d3a4 100644 --- a/src/CommonProviderImplementation/ConversionsGenerator.fs +++ b/src/CommonProviderImplementation/ConversionsGenerator.fs @@ -13,67 +13,98 @@ open ProviderImplementation open ProviderImplementation.ProvidedTypes open ProviderImplementation.QuotationBuilder -let getConversionQuotation missingValuesStr cultureStr typ (value:Expr) = - if typ = typeof then <@@ TextRuntime.ConvertString(%value) @@> - elif typ = typeof || typ = typeof || typ = typeof then <@@ TextRuntime.ConvertInteger(cultureStr, %value) @@> - elif typ = typeof then <@@ TextRuntime.ConvertInteger64(cultureStr, %value) @@> - elif typ = typeof then <@@ TextRuntime.ConvertDecimal(cultureStr, %value) @@> - elif typ = typeof then <@@ TextRuntime.ConvertFloat(cultureStr, missingValuesStr, %value) @@> - elif typ = typeof || typ = typeof then <@@ TextRuntime.ConvertBoolean(%value) @@> - elif typ = typeof then <@@ TextRuntime.ConvertDateTime(cultureStr, %value) @@> - elif typ = typeof then <@@ TextRuntime.ConvertDateTimeOffset(cultureStr, %value) @@> - elif typ = typeof then <@@ TextRuntime.ConvertTimeSpan(cultureStr, %value) @@> - elif typ = typeof then <@@ TextRuntime.ConvertGuid(%value) @@> - else failwith "getConversionQuotation: Unsupported primitive type" +let getConversionQuotation missingValuesStr cultureStr typ (value: Expr) = + if typ = typeof then + <@@ TextRuntime.ConvertString(%value) @@> + elif typ = typeof + || typ = typeof + || typ = typeof then + <@@ TextRuntime.ConvertInteger(cultureStr, %value) @@> + elif typ = typeof then + <@@ TextRuntime.ConvertInteger64(cultureStr, %value) @@> + elif typ = typeof then + <@@ TextRuntime.ConvertDecimal(cultureStr, %value) @@> + elif typ = typeof then + <@@ TextRuntime.ConvertFloat(cultureStr, missingValuesStr, %value) @@> + elif typ = typeof || typ = typeof then + <@@ TextRuntime.ConvertBoolean(%value) @@> + elif typ = typeof then + <@@ TextRuntime.ConvertDateTime(cultureStr, %value) @@> + elif typ = typeof then + <@@ TextRuntime.ConvertDateTimeOffset(cultureStr, %value) @@> + elif typ = typeof then + <@@ TextRuntime.ConvertTimeSpan(cultureStr, %value) @@> + elif typ = typeof then + <@@ TextRuntime.ConvertGuid(%value) @@> + else + failwith "getConversionQuotation: Unsupported primitive type" let getBackConversionQuotation missingValuesStr cultureStr typ value : Expr = - if typ = typeof || typ = typeof || typ = typeof then <@ TextRuntime.ConvertIntegerBack(cultureStr, %%value) @> - elif typ = typeof then <@ TextRuntime.ConvertInteger64Back(cultureStr, %%value) @> - elif typ = typeof then <@ TextRuntime.ConvertDecimalBack(cultureStr, %%value) @> - elif typ = typeof then <@ TextRuntime.ConvertFloatBack(cultureStr, missingValuesStr, %%value) @> - elif typ = typeof then <@ TextRuntime.ConvertStringBack(%%value) @> - elif typ = typeof || typ = typeof then <@ TextRuntime.ConvertBooleanBack(%%value, false) @> - elif typ = typeof then <@ TextRuntime.ConvertGuidBack(%%value) @> - elif typ = typeof then <@ TextRuntime.ConvertDateTimeBack(cultureStr, %%value) @> - elif typ = typeof then <@ TextRuntime.ConvertDateTimeOffsetBack(cultureStr, %%value) @> - elif typ = typeof then <@ TextRuntime.ConvertTimeSpanBack(cultureStr, %%value) @> - else failwith "getBackConversionQuotation: Unsupported primitive type" + if typ = typeof + || typ = typeof + || typ = typeof then + <@ TextRuntime.ConvertIntegerBack(cultureStr, %%value) @> + elif typ = typeof then + <@ TextRuntime.ConvertInteger64Back(cultureStr, %%value) @> + elif typ = typeof then + <@ TextRuntime.ConvertDecimalBack(cultureStr, %%value) @> + elif typ = typeof then + <@ TextRuntime.ConvertFloatBack(cultureStr, missingValuesStr, %%value) @> + elif typ = typeof then + <@ TextRuntime.ConvertStringBack(%%value) @> + elif typ = typeof || typ = typeof then + <@ TextRuntime.ConvertBooleanBack(%%value, false) @> + elif typ = typeof then + <@ TextRuntime.ConvertGuidBack(%%value) @> + elif typ = typeof then + <@ TextRuntime.ConvertDateTimeBack(cultureStr, %%value) @> + elif typ = typeof then + <@ TextRuntime.ConvertDateTimeOffsetBack(cultureStr, %%value) @> + elif typ = typeof then + <@ TextRuntime.ConvertTimeSpanBack(cultureStr, %%value) @> + else + failwith "getBackConversionQuotation: Unsupported primitive type" -/// Creates a function that takes Expr and converts it to +/// Creates a function that takes Expr and converts it to /// an expression of other type - the type is specified by `field` -let convertStringValue missingValuesStr cultureStr (field:PrimitiveInferedProperty) = +let convertStringValue missingValuesStr cultureStr (field: PrimitiveInferedProperty) = - let returnType = - match field.TypeWrapper with - | TypeWrapper.None -> field.TypeWithMeasure - | TypeWrapper.Option -> typedefof>.MakeGenericType field.TypeWithMeasure - | TypeWrapper.Nullable -> typedefof>.MakeGenericType field.TypeWithMeasure + let returnType = + match field.TypeWrapper with + | TypeWrapper.None -> field.TypeWithMeasure + | TypeWrapper.Option -> typedefof>.MakeGenericType field.TypeWithMeasure + | TypeWrapper.Nullable -> typedefof>.MakeGenericType field.TypeWithMeasure - let returnTypeWithoutMeasure = - match field.TypeWrapper with - | TypeWrapper.None -> field.RuntimeType - | TypeWrapper.Option -> typedefof>.MakeGenericType field.RuntimeType - | TypeWrapper.Nullable -> typedefof>.MakeGenericType field.RuntimeType + let returnTypeWithoutMeasure = + match field.TypeWrapper with + | TypeWrapper.None -> field.RuntimeType + | TypeWrapper.Option -> typedefof>.MakeGenericType field.RuntimeType + | TypeWrapper.Nullable -> typedefof>.MakeGenericType field.RuntimeType - let convert (value:Expr) = - let convert value = - getConversionQuotation missingValuesStr cultureStr field.InferedType value - match field.TypeWrapper with - | TypeWrapper.None -> - //prevent value being calculated twice - let var = Var("value", typeof) - let varExpr = Expr.Cast (Expr.Var var) - let body = typeof?GetNonOptionalValue field.RuntimeType (field.Name, convert varExpr, varExpr) - Expr.Let(var, value, body) - | TypeWrapper.Option -> convert value - | TypeWrapper.Nullable -> typeof?OptionToNullable field.RuntimeType (convert value) + let convert (value: Expr) = + let convert value = + getConversionQuotation missingValuesStr cultureStr field.InferedType value - let convertBack value = - let value = - match field.TypeWrapper with - | TypeWrapper.None -> ProviderHelpers.some field.RuntimeType value - | TypeWrapper.Option -> value - | TypeWrapper.Nullable -> typeof?NullableToOption field.RuntimeType value - getBackConversionQuotation missingValuesStr cultureStr field.InferedType value :> Expr + match field.TypeWrapper with + | TypeWrapper.None -> + //prevent value being calculated twice + let var = Var("value", typeof) + let varExpr = Expr.Cast(Expr.Var var) - returnType, returnTypeWithoutMeasure, convert, convertBack + let body = + typeof?GetNonOptionalValue field.RuntimeType (field.Name, convert varExpr, varExpr) + + Expr.Let(var, value, body) + | TypeWrapper.Option -> convert value + | TypeWrapper.Nullable -> typeof?OptionToNullable field.RuntimeType (convert value) + + let convertBack value = + let value = + match field.TypeWrapper with + | TypeWrapper.None -> ProviderHelpers.some field.RuntimeType value + | TypeWrapper.Option -> value + | TypeWrapper.Nullable -> typeof?NullableToOption field.RuntimeType value + + getBackConversionQuotation missingValuesStr cultureStr field.InferedType value :> Expr + + returnType, returnTypeWithoutMeasure, convert, convertBack diff --git a/src/CommonProviderImplementation/Helpers.fs b/src/CommonProviderImplementation/Helpers.fs index 4f34e8053..74cdc49d6 100644 --- a/src/CommonProviderImplementation/Helpers.fs +++ b/src/CommonProviderImplementation/Helpers.fs @@ -25,14 +25,15 @@ open ProviderImplementation.ProvidedTypes module internal PrimitiveInferedPropertyExtensions = type PrimitiveInferedProperty with - - member x.TypeWithMeasure = - match x.UnitOfMeasure with - | None -> x.RuntimeType - | Some unit -> - if supportsUnitsOfMeasure x.RuntimeType - then ProvidedMeasureBuilder.AnnotateType(x.RuntimeType, [unit]) - else failwithf "Units of measure not supported by type %s" x.RuntimeType.Name + + member x.TypeWithMeasure = + match x.UnitOfMeasure with + | None -> x.RuntimeType + | Some unit -> + if supportsUnitsOfMeasure x.RuntimeType then + ProvidedMeasureBuilder.AnnotateType(x.RuntimeType, [ unit ]) + else + failwithf "Units of measure not supported by type %s" x.RuntimeType.Name // ---------------------------------------------------------------------------------------------- @@ -45,85 +46,87 @@ module internal ActivePatterns = /// /// p.InvokeCode <- fun (Singleton self) -> <@ 1 + 2 @> /// - let (|Singleton|) = function [l] -> l | _ -> failwith "Parameter mismatch" - + let (|Singleton|) = + function + | [ l ] -> l + | _ -> failwith "Parameter mismatch" + /// Takes a map and succeeds if it is empty - let (|EmptyMap|_|) result (map:Map<_,_>) = if map.IsEmpty then Some result else None - + let (|EmptyMap|_|) result (map: Map<_, _>) = + if map.IsEmpty then Some result else None + /// Takes a map and succeeds if it contains exactly one value - let (|SingletonMap|_|) (map:Map<_,_>) = - if map.Count <> 1 then None else - let (KeyValue(k, v)) = Seq.head map + let (|SingletonMap|_|) (map: Map<_, _>) = + if map.Count <> 1 then + None + else + let (KeyValue (k, v)) = Seq.head map Some(k, v) // ---------------------------------------------------------------------------------------------- -module internal ReflectionHelpers = +module internal ReflectionHelpers = open FSharp.Quotations open UncheckedQuotations - let makeDelegate (exprfunc:Expr -> Expr) argType = + let makeDelegate (exprfunc: Expr -> Expr) argType = let var = Var("t", argType) let convBody = exprfunc (Expr.Var var) - Expr.NewDelegateUnchecked(typedefof>.MakeGenericType(argType, convBody.Type), [var], convBody) + Expr.NewDelegateUnchecked(typedefof>.MakeGenericType (argType, convBody.Type), [ var ], convBody) // ---------------------------------------------------------------------------------------------- type DisposableTypeProviderForNamespaces(config, ?assemblyReplacementMap) as x = - inherit TypeProviderForNamespaces(config, ?assemblyReplacementMap=assemblyReplacementMap) - + inherit TypeProviderForNamespaces(config, ?assemblyReplacementMap = assemblyReplacementMap) + let disposeActions = ResizeArray() - + static let mutable idCount = 0 - + let id = idCount let filesToWatch = Dictionary() do idCount <- idCount + 1 - - let dispose typeNameOpt = - lock disposeActions (fun () -> - for i = disposeActions.Count-1 downto 0 do + + let dispose typeNameOpt = + 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) - ) + if discard then disposeActions.RemoveAt(i)) do log (sprintf "Creating TypeProviderForNamespaces %O [%d]" x id) - x.Disposing.Add (fun _ -> + + 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) - member __.AddDisposeAction action = + member __.AddDisposeAction action = lock disposeActions (fun () -> disposeActions.Add action) - member __.InvalidateOneType typeName = - 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 + member __.InvalidateOneType typeName = + (use _holder = logTime "InvalidateOneType" (sprintf "%s in %O [%d]" typeName x id) + dispose (Some typeName) + log (sprintf "Calling invalidate for %O [%d]" x id)) + base.Invalidate() #if LOGGING_ENABLED - override x.Finalize() = - log (sprintf "Finalize %O [%d]" x id) + override x.Finalize() = log (sprintf "Finalize %O [%d]" x id) #endif @@ -134,54 +137,67 @@ module internal ProviderHelpers = open System.IO open FSharp.Data.Runtime.Caching - let unitsOfMeasureProvider = + let unitsOfMeasureProvider = { new StructuralInference.IUnitsOfMeasureProvider with member x.SI(str) = ProvidedMeasureBuilder.SI str - member x.Product(measure1, measure2) = ProvidedMeasureBuilder.Product(measure1, measure2) - member x.Inverse(denominator): Type = ProvidedMeasureBuilder.Inverse(denominator) } - let asyncMap (resultType:Type) (valueAsync:Expr>) (body:Expr<'T>->Expr) = + member x.Product(measure1, measure2) = + ProvidedMeasureBuilder.Product(measure1, measure2) + + member x.Inverse(denominator) : Type = + ProvidedMeasureBuilder.Inverse(denominator) } + + let asyncMap (resultType: Type) (valueAsync: Expr>) (body: Expr<'T> -> Expr) = let (?) = QuotationBuilder.(?) - let convFunc = ReflectionHelpers.makeDelegate (Expr.Cast >> body) typeof<'T> + let convFunc = ReflectionHelpers.makeDelegate (Expr.Cast >> body) typeof<'T> let f = Var("f", convFunc.Type) - let body = typeof?AsyncMap (typeof<'T>, resultType) (valueAsync, Expr.Var f) - Expr.Let(f, convFunc, body) - let some (typ:Type) arg = + let body = + typeof?AsyncMap (typeof<'T>, resultType) (valueAsync, Expr.Var f) + + Expr.Let(f, convFunc, body) + + let some (typ: Type) arg = let unionType = typedefof>.MakeGenericType typ let meth = unionType.GetMethod("Some") - Expr.Call(meth, [arg]) + Expr.Call(meth, [ arg ]) let private cacheDuration = TimeSpan.FromMinutes 30.0 - let private invalidChars = [ for c in "\"|<>{}[]," -> c ] @ [ for i in 0..31 -> char i ] |> set + + let private invalidChars = + [ for c in "\"|<>{}[]," -> c ] + @ [ for i in 0..31 -> char i ] + |> set + let private webUrisCache = createInternetFileCache "DesignTimeURIs" cacheDuration - + // part of the information needed by generateType type TypeProviderSpec<'RuntimeValue> = - { //the generated type - GeneratedType : ProvidedTypeDefinition - //the representation type (what's returned from the constructors, may or may not be the same as Type) - RepresentationType : Type - // the constructor from a text reader to the representation - CreateFromTextReader : Expr -> Expr - CreateListFromTextReader : (Expr -> Expr) option - // the constructor from a text reader to an array of the representation - CreateFromTextReaderForSampleList : Expr -> Expr - /// Runtime representation of underlying data (e.g. JsonValue) * Mapper function - CreateFromValue: (Type * (Expr<'RuntimeValue> -> Expr)) option - } + { + GeneratedType: ProvidedTypeDefinition //the generated type + //the representation type (what's returned from the constructors, may or may not be the same as Type) + RepresentationType: Type + // the constructor from a text reader to the representation + CreateFromTextReader: Expr -> Expr + CreateListFromTextReader: (Expr -> Expr) option + // the constructor from a text reader to an array of the representation + CreateFromTextReaderForSampleList: Expr -> Expr + /// Runtime representation of underlying data (e.g. JsonValue) * Mapper function + CreateFromValue: (Type * (Expr<'RuntimeValue> -> Expr)) option + } type private ParseTextResult<'RuntimeValue> = - { Spec : TypeProviderSpec<'RuntimeValue> - IsUri : bool - IsResource : bool } + { Spec: TypeProviderSpec<'RuntimeValue> + IsUri: bool + IsResource: bool } - let readResource(tp: DisposableTypeProviderForNamespaces, resourceName:string) = + let readResource (tp: DisposableTypeProviderForNamespaces, resourceName: string) = match resourceName.Split(',') with - | [| asmName; name |] -> + | [| asmName; name |] -> let bindingCtxt = tp.TargetContext + match bindingCtxt.TryBindSimpleAssemblyNameToTarget(asmName.Trim()) with - | Choice1Of2 asm -> + | Choice1Of2 asm -> use sr = new StreamReader(asm.GetManifestResourceStream(name.Trim())) Some(sr.ReadToEnd()) | _ -> None @@ -191,10 +207,10 @@ module internal ProviderHelpers = /// Reads a sample parameter for a type provider, detecting if it is a uri and fetching it if needed /// /// - /// Samples from the web are cached for 30 minutes. + /// Samples from the web are cached for 30 minutes. /// Samples from the filesystem are read using shared read, so it works when the file is locked by Excel or similar tools, /// - /// + /// /// the text which can be a sample or an uri for a sample /// receives the file/url extension (or "" if not applicable) and the text value /// the description of what is being parsed (for the error message) @@ -206,136 +222,168 @@ module internal ProviderHelpers = /// /// /// - let private parseTextAtDesignTime valueToBeParsedOrItsUri parseFunc formatName (tp:DisposableTypeProviderForNamespaces) - (cfg:TypeProviderConfig) encodingStr resolutionFolder resource fullTypeName maxNumberOfRows = - + let private parseTextAtDesignTime + valueToBeParsedOrItsUri + parseFunc + formatName + (tp: DisposableTypeProviderForNamespaces) + (cfg: TypeProviderConfig) + encodingStr + resolutionFolder + resource + fullTypeName + maxNumberOfRows + = + use _holder = logTime "LoadingTextToBeParsed" valueToBeParsedOrItsUri - - let tryGetResource() = - if resource = "" then None else readResource(tp, resource) + + let tryGetResource () = + if resource = "" then None else readResource (tp, resource) let tryGetUri str = match Uri.TryCreate(str, UriKind.RelativeOrAbsolute) with | false, _ -> None | true, uri -> - if str.Trim() = "" || not uri.IsAbsoluteUri && Seq.exists invalidChars.Contains str - then None else Some uri - - match tryGetResource() with - | Some res -> { Spec = parseFunc "" res - IsUri = false - IsResource = true } - | _ -> - - match tryGetUri valueToBeParsedOrItsUri with - | None -> - - try - { Spec = parseFunc "" valueToBeParsedOrItsUri - IsUri = false - IsResource = false } - with e -> - failwithf "The provided sample is neither a file, nor a well-formed %s: %s" formatName e.Message - - | Some uri -> - - let resolver = - { ResolutionType = DesignTime - DefaultResolutionFolder = cfg.ResolutionFolder - ResolutionFolder = resolutionFolder } - - let readText() = - let reader, toWatch = asyncRead resolver formatName encodingStr uri - // Non need to register file watchers in fsc.exe and fsi.exe - if cfg.IsInvalidationSupported then - toWatch |> Option.iter (fun path -> tp.SetFileToWatch(fullTypeName, path)) - use reader = reader |> Async.RunSynchronously - match maxNumberOfRows with - | None -> reader.ReadToEnd() - | Some max -> - let sb = StringBuilder() - let mutable max = max - while max > 0 do - let line = reader.ReadLine() - if line = null then - max <- 0 + if str.Trim() = "" + || not uri.IsAbsoluteUri + && Seq.exists invalidChars.Contains str then + None + else + Some uri + + match tryGetResource () with + | Some res -> + { Spec = parseFunc "" res + IsUri = false + IsResource = true } + | _ -> + + match tryGetUri valueToBeParsedOrItsUri with + | None -> + + try + { Spec = parseFunc "" valueToBeParsedOrItsUri + IsUri = false + IsResource = false } + with e -> + failwithf "The provided sample is neither a file, nor a well-formed %s: %s" formatName e.Message + + | Some uri -> + + let resolver = + { ResolutionType = DesignTime + DefaultResolutionFolder = cfg.ResolutionFolder + ResolutionFolder = resolutionFolder } + + let readText () = + let reader, toWatch = asyncRead resolver formatName encodingStr uri + // Non need to register file watchers in fsc.exe and fsi.exe + if cfg.IsInvalidationSupported then + toWatch + |> Option.iter (fun path -> tp.SetFileToWatch(fullTypeName, path)) + + use reader = reader |> Async.RunSynchronously + + match maxNumberOfRows with + | None -> reader.ReadToEnd() + | Some max -> + let sb = StringBuilder() + let mutable max = max + + while max > 0 do + let line = reader.ReadLine() + + if line = null then + max <- 0 + else + line |> sb.AppendLine |> ignore + max <- max - 1 + + sb.ToString() + + try + + let sample = + if isWeb uri then + let text = + match webUrisCache.TryRetrieve(uri.OriginalString) with + | Some text -> text + | None -> + let text = readText () + webUrisCache.Set(uri.OriginalString, text) + text + + text else - line |> sb.AppendLine |> ignore - max <- max - 1 - sb.ToString() - - try - - let sample = - if isWeb uri then - let text = - match webUrisCache.TryRetrieve(uri.OriginalString) with - | Some text -> text - | None -> - let text = readText() - webUrisCache.Set(uri.OriginalString, text) - text - text - else - readText() - - { Spec = parseFunc (Path.GetExtension uri.OriginalString) sample - IsUri = true - IsResource = false } - - with e -> - - if not uri.IsAbsoluteUri then - // even if it's a valid uri, it could be sample text - try - { Spec = parseFunc "" valueToBeParsedOrItsUri - IsUri = false - IsResource = false } - with _ -> - // if not, return the first exception + readText () + + { Spec = parseFunc (Path.GetExtension uri.OriginalString) sample + IsUri = true + IsResource = false } + + with e -> + + if not uri.IsAbsoluteUri then + // even if it's a valid uri, it could be sample text + try + { Spec = parseFunc "" valueToBeParsedOrItsUri + IsUri = false + IsResource = false } + with _ -> + // if not, return the first exception + failwithf "Cannot read sample %s from '%s': %s" formatName valueToBeParsedOrItsUri e.Message + else failwithf "Cannot read sample %s from '%s': %s" formatName valueToBeParsedOrItsUri e.Message - else - failwithf "Cannot read sample %s from '%s': %s" formatName valueToBeParsedOrItsUri e.Message - + let private providedTypesCache = createInMemoryCache (TimeSpan.FromSeconds 30.0) let private activeDisposeActions = HashSet<_>() // Cache generated types for a short time, since VS invokes the TP multiple tiems // 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 = - - use _holder = logTime "GeneratingProvidedType" (sprintf "%s [%d]" fullTypeName tp.Id) + let internal getOrCreateProvidedType + (cfg: TypeProviderConfig) + (tp: DisposableTypeProviderForNamespaces) + (fullTypeName: string) + f + = + + use _holder = + logTime "GeneratingProvidedType" (sprintf "%s [%d]" fullTypeName tp.Id) + + let fullKey = + (fullTypeName, cfg.RuntimeAssembly, cfg.ResolutionFolder, cfg.SystemRuntimeAssemblyVersion) - let fullKey = (fullTypeName, cfg.RuntimeAssembly, cfg.ResolutionFolder, cfg.SystemRuntimeAssemblyVersion) - let setupDisposeAction providedType fileToWatch = - + if activeDisposeActions.Add(fullTypeName, tp.Id) then - + log "Setting up dispose action" - - let watcher = + + let watcher = match fileToWatch with | Some file -> let name = sprintf "%s [%d]" fullTypeName tp.Id // Hold a weak reference to the type provider instance. If the TP instance is leaked // and not held strongly by anyone else, then don't hold it strongly here. let tpref = WeakReference<_>(tp) - let invalidateAction() = + + let invalidateAction () = match tpref.TryGetTarget() with | true, tp -> tp.InvalidateOneType(fullTypeName) | _ -> () - Some (watchForChanges file (name, invalidateAction)) + + Some(watchForChanges file (name, invalidateAction)) | 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()) - + watcher + |> Option.iter (fun watcher -> watcher.Dispose()) + match typeNameBeingDisposedOpt with - | Some typeNameBeingDisposed when fullTypeName = typeNameBeingDisposed -> + | Some typeNameBeingDisposed when fullTypeName = typeNameBeingDisposed -> providedTypesCache.Remove(fullTypeName) log (sprintf "Dropping dispose action for %s [%d]" fullTypeName tp.Id) // for the case where a file used by two TPs, when the file changes @@ -343,7 +391,7 @@ module internal ProviderHelpers = // when the dispose action is called with A, A is removed from the cache // so we need to remove the dispose action so it will won't be added when disposed is called with B true - | _ -> + | _ -> log (sprintf "Caching %s [%d] for 5 minutes" fullTypeName tp.Id) providedTypesCache.Set(fullTypeName, (providedType, fullKey, fileToWatch)) // for the case where a file used by two TPs, when the file changes @@ -351,24 +399,24 @@ module internal ProviderHelpers = // 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) - + match providedTypesCache.TryRetrieve(fullTypeName, true) with - | Some (providedType, fullKey2, watchedFile) when fullKey = fullKey2 -> + | Some (providedType, fullKey2, watchedFile) when fullKey = fullKey2 -> log "Retrieved from cache" setupDisposeAction providedType watchedFile providedType - | _ -> - let providedType = f() + | _ -> + let providedType = f () log "Caching for 5 minutes" let fileToWatch = tp.GetFileToWath(fullTypeName) providedTypesCache.Set(fullTypeName, (providedType, fullKey, fileToWatch)) setupDisposeAction providedType fileToWatch - providedType + providedType - type Source = - | Sample of string - | SampleList of string - | Schema of string + type Source = + | Sample of string + | SampleList of string + | Schema of string /// Creates all the constructors for a type provider: (Async)Parse, (Async)Load, (Async)GetSample(s), and default constructor /// the sample/sample list/schema from which the types will be generated @@ -381,169 +429,319 @@ module internal ProviderHelpers = /// (the value specifies assembly and resource name e.g. "MyCompany.MyAssembly, some_resource.json") /// the full name of the type provider, this will be used as the caching key /// the max number of rows to read from the sample or schema - let generateType formatName source getSpec - (tp:DisposableTypeProviderForNamespaces) (cfg:TypeProviderConfig) - encodingStr resolutionFolder resource fullTypeName maxNumberOfRows = - + let generateType + formatName + source + getSpec + (tp: DisposableTypeProviderForNamespaces) + (cfg: TypeProviderConfig) + encodingStr + resolutionFolder + resource + fullTypeName + maxNumberOfRows + = + getOrCreateProvidedType cfg tp fullTypeName (fun () -> - let isRunningInFSI = cfg.IsHostedExecution - let defaultResolutionFolder = cfg.ResolutionFolder - - let valueToBeParsedOrItsUri = - match source with - | Sample value -> value - | SampleList value -> value - | Schema value -> value - - let parseResult = - parseTextAtDesignTime valueToBeParsedOrItsUri getSpec formatName tp cfg encodingStr resolutionFolder resource fullTypeName maxNumberOfRows - - let spec = parseResult.Spec - - let resultType = spec.RepresentationType - let resultTypeAsync = typedefof>.MakeGenericType(resultType) - - use _holder = logTime "CommonTypeGeneration" valueToBeParsedOrItsUri - - [ // Generate static Parse method - let args = [ ProvidedParameter("text", typeof) ] - 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 - | None -> () - | Some listParser -> - let resultTypeList = resultType.MakeArrayType() - let args = [ ProvidedParameter("text", typeof) ] - 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 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 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 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 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 - match spec.CreateFromValue with - | None -> () - | Some (valueType, valueMapper) -> - let args = [ ProvidedParameter("value", valueType) ] - 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 - - match source with - | SampleList _ -> - - // the [][] case needs more work, and it's a weird scenario anyway, so we won't support it - if not resultType.IsArray then - - let resultTypeArray = resultType.MakeArrayType() - let resultTypeArrayAsync = typedefof>.MakeGenericType(resultTypeArray) - - // Generate static GetSamples method - 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 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 _ -> - - let name = if resultType.IsArray then "GetSamples" else "GetSample" - let getSampleCode _ = - if parseResult.IsUri - then <@ Async.RunSynchronously(asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr valueToBeParsedOrItsUri) @> - else <@ new StringReader(valueToBeParsedOrItsUri) :> TextReader @> + let isRunningInFSI = cfg.IsHostedExecution + let defaultResolutionFolder = cfg.ResolutionFolder + + let valueToBeParsedOrItsUri = + match source with + | Sample value -> value + | SampleList value -> value + | Schema value -> value + + let parseResult = + parseTextAtDesignTime + valueToBeParsedOrItsUri + getSpec + formatName + tp + cfg + encodingStr + resolutionFolder + resource + fullTypeName + maxNumberOfRows + + let spec = parseResult.Spec + + let resultType = spec.RepresentationType + let resultTypeAsync = typedefof>.MakeGenericType (resultType) + + use _holder = logTime "CommonTypeGeneration" valueToBeParsedOrItsUri + + [ // Generate static Parse method + let args = [ ProvidedParameter("text", typeof) ] + + let m = + let parseCode (Singleton text: Expr list) = + <@ new StringReader(%%text) :> TextReader @> |> spec.CreateFromTextReader - // Generate static GetSample method - yield ProvidedMethod(name, [], resultType, isStatic = true, invokeCode = getSampleCode) :> _ - - if spec.GeneratedType :> Type = spec.RepresentationType then - // Generate default constructor - yield ProvidedConstructor([], invokeCode = getSampleCode) :> _ - - if parseResult.IsUri then - // Generate static AsyncGetSample method - 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 _ -> - let getSchemaCode _ = - if parseResult.IsUri - then <@ Async.RunSynchronously(asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr valueToBeParsedOrItsUri) @> - else <@ new StringReader(valueToBeParsedOrItsUri) :> TextReader @> - |> spec.CreateFromTextReaderForSampleList // hack: this will actually parse the schema - - // Generate static GetSchema method - yield ProvidedMethod("GetSchema", [], typeof, isStatic = true, - invokeCode = getSchemaCode) :> _ - - - ] |> spec.GeneratedType.AddMembers - - spec.GeneratedType) - -[] -do() + ProvidedMethod("Parse", args, resultType, isStatic = true, invokeCode = parseCode) + + m.AddXmlDoc(sprintf "Parses the specified %s string" formatName) + yield m :> MemberInfo + + match spec.CreateListFromTextReader with + | None -> () + | Some listParser -> + let resultTypeList = resultType.MakeArrayType() + let args = [ ProvidedParameter("text", typeof) ] + + 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 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 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 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 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 + match spec.CreateFromValue with + | None -> () + | Some (valueType, valueMapper) -> + let args = [ ProvidedParameter("value", valueType) ] + + 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 + + match source with + | SampleList _ -> + + // the [][] case needs more work, and it's a weird scenario anyway, so we won't support it + if not resultType.IsArray then + + let resultTypeArray = resultType.MakeArrayType() + let resultTypeArrayAsync = typedefof>.MakeGenericType (resultTypeArray) + + // Generate static GetSamples method + 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 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 _ -> + + let name = if resultType.IsArray then "GetSamples" else "GetSample" + + let getSampleCode _ = + if parseResult.IsUri then + <@ + Async.RunSynchronously( + asyncReadTextAtRuntimeWithDesignTimeRules + defaultResolutionFolder + resolutionFolder + formatName + encodingStr + valueToBeParsedOrItsUri + ) + @> + else + <@ new StringReader(valueToBeParsedOrItsUri) :> TextReader @> + |> spec.CreateFromTextReader + + // Generate static GetSample method + yield ProvidedMethod(name, [], resultType, isStatic = true, invokeCode = getSampleCode) :> _ + + if spec.GeneratedType :> Type = spec.RepresentationType then + // Generate default constructor + yield ProvidedConstructor([], invokeCode = getSampleCode) :> _ + + if parseResult.IsUri then + // Generate static AsyncGetSample method + 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 _ -> + let getSchemaCode _ = + if parseResult.IsUri then + <@ + Async.RunSynchronously( + asyncReadTextAtRuntimeWithDesignTimeRules + defaultResolutionFolder + resolutionFolder + formatName + encodingStr + valueToBeParsedOrItsUri + ) + @> + else + <@ new StringReader(valueToBeParsedOrItsUri) :> TextReader @> + |> spec.CreateFromTextReaderForSampleList // hack: this will actually parse the schema + + // Generate static GetSchema method + yield + ProvidedMethod( + "GetSchema", + [], + typeof, + isStatic = true, + invokeCode = getSchemaCode + ) + :> _ + + + ] + |> spec.GeneratedType.AddMembers + + spec.GeneratedType) + +[] +do () diff --git a/src/CommonProviderImplementation/QuotationBuilder.fs b/src/CommonProviderImplementation/QuotationBuilder.fs index 95db712a0..e9e38f113 100644 --- a/src/CommonProviderImplementation/QuotationBuilder.fs +++ b/src/CommonProviderImplementation/QuotationBuilder.fs @@ -13,7 +13,7 @@ open FSharp.Reflection open ProviderImplementation.ProvidedTypes open UncheckedQuotations -/// Dynamic operator (?) that can be used for constructing quoted F# code without +/// Dynamic operator (?) that can be used for constructing quoted F# code without /// quotations (to simplify constructing F# quotations in portable libraries - where /// we need to pass the System.Type of various types as arguments) /// @@ -24,48 +24,66 @@ open UncheckedQuotations /// Actual arguments can be either expression (Expr<'T>) or primitive values, whic /// are automatically wrapped using Expr.Value. /// -let (?) (typ:Type) (operation:string) (args1:'T) (args2: 'U) : Expr = - // Arguments are either Expr or other type - in the second case, - // we treat them as Expr.Value (which will only work for primitives) - let convertValue (arg:obj) = - match arg with - | :? Expr as e -> e - | :? Var as v -> Expr.Var v - | value -> Expr.Value(value, value.GetType()) +let (?) (typ: Type) (operation: string) (args1: 'T) (args2: 'U) : Expr = + // Arguments are either Expr or other type - in the second case, + // we treat them as Expr.Value (which will only work for primitives) + let convertValue (arg: obj) = + match arg with + | :? Expr as e -> e + | :? Var as v -> Expr.Var v + | value -> Expr.Value(value, value.GetType()) - let invokeOperation (tyargs:obj, tyargsT) (args:obj, argsT) = - // To support (e1, e2, ..) syntax, we use tuples - extract tuple arguments - // First, extract type arguments - a list of System.Type values - let tyargs = - if tyargsT = typeof then [] - elif FSharpType.IsTuple(tyargsT) then - [ for f in FSharpValue.GetTupleFields(tyargs) -> f :?> Type ] - else [ tyargs :?> Type ] - // Second, extract arguments (which are either Expr values or primitive constants) - let args = - if argsT = typeof then [] - elif FSharpType.IsTuple(argsT) then - [ for f in FSharpValue.GetTupleFields(args) -> convertValue f ] - else [ convertValue args ] + let invokeOperation (tyargs: obj, tyargsT) (args: obj, argsT) = + // To support (e1, e2, ..) syntax, we use tuples - extract tuple arguments + // First, extract type arguments - a list of System.Type values + let tyargs = + if tyargsT = typeof then + [] + elif FSharpType.IsTuple(tyargsT) then + [ for f in FSharpValue.GetTupleFields(tyargs) -> f :?> Type ] + else + [ tyargs :?> Type ] + // Second, extract arguments (which are either Expr values or primitive constants) + let args = + if argsT = typeof then + [] + elif FSharpType.IsTuple(argsT) then + [ for f in FSharpValue.GetTupleFields(args) -> convertValue f ] + else + [ convertValue args ] - // Find a method that we want to call - let flags = BindingFlags.Public ||| BindingFlags.Static ||| BindingFlags.Instance - match typ.GetMember(operation, MemberTypes.All, flags) with - | [| :? MethodInfo as mi |] -> - let mi = - if tyargs = [] then mi - else mi.MakeGenericMethod(tyargs |> Array.ofList) - if mi.IsStatic then Expr.CallUnchecked(mi, args) - else Expr.CallUnchecked(List.head args, mi, List.tail args) - | [| :? ConstructorInfo as ci |] -> - if tyargs <> [] then failwith "Constructor cannot be generic!" - Expr.NewObjectUnchecked(ci, args) - | [| :? PropertyInfo as pi |] -> - let isStatic = - pi.CanRead && pi.GetGetMethod().IsStatic || - pi.CanWrite && pi.GetSetMethod().IsStatic - if isStatic then Expr.PropertyGetUnchecked(pi, args) - else Expr.PropertyGetUnchecked(List.head args, pi, List.tail args) - | options -> failwithf "Constructing call of the '%s' operation failed. Got %A" operation options + // Find a method that we want to call + let flags = + BindingFlags.Public + ||| BindingFlags.Static + ||| BindingFlags.Instance - invokeOperation (args1, typeof<'T>) (args2, typeof<'U>) + match typ.GetMember(operation, MemberTypes.All, flags) with + | [| :? MethodInfo as mi |] -> + let mi = + if tyargs = [] then + mi + else + mi.MakeGenericMethod(tyargs |> Array.ofList) + + if mi.IsStatic then + Expr.CallUnchecked(mi, args) + else + Expr.CallUnchecked(List.head args, mi, List.tail args) + | [| :? ConstructorInfo as ci |] -> + if tyargs <> [] then + failwith "Constructor cannot be generic!" + + Expr.NewObjectUnchecked(ci, args) + | [| :? PropertyInfo as pi |] -> + let isStatic = + pi.CanRead && pi.GetGetMethod().IsStatic + || pi.CanWrite && pi.GetSetMethod().IsStatic + + if isStatic then + Expr.PropertyGetUnchecked(pi, args) + else + Expr.PropertyGetUnchecked(List.head args, pi, List.tail args) + | options -> failwithf "Constructing call of the '%s' operation failed. Got %A" operation options + + invokeOperation (args1, typeof<'T>) (args2, typeof<'U>) diff --git a/src/CommonRuntime/Caching.fs b/src/CommonRuntime/Caching.fs index 692a9aef8..9bc9c85a3 100644 --- a/src/CommonRuntime/Caching.fs +++ b/src/CommonRuntime/Caching.fs @@ -1,4 +1,4 @@ -/// Implements caching using in-memory and local file system +/// Implements caching using in-memory and local file system module FSharp.Data.Runtime.Caching open System @@ -9,19 +9,21 @@ open System.Security.Cryptography open System.Text open FSharp.Data.Runtime.IO -type ICache<'TKey, 'TValue> = - abstract Set : key:'TKey * value:'TValue -> unit - abstract TryRetrieve : key:'TKey * ?extendCacheExpiration:bool -> 'TValue option - abstract Remove : key:'TKey -> unit +type ICache<'TKey, 'TValue> = + abstract Set: key: 'TKey * value: 'TValue -> unit + abstract TryRetrieve: key: 'TKey * ?extendCacheExpiration: bool -> 'TValue option + abstract Remove: key: 'TKey -> unit /// Creates a cache that uses in-memory collection -let createInMemoryCache (expiration:TimeSpan) = - let dict = ConcurrentDictionary<'TKey_,'TValue*DateTime>() - let rec invalidationFunction key = - async { - do! Async.Sleep (int expiration.TotalMilliseconds) +let createInMemoryCache (expiration: TimeSpan) = + let dict = ConcurrentDictionary<'TKey_, 'TValue * DateTime>() + + let rec invalidationFunction key = + async { + do! Async.Sleep(int expiration.TotalMilliseconds) + match dict.TryGetValue(key) with - | true, (_, timestamp) -> + | true, (_, timestamp) -> if DateTime.UtcNow - timestamp >= expiration then match dict.TryRemove(key) with | true, _ -> log (sprintf "Cache expired: %O" key) @@ -30,97 +32,116 @@ let createInMemoryCache (expiration:TimeSpan) = do! invalidationFunction key | _ -> () } - { new ICache<_,_> with + + { new ICache<_, _> with member __.Set(key, value) = dict.[key] <- (value, DateTime.UtcNow) invalidationFunction key |> Async.Start + member x.TryRetrieve(key, ?extendCacheExpiration) = match dict.TryGetValue(key) with - | true, (value, timestamp) when DateTime.UtcNow - timestamp < expiration -> - if extendCacheExpiration = Some true then + | true, (value, timestamp) when DateTime.UtcNow - timestamp < expiration -> + if extendCacheExpiration = Some true then dict.[key] <- (value, DateTime.UtcNow) + Some value | _ -> None - member __.Remove(key) = + + member __.Remove(key) = match dict.TryRemove(key) with | true, _ -> log (sprintf "Explicitly removed from cache: %O" key) - | _ -> () - } + | _ -> () } /// Get hash code of a string - used to determine cache file -let private hashString (plainText:string) = - let plainTextBytes = Encoding.UTF8.GetBytes(plainText) - let hash = new SHA1Managed() - let hashBytes = hash.ComputeHash(plainTextBytes) - let s = Convert.ToBase64String(hashBytes) - s.Replace("ab","abab").Replace("\\","ab") +let private hashString (plainText: string) = + let plainTextBytes = Encoding.UTF8.GetBytes(plainText) + let hash = new SHA1Managed() + let hashBytes = hash.ComputeHash(plainTextBytes) + let s = Convert.ToBase64String(hashBytes) + s.Replace("ab", "abab").Replace("\\", "ab") /// Creates a cache that stores data in a local file system let createInternetFileCache prefix expiration = - // %UserProfile%\AppData\Local\Microsoft\Windows\INetCache - let cacheFolder = - if Environment.OSVersion.Platform = PlatformID.Unix - then Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + "/.cache/fsharp-data" - else Environment.GetFolderPath(Environment.SpecialFolder.InternetCache) - - let downloadCache = Path.Combine(cacheFolder, prefix) - - // Get file name for a given string (using hash) - let cacheFile key = - let sha1 = hashString key - let encoded = Uri.EscapeDataString sha1 - Path.Combine(downloadCache, encoded + ".txt") - - // A simple check for now. This is to guard against a corrupted cache file. - let isWellFormedResult result = not (String.IsNullOrEmpty result) - - try - // Try to create directory, if it does not exist - if not (Directory.Exists downloadCache) then - Directory.CreateDirectory downloadCache |> ignore - - let cache = - { new ICache with - member __.Set(key, value) = - let cacheFile = cacheFile key - try File.WriteAllText(cacheFile, value) - with e -> - Debug.WriteLine("Caching: Failed to write file {0} with an exception: {1}", cacheFile, e.Message) - - member __.TryRetrieve(key, ?extendCacheExpiration) = - if extendCacheExpiration = Some true then - failwith "Not implemented" - let cacheFile = cacheFile key - try - if File.Exists cacheFile && DateTime.UtcNow - File.GetLastWriteTimeUtc cacheFile < expiration then - let result = File.ReadAllText cacheFile - if isWellFormedResult result - then Some result - else None - else None - with e -> - Debug.WriteLine("Caching: Failed to read file {0} with an exception: {1}", cacheFile, e.Message) - None - - member __.Remove(key) = - let cacheFile = cacheFile key - try - File.Delete(cacheFile) - with e -> - Debug.WriteLine("Caching: Failed to delete file {0} with an exception: {1}", cacheFile, e.Message) - } - - // Ensure that we can access the file system by writing a sample value to the cache - cache.Set("$$$test$$$", "dummyValue") - match cache.TryRetrieve("$$$test$$$") with - | Some "dummyValue" -> - cache.Remove("$$$test$$$") |> ignore - cache - | _ -> + // %UserProfile%\AppData\Local\Microsoft\Windows\INetCache + let cacheFolder = + if Environment.OSVersion.Platform = PlatformID.Unix then + Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + + "/.cache/fsharp-data" + else + Environment.GetFolderPath(Environment.SpecialFolder.InternetCache) + + let downloadCache = Path.Combine(cacheFolder, prefix) + + // Get file name for a given string (using hash) + let cacheFile key = + let sha1 = hashString key + let encoded = Uri.EscapeDataString sha1 + Path.Combine(downloadCache, encoded + ".txt") + + // A simple check for now. This is to guard against a corrupted cache file. + let isWellFormedResult result = not (String.IsNullOrEmpty result) + + try + // Try to create directory, if it does not exist + if not (Directory.Exists downloadCache) then + Directory.CreateDirectory downloadCache |> ignore + + let cache = + { new ICache with + member __.Set(key, value) = + let cacheFile = cacheFile key + + try + File.WriteAllText(cacheFile, value) + with e -> + Debug.WriteLine( + "Caching: Failed to write file {0} with an exception: {1}", + cacheFile, + e.Message + ) + + member __.TryRetrieve(key, ?extendCacheExpiration) = + if extendCacheExpiration = Some true then + failwith "Not implemented" + + let cacheFile = cacheFile key + + try + if File.Exists cacheFile + && DateTime.UtcNow + - File.GetLastWriteTimeUtc cacheFile < expiration then + let result = File.ReadAllText cacheFile + if isWellFormedResult result then Some result else None + else + None + with e -> + Debug.WriteLine("Caching: Failed to read file {0} with an exception: {1}", cacheFile, e.Message) + None + + member __.Remove(key) = + let cacheFile = cacheFile key + + try + File.Delete(cacheFile) + with e -> + Debug.WriteLine( + "Caching: Failed to delete file {0} with an exception: {1}", + cacheFile, + e.Message + ) } + + // Ensure that we can access the file system by writing a sample value to the cache + cache.Set("$$$test$$$", "dummyValue") + + match cache.TryRetrieve("$$$test$$$") with + | Some "dummyValue" -> + cache.Remove("$$$test$$$") |> ignore + cache + | _ -> + // fallback to an in memory cache + createInMemoryCache expiration + with e -> + Debug.WriteLine("Caching: Fall back to memory cache, because of an exception: {0}", e.Message) // fallback to an in memory cache createInMemoryCache expiration - with e -> - Debug.WriteLine("Caching: Fall back to memory cache, because of an exception: {0}", e.Message) - // fallback to an in memory cache - createInMemoryCache expiration diff --git a/src/CommonRuntime/IO.fs b/src/CommonRuntime/IO.fs index 4f2bb3ed1..e4c08cbc5 100644 --- a/src/CommonRuntime/IO.fs +++ b/src/CommonRuntime/IO.fs @@ -12,18 +12,21 @@ type internal UriResolutionType = | Runtime | RuntimeInFSI -let internal isWeb (uri:Uri) = uri.IsAbsoluteUri && not uri.IsUnc && uri.Scheme <> "file" - -type internal UriResolver = - - { ResolutionType : UriResolutionType - DefaultResolutionFolder : string - ResolutionFolder : string } - +let internal isWeb (uri: Uri) = + uri.IsAbsoluteUri + && not uri.IsUnc + && uri.Scheme <> "file" + +type internal UriResolver = + + { ResolutionType: UriResolutionType + DefaultResolutionFolder: string + ResolutionFolder: string } + static member Create(resolutionType, defaultResolutionFolder, resolutionFolder) = - { ResolutionType = resolutionType - DefaultResolutionFolder = defaultResolutionFolder - ResolutionFolder = resolutionFolder } + { ResolutionType = resolutionType + DefaultResolutionFolder = defaultResolutionFolder + ResolutionFolder = resolutionFolder } /// Resolve the absolute location of a file (or web URL) according to the rules /// used by standard F# type providers as described here: @@ -38,26 +41,29 @@ type internal UriResolver = /// * otherwise use the default resolution folder /// At run-time: /// * if the user specified resolution folder, use that - /// * if it is running in F# interactive (config.IsHostedExecution) + /// * if it is running in F# interactive (config.IsHostedExecution) /// use the default resolution folder /// * otherwise, use 'CurrentDomain.BaseDirectory' /// returns an absolute uri * isWeb flag - member x.Resolve(uri:Uri) = - if uri.IsAbsoluteUri then - uri, isWeb uri - else - let root = - match x.ResolutionType with - | DesignTime -> if String.IsNullOrEmpty x.ResolutionFolder - then x.DefaultResolutionFolder - else x.ResolutionFolder - | RuntimeInFSI -> x.DefaultResolutionFolder - | Runtime -> AppDomain.CurrentDomain.BaseDirectory.TrimEnd('\\', '/') - Uri(Path.Combine(root, uri.OriginalString), UriKind.Absolute), false + member x.Resolve(uri: Uri) = + if uri.IsAbsoluteUri then + uri, isWeb uri + else + let root = + match x.ResolutionType with + | DesignTime -> + if String.IsNullOrEmpty x.ResolutionFolder then + x.DefaultResolutionFolder + else + x.ResolutionFolder + | RuntimeInFSI -> x.DefaultResolutionFolder + | Runtime -> AppDomain.CurrentDomain.BaseDirectory.TrimEnd('\\', '/') + + Uri(Path.Combine(root, uri.OriginalString), UriKind.Absolute), false #if LOGGING_ENABLED -let private logLock = obj() +let private logLock = obj () let mutable private indentation = 0 let private appendToLogMultiple logFile lines = @@ -65,34 +71,40 @@ let private appendToLogMultiple logFile lines = 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")) + + 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] +let private appendToLog logFile line = appendToLogMultiple logFile [ line ] let internal log str = #if TIMESTAMPS_IN_LOG - "[" + DateTime.Now.TimeOfDay.ToString() + "] " + String(' ', indentation * 2) + str + "[" + + DateTime.Now.TimeOfDay.ToString() + + "] " + + String(' ', indentation * 2) + + str #else String(' ', indentation * 2) + str #endif |> appendToLog "log.txt" -let internal logWithStackTrace (str:string) = - let stackTrace = +let internal logWithStackTrace (str: string) = + let stackTrace = Environment.StackTrace.Split '\n' |> Seq.skip 3 |> Seq.truncate 5 |> Seq.map (fun s -> s.TrimEnd()) |> Seq.toList - str::stackTrace |> appendToLogMultiple "log.txt" + + str :: stackTrace |> appendToLogMultiple "log.txt" open System.Diagnostics open System.Threading - -let internal logTime category (instance:string) = + +let internal logTime category (instance: string) = log (sprintf "%s %s" category instance) Interlocked.Increment &indentation |> ignore @@ -105,16 +117,20 @@ let internal logTime category (instance:string) = s.Stop() Interlocked.Decrement &indentation |> ignore log (sprintf "Finished %s [%dms]" category s.ElapsedMilliseconds) - let instance = instance.Replace("\r", null).Replace("\n","\\n") + let instance = instance.Replace("\r", null).Replace("\n", "\\n") + sprintf "%s|%s|%d" category instance s.ElapsedMilliseconds |> appendToLog "log.csv" } #else -let internal dummyDisposable = { new IDisposable with member __.Dispose() = () } -let inline internal log (_:string) = () -let inline internal logWithStackTrace (_:string) = () -let inline internal logTime (_:string) (_:string) = dummyDisposable +let internal dummyDisposable = + { new IDisposable with + member __.Dispose() = () } + +let inline internal log (_: string) = () +let inline internal logWithStackTrace (_: string) = () +let inline internal logTime (_: string) (_: string) = dummyDisposable #endif @@ -122,54 +138,56 @@ type private FileWatcher(path) = let subscriptions = Dictionary unit>() - let getLastWrite() = File.GetLastWriteTime path - let mutable lastWrite = getLastWrite() - - let watcher = + let getLastWrite () = File.GetLastWriteTime path + let mutable lastWrite = getLastWrite () + + let watcher = new FileSystemWatcher( - Filter = Path.GetFileName path, - Path = Path.GetDirectoryName path, - EnableRaisingEvents = true) + Filter = Path.GetFileName path, + Path = Path.GetDirectoryName path, + EnableRaisingEvents = true + ) let checkForChanges action _ = - let curr = getLastWrite() - + let curr = getLastWrite () + if lastWrite <> curr then log (sprintf "File %s: %s" action path) lastWrite <- curr // creating a copy since the handler can be unsubscribed during the iteration let handlers = subscriptions.Values |> Seq.toArray + for handler in handlers do - handler() + handler () do - watcher.Changed.Add (checkForChanges "changed") - watcher.Renamed.Add (checkForChanges "renamed") - watcher.Deleted.Add (checkForChanges "deleted") + watcher.Changed.Add(checkForChanges "changed") + watcher.Renamed.Add(checkForChanges "renamed") + watcher.Deleted.Add(checkForChanges "deleted") - member __.Subscribe(name, action) = - subscriptions.Add(name, action) + member __.Subscribe(name, action) = subscriptions.Add(name, action) - member __.Unsubscribe(name) = + member __.Unsubscribe(name) = if subscriptions.Remove(name) then - log (sprintf "Unsubscribed %s from %s watcher" name path) + log (sprintf "Unsubscribed %s from %s watcher" name path) + if subscriptions.Count = 0 then - log (sprintf "Disposing %s watcher" path) + log (sprintf "Disposing %s watcher" path) watcher.Dispose() true else - false + false else false -let private watchers = Dictionary() +let private watchers = Dictionary() // sets up a filesystem watcher that calls the invalidate function whenever the file changes let watchForChanges path (owner, onChange) = - let watcher = + let watcher = - lock watchers (fun () -> + lock watchers (fun () -> match watchers.TryGetValue(path) with | true, watcher -> @@ -179,66 +197,83 @@ let watchForChanges path (owner, onChange) = watcher | false, _ -> - + log (sprintf "Setting up %s watcher" path) let watcher = FileWatcher path watcher.Subscribe(owner, onChange) watchers.Add(path, watcher) - watcher - ) - + watcher) + { new IDisposable with member __.Dispose() = 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 /// It the uri is a file, uses shared read, so it works when the file locked by Excel or similar tools, /// and sets up a filesystem watcher that calls the invalidate function whenever the file changes -let internal asyncRead (uriResolver:UriResolver) formatName encodingStr (uri:Uri) = - let uri, isWeb = uriResolver.Resolve uri - if isWeb then - async { - let contentTypes = - match formatName with - | "CSV" -> [ HttpContentTypes.Csv ] - | "HTML" -> [ HttpContentTypes.Html ] - | "JSON" -> [ HttpContentTypes.Json ] - | "XML" -> [ HttpContentTypes.Xml ] - | _ -> [] - @ [ HttpContentTypes.Any ] - let headers = [ HttpRequestHeaders.UserAgent ("FSharp.Data " + formatName + " Type Provider") - HttpRequestHeaders.Accept (String.concat ", " contentTypes) ] - // Download the whole web resource at once, otherwise with some servers we won't get the full file - let! text = Http.AsyncRequestString(uri.OriginalString, headers = headers, responseEncodingOverride = encodingStr) - return new StringReader(text) :> TextReader - }, None - else - let path = uri.OriginalString.Replace(Uri.UriSchemeFile + "://", "") - async { - let file = File.Open(path, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) - let encoding = if encodingStr = "" then Encoding.UTF8 else HttpEncodings.getEncoding encodingStr - return new StreamReader(file, encoding) :> TextReader - }, Some path +let internal asyncRead (uriResolver: UriResolver) formatName encodingStr (uri: Uri) = + let uri, isWeb = uriResolver.Resolve uri + + if isWeb then + async { + let contentTypes = + match formatName with + | "CSV" -> [ HttpContentTypes.Csv ] + | "HTML" -> [ HttpContentTypes.Html ] + | "JSON" -> [ HttpContentTypes.Json ] + | "XML" -> [ HttpContentTypes.Xml ] + | _ -> [] + @ [ HttpContentTypes.Any ] + + let headers = + [ HttpRequestHeaders.UserAgent("FSharp.Data " + formatName + " Type Provider") + HttpRequestHeaders.Accept(String.concat ", " contentTypes) ] + // Download the whole web resource at once, otherwise with some servers we won't get the full file + let! text = + Http.AsyncRequestString(uri.OriginalString, headers = headers, responseEncodingOverride = encodingStr) + + return new StringReader(text) :> TextReader + }, + None + else + let path = uri.OriginalString.Replace(Uri.UriSchemeFile + "://", "") + + async { + let file = File.Open(path, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) + + let encoding = + if encodingStr = "" then + Encoding.UTF8 + else + HttpEncodings.getEncoding encodingStr + + return new StreamReader(file, encoding) :> TextReader + }, + Some path let private withUri uri = - match Uri.TryCreate(uri, UriKind.RelativeOrAbsolute) with - | false, _ -> failwithf "Invalid uri: %s" uri - | true, uri -> uri + match Uri.TryCreate(uri, UriKind.RelativeOrAbsolute) with + | false, _ -> failwithf "Invalid uri: %s" uri + | true, uri -> uri /// Returns a TextReader for the uri using the runtime resolution rules -let asyncReadTextAtRuntime forFSI defaultResolutionFolder resolutionFolder formatName encodingStr uri = - let uri = withUri uri - let resolver = UriResolver.Create((if forFSI then RuntimeInFSI else Runtime), - defaultResolutionFolder, resolutionFolder) - asyncRead resolver formatName encodingStr uri |> fst +let asyncReadTextAtRuntime forFSI defaultResolutionFolder resolutionFolder formatName encodingStr uri = + 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 = - let uri = withUri uri - let resolver = UriResolver.Create(DesignTime, defaultResolutionFolder, resolutionFolder) - asyncRead resolver formatName encodingStr uri |> fst +let asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr uri = + let uri = withUri uri + + let resolver = + UriResolver.Create(DesignTime, defaultResolutionFolder, resolutionFolder) + asyncRead resolver formatName encodingStr uri + |> fst diff --git a/src/CommonRuntime/NameUtils.fs b/src/CommonRuntime/NameUtils.fs index 015065c21..5462007b0 100644 --- a/src/CommonRuntime/NameUtils.fs +++ b/src/CommonRuntime/NameUtils.fs @@ -9,9 +9,19 @@ open FSharp.Data.Runtime // -------------------------------------------------------------------------------------- // Active patterns & operators for parsing strings -let private tryAt (s:string) i = if i >= s.Length then None else Some s.[i] -let private sat f (c:option) = match c with Some c when f c -> Some c | _ -> None -let private (|EOF|_|) c = match c with Some _ -> None | _ -> Some () +let private tryAt (s: string) i = + if i >= s.Length then None else Some s.[i] + +let private sat f (c: option) = + match c with + | Some c when f c -> Some c + | _ -> None + +let private (|EOF|_|) c = + match c with + | Some _ -> None + | _ -> Some() + let private (|LetterDigit|_|) = sat Char.IsLetterOrDigit let private (|Upper|_|) = sat (fun c -> Char.IsUpper c || Char.IsDigit c) let private (|Lower|_|) = sat (fun c -> Char.IsLower c || Char.IsDigit c) @@ -19,114 +29,142 @@ let private (|Lower|_|) = sat (fun c -> Char.IsLower c || Char.IsDigit c) // -------------------------------------------------------------------------------------- /// Turns a given non-empty string into a nice 'PascalCase' identifier -let nicePascalName (s:string) = - if s.Length = 1 then s.ToUpperInvariant() else - // Starting to parse a new segment - let rec restart i = seq { - match tryAt s i with - | EOF -> () - | LetterDigit _ & Upper _ -> yield! upperStart i (i + 1) - | LetterDigit _ -> yield! consume i false (i + 1) - | _ -> yield! restart (i + 1) } - // Parsed first upper case letter, continue either all lower or all upper - and upperStart from i = seq { - match tryAt s i with - | Upper _ -> yield! consume from true (i + 1) - | Lower _ -> yield! consume from false (i + 1) - | _ -> - yield from, i - yield! restart (i + 1) } - // Consume are letters of the same kind (either all lower or all upper) - and consume from takeUpper i = seq { - match tryAt s i with - | Lower _ when not takeUpper -> yield! consume from takeUpper (i + 1) - | Upper _ when takeUpper -> yield! consume from takeUpper (i + 1) - | Lower _ when takeUpper -> - yield from, (i - 1) - yield! restart (i - 1) - | _ -> - yield from, i - yield! restart i } - - // Split string into segments and turn them to PascalCase - seq { for i1, i2 in restart 0 do - let sub = s.Substring(i1, i2 - i1) - if Array.forall Char.IsLetterOrDigit (sub.ToCharArray()) then - yield sub.[0].ToString().ToUpperInvariant() + sub.ToLowerInvariant().Substring(1) } - |> String.Concat +let nicePascalName (s: string) = + if s.Length = 1 then + s.ToUpperInvariant() + else + // Starting to parse a new segment + let rec restart i = + seq { + match tryAt s i with + | EOF -> () + | LetterDigit _ & Upper _ -> yield! upperStart i (i + 1) + | LetterDigit _ -> yield! consume i false (i + 1) + | _ -> yield! restart (i + 1) + } + // Parsed first upper case letter, continue either all lower or all upper + and upperStart from i = + seq { + match tryAt s i with + | Upper _ -> yield! consume from true (i + 1) + | Lower _ -> yield! consume from false (i + 1) + | _ -> + yield from, i + yield! restart (i + 1) + } + // Consume are letters of the same kind (either all lower or all upper) + and consume from takeUpper i = + seq { + match tryAt s i with + | Lower _ when not takeUpper -> yield! consume from takeUpper (i + 1) + | Upper _ when takeUpper -> yield! consume from takeUpper (i + 1) + | Lower _ when takeUpper -> + yield from, (i - 1) + yield! restart (i - 1) + | _ -> + yield from, i + yield! restart i + } + + // Split string into segments and turn them to PascalCase + seq { + for i1, i2 in restart 0 do + let sub = s.Substring(i1, i2 - i1) + + if Array.forall Char.IsLetterOrDigit (sub.ToCharArray()) then + yield + sub.[0].ToString().ToUpperInvariant() + + sub.ToLowerInvariant().Substring(1) + } + |> String.Concat /// Turns a given non-empty string into a nice 'camelCase' identifier -let niceCamelName (s:string) = - let name = nicePascalName s - if name.Length > 0 then - name.[0].ToString().ToLowerInvariant() + name.Substring(1) - else name +let niceCamelName (s: string) = + let name = nicePascalName s + + if name.Length > 0 then + name.[0].ToString().ToLowerInvariant() + + name.Substring(1) + else + name /// Given a function to format names (such as 'niceCamelName' or 'nicePascalName') /// returns a name generator that never returns duplicate name (by appending an /// index to already used names) -/// +/// /// This function is curried and should be used with partial function application: /// /// let makeUnique = uniqueGenerator nicePascalName /// let n1 = makeUnique "sample-name" /// let n2 = makeUnique "sample-name" /// -let uniqueGenerator (niceName:string->string) = - let set = new HashSet<_>() - fun name -> - let mutable name = niceName name - if name.Length = 0 then name <- "Unnamed" - while set.Contains name do - let mutable lastLetterPos = String.length name - 1 - while Char.IsDigit name.[lastLetterPos] && lastLetterPos > 0 do - lastLetterPos <- lastLetterPos - 1 - if lastLetterPos = name.Length - 1 then - if name.Contains " " then - name <- name + " 2" - else - name <- name + "2" - elif lastLetterPos = 0 && name.Length = 1 then - name <- (UInt64.Parse name + 1UL).ToString() - else - let number = name.Substring(lastLetterPos + 1) - name <- name.Substring(0, lastLetterPos + 1) + (UInt64.Parse number + 1UL).ToString() - set.Add name |> ignore - name - -let capitalizeFirstLetter (s:string) = +let uniqueGenerator (niceName: string -> string) = + let set = new HashSet<_>() + + fun name -> + let mutable name = niceName name + if name.Length = 0 then name <- "Unnamed" + + while set.Contains name do + let mutable lastLetterPos = String.length name - 1 + + while Char.IsDigit name.[lastLetterPos] + && lastLetterPos > 0 do + lastLetterPos <- lastLetterPos - 1 + + if lastLetterPos = name.Length - 1 then + if name.Contains " " then + name <- name + " 2" + else + name <- name + "2" + elif lastLetterPos = 0 && name.Length = 1 then + name <- (UInt64.Parse name + 1UL).ToString() + else + let number = name.Substring(lastLetterPos + 1) + + name <- + name.Substring(0, lastLetterPos + 1) + + (UInt64.Parse number + 1UL).ToString() + + set.Add name |> ignore + name + +let capitalizeFirstLetter (s: string) = match s.Length with - | 0 -> "" - | 1 -> (Char.ToUpperInvariant s.[0]).ToString() - | _ -> (Char.ToUpperInvariant s.[0]).ToString() + s.Substring(1) + | 0 -> "" + | 1 -> (Char.ToUpperInvariant s.[0]).ToString() + | _ -> + (Char.ToUpperInvariant s.[0]).ToString() + + s.Substring(1) /// Trim HTML tags from a given string and replace all of them with spaces -/// Multiple tags are replaced with just a single space. (This is a recursive +/// Multiple tags are replaced with just a single space. (This is a recursive /// implementation that is somewhat faster than regular expression.) -let trimHtml (s:string) = - let chars = s.ToCharArray() - let res = new Text.StringBuilder() - - // Loop and keep track of whether we're inside a tag or not - let rec loop i emitSpace inside = - if i >= chars.Length then () else - let c = chars.[i] - match inside, c with - | true, '>' -> loop (i + 1) false false - | false, '<' -> - if emitSpace then res.Append(' ') |> ignore - loop (i + 1) false true - | _ -> - if not inside then res.Append(c) |> ignore - loop (i + 1) true inside - - loop 0 false false - res.ToString().TrimEnd() +let trimHtml (s: string) = + let chars = s.ToCharArray() + let res = new Text.StringBuilder() + + // Loop and keep track of whether we're inside a tag or not + let rec loop i emitSpace inside = + if i >= chars.Length then + () + else + let c = chars.[i] + + match inside, c with + | true, '>' -> loop (i + 1) false false + | false, '<' -> + if emitSpace then res.Append(' ') |> ignore + loop (i + 1) false true + | _ -> + if not inside then res.Append(c) |> ignore + loop (i + 1) true inside + + loop 0 false false + res.ToString().TrimEnd() /// Return the plural of an English word -let pluralize s = - Pluralizer.toPlural s +let pluralize s = Pluralizer.toPlural s /// Return the singular of an English word -let singularize s = - Pluralizer.toSingular s +let singularize s = Pluralizer.toSingular s diff --git a/src/CommonRuntime/Pluralizer.fs b/src/CommonRuntime/Pluralizer.fs index e7f725eb8..50a47558d 100644 --- a/src/CommonRuntime/Pluralizer.fs +++ b/src/CommonRuntime/Pluralizer.fs @@ -14,185 +14,190 @@ module internal FSharp.Data.Runtime.Pluralizer open System open System.Collections.Generic -// Pluralization service for nice 'NameUtils.fs' based on C# code from -// http://blogs.msdn.com/b/dmitryr/archive/2007/01/11/simple-english-noun-pluralizer-in-c.aspx +// Pluralization service for nice 'NameUtils.fs' based on C# code from +// http://blogs.msdn.com/b/dmitryr/archive/2007/01/11/simple-english-noun-pluralizer-in-c.aspx // (with a couple of more rules were added) -type private SuffixRule = - { SingularSuffix : string - PluralSuffix : string } - -let private tables = lazy( - - let suffixRules = - ["ch", "ches" - "sh", "shes" - "ss", "sses" - - "ay", "ays" - "ey", "eys" - "iy", "iys" - "oy", "oys" - "uy", "uys" - "y", "ies" - - "ao", "aos" - "eo", "eos" - "io", "ios" - "oo", "oos" - "uo", "uos" - "o", "oes" - - "house", "houses" - "course", "courses" - - "cis", "ces" - "us", "uses" - "sis", "ses" - "xis", "xes" - - "louse", "lice" - "mouse", "mice" - - "zoon", "zoa" - - "man", "men" - - "deer", "deer" - "fish", "fish" - "sheep", "sheep" - "itis", "itis" - "ois", "ois" - "pox", "pox" - "ox", "oxes" - - "foot", "feet" - "goose", "geese" - "tooth", "teeth" - - "alf", "alves" - "elf", "elves" - "olf", "olves" - "arf", "arves" - "leaf", "leaves" - "nife", "nives" - "life", "lives" - "wife", "wives"] - - let specialWords = - ["agendum", "agenda", "" - "aircraft", "", "" - "albino", "albinos", "" - "alga", "algae", "" - "alumna", "alumnae", "" - "alumnus", "alumni", "" - "apex", "apices", "apexes" - "archipelago", "archipelagos", "" - "bacterium", "bacteria", "" - "beef", "beefs", "beeves" - "bison", "", "" - "brother", "brothers", "brethren" - "candelabrum", "candelabra", "" - "carp", "", "" - "casino", "casinos", "" - "child", "children", "" - "chassis", "", "" - "chinese", "", "" - "choice", "choices", "" - "clippers", "", "" - "cod", "", "" - "codex", "codices", "" - "commando", "commandos", "" - "corps", "", "" - "cortex", "cortices", "cortexes" - "cow", "cows", "kine" - "criterion", "criteria", "" - "datum", "data", "" - "debris", "", "" - "diabetes", "", "" - "ditto", "dittos", "" - "djinn", "", "" - "dynamo", "", "" - "elk", "", "" - "embryo", "embryos", "" - "ephemeris", "ephemeris", "ephemerides" - "erratum", "errata", "" - "extremum", "extrema", "" - "fiasco", "fiascos", "" - "fish", "fishes", "fish" - "flounder", "", "" - "focus", "focuses", "foci" - "fungus", "fungi", "funguses" - "gallows", "", "" - "genie", "genies", "genii" - "ghetto", "ghettos", "" - "graffiti", "", "" - "headquarters", "", "" - "herpes", "", "" - "homework", "", "" - "index", "indices", "indexes" - "inferno", "infernos", "" - "japanese", "", "" - "jumbo", "jumbos", "" - "latex", "latices", "latexes" - "lingo", "lingos", "" - "mackerel", "", "" - "macro", "macros", "" - "manifesto", "manifestos", "" - "measles", "", "" - "money", "moneys", "monies" - "mongoose", "mongooses", "mongoose" - "mumps", "", "" - "murex", "murecis", "" - "mythos", "mythos", "mythoi" - "news", "", "" - "octopus", "octopuses", "octopodes" - "ovum", "ova", "" - "ox", "ox", "oxen" - "photo", "photos", "" - "pincers", "", "" - "pliers", "", "" - "pro", "pros", "" - "rabies", "", "" - "radius", "radiuses", "radii" - "release", "releases", "" - "rhino", "rhinos", "" - "salmon", "", "" - "scissors", "", "" - "series", "", "" - "shears", "", "" - "silex", "silices", "" - "simplex", "simplices", "simplexes" - "slice", "slices", "" - "soliloquy", "soliloquies", "soliloquy" - "species", "", "" - "stratum", "strata", "" - "source", "sources", "" - "swine", "", "" - "trout", "", "" - "tuna", "", "" - "vertebra", "vertebrae", "" - "vertex", "vertices", "vertexes" - "vortex", "vortices", "vortexes"] - - let suffixRules = - suffixRules - |> List.map (fun (singular, plural) -> { SingularSuffix = singular; PluralSuffix = plural }) - - let specialSingulars = new Dictionary<_, _>(StringComparer.OrdinalIgnoreCase) - let specialPlurals = new Dictionary<_, _>(StringComparer.OrdinalIgnoreCase) - - for singular, plural, plural2 in specialWords do - let plural = if plural = "" then singular else plural - specialPlurals.Add(singular, plural) - specialSingulars.Add(plural, singular) - if plural2 <> "" then - specialSingulars.Add(plural2, singular) - - suffixRules, specialSingulars, specialPlurals) +type private SuffixRule = + { SingularSuffix: string + PluralSuffix: string } + +let private tables = + lazy + ( + + let suffixRules = + [ "ch", "ches" + "sh", "shes" + "ss", "sses" + + "ay", "ays" + "ey", "eys" + "iy", "iys" + "oy", "oys" + "uy", "uys" + "y", "ies" + + "ao", "aos" + "eo", "eos" + "io", "ios" + "oo", "oos" + "uo", "uos" + "o", "oes" + + "house", "houses" + "course", "courses" + + "cis", "ces" + "us", "uses" + "sis", "ses" + "xis", "xes" + + "louse", "lice" + "mouse", "mice" + + "zoon", "zoa" + + "man", "men" + + "deer", "deer" + "fish", "fish" + "sheep", "sheep" + "itis", "itis" + "ois", "ois" + "pox", "pox" + "ox", "oxes" + + "foot", "feet" + "goose", "geese" + "tooth", "teeth" + + "alf", "alves" + "elf", "elves" + "olf", "olves" + "arf", "arves" + "leaf", "leaves" + "nife", "nives" + "life", "lives" + "wife", "wives" ] + + let specialWords = + [ "agendum", "agenda", "" + "aircraft", "", "" + "albino", "albinos", "" + "alga", "algae", "" + "alumna", "alumnae", "" + "alumnus", "alumni", "" + "apex", "apices", "apexes" + "archipelago", "archipelagos", "" + "bacterium", "bacteria", "" + "beef", "beefs", "beeves" + "bison", "", "" + "brother", "brothers", "brethren" + "candelabrum", "candelabra", "" + "carp", "", "" + "casino", "casinos", "" + "child", "children", "" + "chassis", "", "" + "chinese", "", "" + "choice", "choices", "" + "clippers", "", "" + "cod", "", "" + "codex", "codices", "" + "commando", "commandos", "" + "corps", "", "" + "cortex", "cortices", "cortexes" + "cow", "cows", "kine" + "criterion", "criteria", "" + "datum", "data", "" + "debris", "", "" + "diabetes", "", "" + "ditto", "dittos", "" + "djinn", "", "" + "dynamo", "", "" + "elk", "", "" + "embryo", "embryos", "" + "ephemeris", "ephemeris", "ephemerides" + "erratum", "errata", "" + "extremum", "extrema", "" + "fiasco", "fiascos", "" + "fish", "fishes", "fish" + "flounder", "", "" + "focus", "focuses", "foci" + "fungus", "fungi", "funguses" + "gallows", "", "" + "genie", "genies", "genii" + "ghetto", "ghettos", "" + "graffiti", "", "" + "headquarters", "", "" + "herpes", "", "" + "homework", "", "" + "index", "indices", "indexes" + "inferno", "infernos", "" + "japanese", "", "" + "jumbo", "jumbos", "" + "latex", "latices", "latexes" + "lingo", "lingos", "" + "mackerel", "", "" + "macro", "macros", "" + "manifesto", "manifestos", "" + "measles", "", "" + "money", "moneys", "monies" + "mongoose", "mongooses", "mongoose" + "mumps", "", "" + "murex", "murecis", "" + "mythos", "mythos", "mythoi" + "news", "", "" + "octopus", "octopuses", "octopodes" + "ovum", "ova", "" + "ox", "ox", "oxen" + "photo", "photos", "" + "pincers", "", "" + "pliers", "", "" + "pro", "pros", "" + "rabies", "", "" + "radius", "radiuses", "radii" + "release", "releases", "" + "rhino", "rhinos", "" + "salmon", "", "" + "scissors", "", "" + "series", "", "" + "shears", "", "" + "silex", "silices", "" + "simplex", "simplices", "simplexes" + "slice", "slices", "" + "soliloquy", "soliloquies", "soliloquy" + "species", "", "" + "stratum", "strata", "" + "source", "sources", "" + "swine", "", "" + "trout", "", "" + "tuna", "", "" + "vertebra", "vertebrae", "" + "vertex", "vertices", "vertexes" + "vortex", "vortices", "vortexes" ] + + let suffixRules = + suffixRules + |> List.map (fun (singular, plural) -> + { SingularSuffix = singular + PluralSuffix = plural }) + + let specialSingulars = new Dictionary<_, _>(StringComparer.OrdinalIgnoreCase) + let specialPlurals = new Dictionary<_, _>(StringComparer.OrdinalIgnoreCase) + + for singular, plural, plural2 in specialWords do + let plural = if plural = "" then singular else plural + specialPlurals.Add(singular, plural) + specialSingulars.Add(plural, singular) + + if plural2 <> "" then + specialSingulars.Add(plural2, singular) + + suffixRules, specialSingulars, specialPlurals) let private adjustCase (s: string) (template: string) = - if String.IsNullOrEmpty s then + if String.IsNullOrEmpty s then s else // determine the type of casing of the template string @@ -203,8 +208,7 @@ let private adjustCase (s: string) (template: string) = for i = 0 to template.Length - 1 do if Char.IsUpper template.[i] then - if i = 0 then - firstUpper <- true + if i = 0 then firstUpper <- true allLower <- false foundUpperOrLower <- true else if Char.IsLower template.[i] then @@ -219,53 +223,67 @@ let private adjustCase (s: string) (template: string) = else if allUpper then s.ToUpperInvariant() else if firstUpper && not <| Char.IsUpper s.[0] then - s.Substring(0, 1).ToUpperInvariant() + s.Substring(1) + s.Substring(0, 1).ToUpperInvariant() + + s.Substring(1) else s let private tryToPlural (word: string) suffixRule = if word.EndsWith(suffixRule.SingularSuffix, StringComparison.OrdinalIgnoreCase) then - Some <| word.Substring(0, word.Length - suffixRule.SingularSuffix.Length) + suffixRule.PluralSuffix + Some + <| word.Substring(0, word.Length - suffixRule.SingularSuffix.Length) + + suffixRule.PluralSuffix else None -let private tryToSingular (word: string) suffixRule = +let private tryToSingular (word: string) suffixRule = if word.EndsWith(suffixRule.PluralSuffix, StringComparison.OrdinalIgnoreCase) then - Some <| word.Substring(0, word.Length - suffixRule.PluralSuffix.Length) + suffixRule.SingularSuffix + Some + <| word.Substring(0, word.Length - suffixRule.PluralSuffix.Length) + + suffixRule.SingularSuffix else None let toPlural noun = - if String.IsNullOrEmpty noun then noun - else + if String.IsNullOrEmpty noun then + noun + else let suffixRules, _, specialPlurals = tables.Value - let plural = + + let plural = match specialPlurals.TryGetValue noun with | true, plural -> plural - | false, _ -> + | false, _ -> match suffixRules |> Seq.tryPick (tryToPlural noun) with | Some plural -> plural - | None -> + | None -> if noun.EndsWith("s", StringComparison.OrdinalIgnoreCase) then noun else noun + "s" - + (plural, noun) ||> adjustCase let toSingular noun = - if String.IsNullOrEmpty noun then noun - else + if String.IsNullOrEmpty noun then + noun + else let suffixRules, specialSingulars, _ = tables.Value - let singular = + + let singular = match specialSingulars.TryGetValue noun with | true, singular -> singular - | false, _ -> + | false, _ -> match suffixRules |> Seq.tryPick (tryToSingular noun) with | Some singular -> singular | None -> - if noun.EndsWith("s", StringComparison.OrdinalIgnoreCase) && not <| noun.EndsWith("us", StringComparison.OrdinalIgnoreCase) then + if + noun.EndsWith("s", StringComparison.OrdinalIgnoreCase) + && not + <| noun.EndsWith("us", StringComparison.OrdinalIgnoreCase) + then noun.Substring(0, noun.Length - 1) else noun + (singular, noun) ||> adjustCase diff --git a/src/CommonRuntime/StructuralInference.fs b/src/CommonRuntime/StructuralInference.fs index 1a8f43c7c..65cb33fe0 100644 --- a/src/CommonRuntime/StructuralInference.fs +++ b/src/CommonRuntime/StructuralInference.fs @@ -10,49 +10,77 @@ open FSharp.Data.Runtime open FSharp.Data.Runtime.StructuralTypes /// -module internal List = +module internal List = /// Merge two sequences by pairing elements for which /// the specified predicate returns the same key /// /// (If the inputs contain the same keys, then the order /// of the elements is preserved.) - let internal pairBy f first second = - let vals1 = [ for o in first -> f o, o ] - let vals2 = [ for o in second -> f o, o ] - let d1, d2 = dict vals1, dict vals2 - 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)) ] - + let internal pairBy f first second = + let vals1 = [ for o in first -> f o, o ] + let vals2 = [ for o in second -> f o, o ] + let d1, d2 = dict vals1, dict vals2 + 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)) ] + // ------------------------------------------------------------------------------------------------ -let private numericTypes = [ typeof; typeof; typeof; typeof; typeof; typeof] +let private numericTypes = + [ typeof + typeof + typeof + typeof + typeof + typeof ] /// List of primitive types that can be returned as a result of the inference -let private primitiveTypes = [typeof; typeof; typeof; typeof; typeof; typeof; typeof] @ numericTypes +let private primitiveTypes = + [ typeof + typeof + typeof + typeof + typeof + typeof + typeof ] + @ numericTypes /// Checks whether a type supports unit of measure -let supportsUnitsOfMeasure typ = - List.exists ((=) typ) numericTypes +let supportsUnitsOfMeasure typ = List.exists ((=) typ) numericTypes -/// Returns a tag of a type - a tag represents a 'kind' of type +/// Returns a tag of a type - a tag represents a 'kind' of type /// (essentially it describes the different bottom types we have) -let typeTag = function - | InferedType.Record(name = n)-> InferedTypeTag.Record n - | InferedType.Collection _ -> InferedTypeTag.Collection - | InferedType.Null | InferedType.Top -> InferedTypeTag.Null - | InferedType.Heterogeneous _ -> InferedTypeTag.Heterogeneous - | InferedType.Primitive(typ = typ) -> - if typ = typeof || List.exists ((=) typ) numericTypes then InferedTypeTag.Number - elif typ = typeof then InferedTypeTag.Boolean - elif typ = typeof then InferedTypeTag.String - elif typ = typeof || typ = typeof then InferedTypeTag.DateTime - elif typ = typeof then InferedTypeTag.TimeSpan - elif typ = typeof then InferedTypeTag.Guid - else failwith "typeTag: Unknown primitive type" - | InferedType.Json _ -> InferedTypeTag.Json +let typeTag = + function + | InferedType.Record (name = n) -> InferedTypeTag.Record n + | InferedType.Collection _ -> InferedTypeTag.Collection + | InferedType.Null + | InferedType.Top -> InferedTypeTag.Null + | InferedType.Heterogeneous _ -> InferedTypeTag.Heterogeneous + | InferedType.Primitive (typ = typ) -> + if typ = typeof + || List.exists ((=) typ) numericTypes then + InferedTypeTag.Number + elif typ = typeof then + InferedTypeTag.Boolean + elif typ = typeof then + InferedTypeTag.String + elif typ = typeof + || typ = typeof then + InferedTypeTag.DateTime + elif typ = typeof then + InferedTypeTag.TimeSpan + elif typ = typeof then + InferedTypeTag.Guid + else + failwith "typeTag: Unknown primitive type" + | InferedType.Json _ -> InferedTypeTag.Json /// Find common subtype of two primitive types or `Bottom` if there is no such type. /// The numeric types are ordered as below, other types are not related in any way. @@ -66,47 +94,82 @@ let typeTag = function /// are also `decimal` (and `float`) values, but not the other way round. let private conversionTable = - [ typeof, [ typeof; typeof] - typeof, [ typeof; typeof; typeof] - typeof, [ typeof; typeof; typeof] - typeof, [ typeof; typeof; typeof; typeof] - typeof, [ typeof; typeof; typeof; typeof; typeof] - typeof, [ typeof; typeof; typeof; typeof; typeof; typeof] - typeof, [ typeof ] ] - -let private subtypePrimitives typ1 typ2 = - Debug.Assert(List.exists ((=) typ1) primitiveTypes) - Debug.Assert(List.exists ((=) typ2) primitiveTypes) - - let convertibleTo typ source = - typ = source || - conversionTable |> List.find (fst >> (=) typ) |> snd |> List.exists ((=) source) - - // If both types are the same, then that's good - if typ1 = typ2 then Some typ1 - else - // try to find the smaller type that both types are convertible to - conversionTable - |> List.map fst - |> List.tryPick (fun superType -> - if convertibleTo superType typ1 && convertibleTo superType typ2 - then Some superType - else None) + [ typeof, [ typeof; typeof ] + typeof, + [ typeof + typeof + typeof ] + typeof, + [ typeof + typeof + typeof ] + typeof, + [ typeof + typeof + typeof + typeof ] + typeof, + [ typeof + typeof + typeof + typeof + typeof ] + typeof, + [ typeof + typeof + typeof + typeof + typeof + typeof ] + typeof, [ typeof ] ] + +let private subtypePrimitives typ1 typ2 = + Debug.Assert(List.exists ((=) typ1) primitiveTypes) + Debug.Assert(List.exists ((=) typ2) primitiveTypes) + + let convertibleTo typ source = + typ = source + || conversionTable + |> List.find (fst >> (=) typ) + |> snd + |> List.exists ((=) source) + + // If both types are the same, then that's good + if typ1 = typ2 then + Some typ1 + else + // try to find the smaller type that both types are convertible to + conversionTable + |> List.map fst + |> List.tryPick (fun superType -> + if convertibleTo superType typ1 + && convertibleTo superType typ2 then + Some superType + else + None) /// Active pattern that calls `subtypePrimitives` on two primitive types -let private (|SubtypePrimitives|_|) allowEmptyValues = function - | InferedType.Primitive(t1, u1, o1), InferedType.Primitive(t2, u2, o2) -> - // Re-annotate with the unit, if it is the same one - match subtypePrimitives t1 t2 with - | Some t -> - let unit = if u1 = u2 then u1 else None - let optional = (o1 || o2) && not (allowEmptyValues && InferedType.CanHaveEmptyValues t) - Some (t, unit, optional) - | _ -> None - | _ -> None +let private (|SubtypePrimitives|_|) allowEmptyValues = + function + | InferedType.Primitive (t1, u1, o1), InferedType.Primitive (t2, u2, o2) -> + // Re-annotate with the unit, if it is the same one + match subtypePrimitives t1 t2 with + | Some t -> + let unit = if u1 = u2 then u1 else None + + let optional = + (o1 || o2) + && not ( + allowEmptyValues + && InferedType.CanHaveEmptyValues t + ) + + Some(t, unit, optional) + | _ -> None + | _ -> None /// Find common subtype of two infered types: -/// +/// /// * If the types are both primitive, then we find common subtype of the primitive types /// * If the types are both records, then we union their fields (and mark some as optional) /// * If the types are both collections, then we take subtype of their elements @@ -117,161 +180,181 @@ let private (|SubtypePrimitives|_|) allowEmptyValues = function /// Otherwise, we return bottom. /// /// The contract that should hold about the function is that given two types with the -/// same `InferedTypeTag`, the result also has the same `InferedTypeTag`. +/// same `InferedTypeTag`, the result also has the same `InferedTypeTag`. /// let rec subtypeInfered allowEmptyValues ot1 ot2 = - match ot1, ot2 with - // Subtype of matching types or one of equal types - | SubtypePrimitives allowEmptyValues t -> InferedType.Primitive t - | InferedType.Record(n1, t1, o1), InferedType.Record(n2, t2, o2) when n1 = n2 -> 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.Collection(o1, t1), InferedType.Collection(o2, t2) -> InferedType.Collection(unionCollectionOrder o1 o2, unionCollectionTypes allowEmptyValues t1 t2) - - // Top type can be merged with anything else - | t, InferedType.Top | InferedType.Top, t -> t - // 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 -> - // Add the other type as another option. We should never add - // heterogenous type as an option of other heterogeneous type. - assert (typeTag other <> InferedTypeTag.Heterogeneous) - InferedType.Heterogeneous(unionHeterogeneousTypes allowEmptyValues h (Map.ofSeq [typeTag other, other])) - - // 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) + match ot1, ot2 with + // Subtype of matching types or one of equal types + | SubtypePrimitives allowEmptyValues t -> InferedType.Primitive t + | InferedType.Record (n1, t1, o1), InferedType.Record (n2, t2, o2) when n1 = n2 -> + 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.Collection (o1, t1), InferedType.Collection (o2, t2) -> + InferedType.Collection(unionCollectionOrder o1 o2, unionCollectionTypes allowEmptyValues t1 t2) + + // Top type can be merged with anything else + | t, InferedType.Top + | InferedType.Top, t -> t + // 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 -> + // Add the other type as another option. We should never add + // heterogenous type as an option of other heterogeneous type. + assert (typeTag other <> InferedTypeTag.Heterogeneous) + InferedType.Heterogeneous(unionHeterogeneousTypes allowEmptyValues h (Map.ofSeq [ typeTag other, other ])) + + // 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) /// 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 = - 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, Some (KeyValue(_, t1)), Some (KeyValue(_, t2)) -> - tag, (subtypeInfered allowEmptyValues t1 t2).DropOptionality() - | _ -> failwith "unionHeterogeneousTypes: pairBy returned None, None") - |> Map.ofList - -/// A collection can contain multiple types - in that case, we do keep + 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, Some (KeyValue (_, t1)), Some (KeyValue (_, t2)) -> + tag, (subtypeInfered allowEmptyValues t1 t2).DropOptionality() + | _ -> failwith "unionHeterogeneousTypes: pairBy returned None, None") + |> Map.ofList + +/// A collection can contain multiple types - in that case, we do keep /// the multiplicity for each different type tag to generate better types -/// (this is essentially the same as `unionHeterogeneousTypes`, but +/// (this is essentially the same as `unionHeterogeneousTypes`, but /// it also handles the multiplicity) -and private unionCollectionTypes allowEmptyValues cases1 cases2 = - List.pairBy (fun (KeyValue(k, _)) -> k) cases1 cases2 - |> List.map (fun (tag, fst, snd) -> - match tag, fst, snd with - | tag, Some (KeyValue(_, (m, t))), None - | tag, None, Some (KeyValue(_, (m, t))) -> - // If one collection contains something exactly once - // but the other does not contain it, then it is optional - let m = if m = Single then OptionalSingle else m - let t = if m <> Single then t.DropOptionality() else t - tag, (m, t) - | tag, Some (KeyValue(_, (m1, t1))), Some (KeyValue(_, (m2, t2))) -> - let m = - match m1, m2 with - | Multiple, _ | _, Multiple -> Multiple - | OptionalSingle, _ | _, OptionalSingle -> OptionalSingle - | Single, Single -> Single - 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 +and private unionCollectionTypes allowEmptyValues cases1 cases2 = + List.pairBy (fun (KeyValue (k, _)) -> k) cases1 cases2 + |> List.map (fun (tag, fst, snd) -> + match tag, fst, snd with + | tag, Some (KeyValue (_, (m, t))), None + | tag, None, Some (KeyValue (_, (m, t))) -> + // If one collection contains something exactly once + // but the other does not contain it, then it is optional + let m = if m = Single then OptionalSingle else m + let t = if m <> Single then t.DropOptionality() else t + tag, (m, t) + | tag, Some (KeyValue (_, (m1, t1))), Some (KeyValue (_, (m2, t2))) -> + let m = + match m1, m2 with + | Multiple, _ + | _, Multiple -> Multiple + | OptionalSingle, _ + | _, OptionalSingle -> OptionalSingle + | Single, Single -> Single + + 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 and unionCollectionOrder order1 order2 = - order1 @ (order2 |> List.filter (fun x -> not (List.exists ((=) x) order1))) + order1 + @ (order2 + |> List.filter (fun x -> not (List.exists ((=) x) order1))) /// Get the union of record types (merge their properties) /// This matches the corresponding members and marks them as `Optional` /// if one may be missing. It also returns subtype of their types. and unionRecordTypes allowEmptyValues t1 t2 = - List.pairBy (fun (p:InferedProperty) -> p.Name) t1 t2 - |> List.map (fun (name, fst, snd) -> - match fst, snd with - // If one is missing, return the other, but optional - | Some p, None | None, Some p -> { p with Type = subtypeInfered allowEmptyValues p.Type InferedType.Null } - // If both reference the same object, we return one - // (This is needed to support recursive type structures) - | Some p1, Some p2 when Object.ReferenceEquals(p1, p2) -> p1 - // If both are available, we get their subtype - | Some p1, Some p2 -> - { InferedProperty.Name = name - Type = subtypeInfered allowEmptyValues p1.Type p2.Type } - | _ -> failwith "unionRecordTypes: pairBy returned None, None") + List.pairBy (fun (p: InferedProperty) -> p.Name) t1 t2 + |> List.map (fun (name, fst, snd) -> + match fst, snd with + // If one is missing, return the other, but optional + | Some p, None + | None, Some p -> { p with Type = subtypeInfered allowEmptyValues p.Type InferedType.Null } + // If both reference the same object, we return one + // (This is needed to support recursive type structures) + | Some p1, Some p2 when Object.ReferenceEquals(p1, p2) -> p1 + // If both are available, we get their subtype + | Some p1, Some p2 -> + { InferedProperty.Name = name + Type = subtypeInfered allowEmptyValues p1.Type p2.Type } + | _ -> failwith "unionRecordTypes: pairBy returned None, None") /// Infer the type of the collection based on multiple sample types /// (group the types by tag, count their multiplicity) -let inferCollectionType allowEmptyValues types = - let groupedTypes = - types - |> Seq.groupBy typeTag - |> Seq.map (fun (tag, types) -> - let multiple = if Seq.length types > 1 then Multiple else Single - tag, (multiple, Seq.fold (subtypeInfered allowEmptyValues) InferedType.Top types)) - |> Seq.toList - InferedType.Collection (List.map fst groupedTypes, Map.ofList groupedTypes) +let inferCollectionType allowEmptyValues types = + let groupedTypes = + types + |> Seq.groupBy typeTag + |> Seq.map (fun (tag, types) -> + let multiple = if Seq.length types > 1 then Multiple else Single + tag, (multiple, Seq.fold (subtypeInfered allowEmptyValues) InferedType.Top types)) + |> Seq.toList + + InferedType.Collection(List.map fst groupedTypes, Map.ofList groupedTypes) [] module private Helpers = - open System.Text.RegularExpressions + open System.Text.RegularExpressions - let wordRegex = lazy Regex("\\w+", RegexOptions.Compiled) + let wordRegex = lazy Regex("\\w+", RegexOptions.Compiled) - let numberOfNumberGroups value = - wordRegex.Value.Matches value - |> Seq.cast - |> Seq.choose (fun (x:Match) -> TextConversions.AsInteger CultureInfo.InvariantCulture x.Value) - |> Seq.length + let numberOfNumberGroups value = + wordRegex.Value.Matches value + |> Seq.cast + |> Seq.choose (fun (x: Match) -> TextConversions.AsInteger CultureInfo.InvariantCulture x.Value) + |> Seq.length /// Infers the type of a simple string value /// Returns one of null|typeof|typeof|typeof|typeof|typeof|typeof|typeof|typeof|typeof|typeof|typeof -let inferPrimitiveType (cultureInfo:CultureInfo) (value : string) = - - // Helper for calling TextConversions.AsXyz functions - let (|Parse|_|) func value = func cultureInfo value - let (|ParseNoCulture|_|) func value = func value - - let asGuid _ value = TextConversions.AsGuid value - - let getAbbreviatedEraName era = - cultureInfo.DateTimeFormat.GetAbbreviatedEraName(era) - - let isFakeDate (date:DateTime) value = - // If this can be considered a decimal under the invariant culture, - // it's a safer bet to consider it a string than a DateTime - TextConversions.AsDecimal CultureInfo.InvariantCulture value |> Option.isSome - || - // Prevent stuff like 12-002 being considered a date - date.Year < 1000 && numberOfNumberGroups value <> 3 - || - // Prevent stuff like ad3mar being considered a date - cultureInfo.Calendar.Eras |> Array.exists (fun era -> value.IndexOf(cultureInfo.DateTimeFormat.GetEraName(era), StringComparison.OrdinalIgnoreCase) >= 0 || - 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 +let inferPrimitiveType (cultureInfo: CultureInfo) (value: string) = + + // Helper for calling TextConversions.AsXyz functions + let (|Parse|_|) func value = func cultureInfo value + let (|ParseNoCulture|_|) func value = func value + + let asGuid _ value = TextConversions.AsGuid value + + let getAbbreviatedEraName era = + cultureInfo.DateTimeFormat.GetAbbreviatedEraName(era) + + let isFakeDate (date: DateTime) value = + // If this can be considered a decimal under the invariant culture, + // it's a safer bet to consider it a string than a DateTime + TextConversions.AsDecimal CultureInfo.InvariantCulture value + |> Option.isSome + || + // Prevent stuff like 12-002 being considered a date + date.Year < 1000 + && numberOfNumberGroups value <> 3 + || + // Prevent stuff like ad3mar being considered a date + cultureInfo.Calendar.Eras + |> Array.exists (fun era -> + value.IndexOf(cultureInfo.DateTimeFormat.GetEraName(era), StringComparison.OrdinalIgnoreCase) + >= 0 + || 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 = @@ -280,35 +363,37 @@ let getInferedTypeFromString cultureInfo value unit = | 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 + 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 = +let defaultUnitsOfMeasureProvider = { new IUnitsOfMeasureProvider with - member x.SI(_): Type = null + 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 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 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 baseUnitStr = str.[.. str.Length - suffix.Length - 1] let baseUnit = provider.SI baseUnitStr - if baseUnit = null then - None - else + + if baseUnit = null then + None + else baseUnit |> trans provider |> Some else None) + match unit with | Some _ -> unit | None -> diff --git a/src/CommonRuntime/StructuralTypes.fs b/src/CommonRuntime/StructuralTypes.fs index 6d2d7a2ff..733560bf1 100644 --- a/src/CommonRuntime/StructuralTypes.fs +++ b/src/CommonRuntime/StructuralTypes.fs @@ -12,45 +12,45 @@ open FSharp.Data.Runtime /// Types that represent the result of static type inference. /// type InferedProperty = - { Name : string - mutable Type : InferedType } - override x.ToString() = sprintf "%A" x + { Name: string + mutable Type: InferedType } + override x.ToString() = sprintf "%A" x /// For heterogeneous types (types that have multiple possible forms /// such as differently named XML nodes or records and arrays mixed together) /// this type represents the number of occurrences of individual forms -type InferedMultiplicity = - | Single - | OptionalSingle - | Multiple +type InferedMultiplicity = + | Single + | OptionalSingle + | Multiple /// For heterogeneous types, this represents the tag that defines the form /// (that is either primitive type, collection, named record etc.) [] -type InferedTypeTag = - // Unknown type - | Null - // Primitive types - | Number - | Boolean - | String - | Json - | DateTime - | TimeSpan - | DateTimeOffset - | Guid - // Collections and sum types - | Collection - | Heterogeneous - // Possibly named record - | Record of string option +type InferedTypeTag = + // Unknown type + | Null + // Primitive types + | Number + | Boolean + | String + | Json + | DateTime + | TimeSpan + | DateTimeOffset + | Guid + // Collections and sum types + | Collection + | Heterogeneous + // Possibly named record + | Record of string option /// Represents inferred structural type. A type may be either primitive type -/// (one of those listed by `primitiveTypes`) or it can be collection, +/// (one of those listed by `primitiveTypes`) or it can be collection, /// (named) record and heterogeneous type. We also have `Null` type (which is /// a subtype of all non-primitive types) and universal `Top` type. /// -/// * For collection, we infer the types of different things that appear in +/// * For collection, we infer the types of different things that appear in /// the collection and how many times they do. /// /// * A heterogeneous type (sum type) is simply a choice containing one @@ -61,106 +61,121 @@ type InferedTypeTag = /// to generate nicer types! [] type InferedType = - | Primitive of typ:Type * unit:option * optional: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 - | Null - | Top - - member x.IsOptional = - match x with - | Primitive(optional = true) | Record(optional = true) | Json(optional = true) -> true - | _ -> false - - static member CanHaveEmptyValues typ = - typ = typeof || typ = typeof - - /// When allowEmptyValues is true, we allow "" and double.NaN, otherwise - /// we make the type optional and use None instead. - /// It's currently only true in CsvProvider when PreferOptionals is set to false - member x.EnsuresHandlesMissingValues allowEmptyValues = - match x with - | Null | Heterogeneous _ | Primitive(optional = true) | Record(optional = true) | Json(optional = true) -> x - | Primitive(typ, _, false) when allowEmptyValues && InferedType.CanHaveEmptyValues typ -> x - | Primitive(typ, unit, false) -> Primitive(typ, unit, true) - | Record(name, props, false) -> Record(name, props, true) - | Json(typ, false) -> Json(typ, true) - | Collection (order, 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() = - 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 - - // We need to implement custom equality that returns 'true' when - // values reference the same object (to support recursive types) - override x.GetHashCode() = -1 - - override x.Equals(y:obj) = - 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 - | 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 - | Null, Null | Top, Top -> true - | _ -> false - else false - - override x.ToString() = sprintf "%A" x + | Primitive of typ: Type * unit: option * optional: 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 + | Null + | Top + + member x.IsOptional = + match x with + | Primitive(optional = true) + | Record(optional = true) + | Json(optional = true) -> true + | _ -> false + + static member CanHaveEmptyValues typ = + typ = typeof || typ = typeof + + /// When allowEmptyValues is true, we allow "" and double.NaN, otherwise + /// we make the type optional and use None instead. + /// It's currently only true in CsvProvider when PreferOptionals is set to false + member x.EnsuresHandlesMissingValues allowEmptyValues = + match x with + | Null + | Heterogeneous _ + | Primitive(optional = true) + | Record(optional = true) + | Json(optional = true) -> x + | Primitive (typ, _, false) when + allowEmptyValues + && InferedType.CanHaveEmptyValues typ + -> + x + | Primitive (typ, unit, false) -> Primitive(typ, unit, true) + | Record (name, props, false) -> Record(name, props, true) + | Json (typ, false) -> Json(typ, true) + | Collection (order, 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() = + 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 + + // We need to implement custom equality that returns 'true' when + // values reference the same object (to support recursive types) + override x.GetHashCode() = -1 + + override x.Equals(y: obj) = + 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 + | 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 + | Null, Null + | Top, Top -> true + | _ -> false + else + false + + override x.ToString() = sprintf "%A" x // ------------------------------------------------------------------------------------------------ // Additional operations for working with the inferred representation type InferedTypeTag with - member x.NiceName = - match x with - | Null -> failwith "Null nodes should be skipped" - | Number -> "Number" - | Boolean -> "Boolean" - | String -> "String" - | DateTime -> "DateTime" - | TimeSpan -> "TimeSpan" - | DateTimeOffset -> "DateTimeOffset" - | Guid -> "Guid" - | Collection -> "Array" - | Heterogeneous -> "Choice" - | Record None -> "Record" - | Record (Some name) -> NameUtils.nicePascalName name - | Json _ -> "Json" - - /// Converts tag to string code that can be passed to generated code - member x.Code = - match x with - | Record (Some name) -> "Record@" + name - | _ -> x.NiceName - - /// Parses code returned by 'Code' member (to be used in provided code) - static member ParseCode(str:string) = - match str with - | s when s.StartsWith("Record@") -> Record(Some(s.Substring("Record@".Length))) - | "Record" -> Record None - | "Json" -> Json - | "Number" -> Number - | "Boolean" -> Boolean - | "String" -> String - | "DateTime" -> DateTime - | "TimeSpan" -> TimeSpan - | "DateTimeOffset" -> DateTimeOffset - | "Guid" -> Guid - | "Array" -> Collection - | "Choice" -> Heterogeneous - | "Null" -> failwith "Null nodes should be skipped" - | _ -> failwith "Invalid InferredTypeTag code" + member x.NiceName = + match x with + | Null -> failwith "Null nodes should be skipped" + | Number -> "Number" + | Boolean -> "Boolean" + | String -> "String" + | DateTime -> "DateTime" + | TimeSpan -> "TimeSpan" + | DateTimeOffset -> "DateTimeOffset" + | Guid -> "Guid" + | Collection -> "Array" + | Heterogeneous -> "Choice" + | Record None -> "Record" + | Record (Some name) -> NameUtils.nicePascalName name + | Json _ -> "Json" + + /// Converts tag to string code that can be passed to generated code + member x.Code = + match x with + | Record (Some name) -> "Record@" + name + | _ -> x.NiceName + + /// Parses code returned by 'Code' member (to be used in provided code) + static member ParseCode(str: string) = + match str with + | s when s.StartsWith("Record@") -> Record(Some(s.Substring("Record@".Length))) + | "Record" -> Record None + | "Json" -> Json + | "Number" -> Number + | "Boolean" -> Boolean + | "String" -> String + | "DateTime" -> DateTime + | "TimeSpan" -> TimeSpan + | "DateTimeOffset" -> DateTimeOffset + | "Guid" -> Guid + | "Array" -> Collection + | "Choice" -> Heterogeneous + | "Null" -> failwith "Null nodes should be skipped" + | _ -> failwith "Invalid InferredTypeTag code" /// Dummy type to represent that only "0" was found. /// Will be generated as 'int', unless it's converted to Bit. @@ -180,30 +195,35 @@ type Bit = Bit /// This type captures the type, unit of measure and handling of missing values (if we /// infer that the value may be missing, we can generate option or nullable) type PrimitiveInferedProperty = - { Name : string - InferedType : Type - RuntimeType : Type - UnitOfMeasure : Type option - TypeWrapper : TypeWrapper } - static member Create(name, typ, typWrapper, unit) = - let runtimeTyp = - if typ = typeof then typeof - elif typ = typeof || typ = typeof then typeof - else typ - { Name = name - InferedType = typ - RuntimeType = runtimeTyp - UnitOfMeasure = unit - TypeWrapper = typWrapper } - static member Create(name, typ, optional, unit) = - PrimitiveInferedProperty.Create(name, typ, (if optional then TypeWrapper.Option else TypeWrapper.None), unit) + { Name: string + InferedType: Type + RuntimeType: Type + UnitOfMeasure: Type option + TypeWrapper: TypeWrapper } + static member Create(name, typ, typWrapper, unit) = + let runtimeTyp = + if typ = typeof then + typeof + elif typ = typeof || typ = typeof then + typeof + else + typ + + { Name = name + InferedType = typ + RuntimeType = runtimeTyp + UnitOfMeasure = unit + TypeWrapper = typWrapper } + + static member Create(name, typ, optional, unit) = + PrimitiveInferedProperty.Create(name, typ, (if optional then TypeWrapper.Option else TypeWrapper.None), unit) /// Represents a transformation of a type [] -type TypeWrapper = +type TypeWrapper = /// No transformation will be made to the type - | None + | None /// The type T will be converter to type T option - | Option + | Option /// The type T will be converter to type Nullable | Nullable diff --git a/src/CommonRuntime/TextConversions.fs b/src/CommonRuntime/TextConversions.fs index 205bc8cc1..c4c68dde3 100644 --- a/src/CommonRuntime/TextConversions.fs +++ b/src/CommonRuntime/TextConversions.fs @@ -13,133 +13,197 @@ open System.Text.RegularExpressions [] module private Helpers = - /// Convert the result of TryParse to option type - let asOption = function true, v -> Some v | _ -> None - - let (|StringEqualsIgnoreCase|_|) (s1:string) s2 = - if s1.Equals(s2, StringComparison.OrdinalIgnoreCase) - then Some () else None - - let (|OneOfIgnoreCase|_|) set str = - if Array.exists (fun s -> StringComparer.OrdinalIgnoreCase.Compare(s, str) = 0) set then Some() else None - - // note on the regex we have /Date()/ and not \/Date()\/ because the \/ escaping - // is already taken care of before AsDateTime is called - let msDateRegex = lazy Regex(@"^/Date\((-?\d+)([-+]\d+)?\)/$", RegexOptions.Compiled) - - let dateTimeStyles = DateTimeStyles.AllowWhiteSpaces ||| DateTimeStyles.RoundtripKind - - let ParseISO8601FormattedDateTime text cultureInfo = - match DateTime.TryParse(text, cultureInfo, dateTimeStyles) with - | true, d -> d |> Some - | false, _ -> None + /// Convert the result of TryParse to option type + let asOption = + function + | true, v -> Some v + | _ -> None + + let (|StringEqualsIgnoreCase|_|) (s1: string) s2 = + if s1.Equals(s2, StringComparison.OrdinalIgnoreCase) then + Some() + else + None + + let (|OneOfIgnoreCase|_|) set str = + if Array.exists (fun s -> StringComparer.OrdinalIgnoreCase.Compare(s, str) = 0) set then + Some() + else + None + + // note on the regex we have /Date()/ and not \/Date()\/ because the \/ escaping + // is already taken care of before AsDateTime is called + let msDateRegex = + lazy Regex(@"^/Date\((-?\d+)([-+]\d+)?\)/$", RegexOptions.Compiled) + + let dateTimeStyles = + DateTimeStyles.AllowWhiteSpaces + ||| DateTimeStyles.RoundtripKind + + let ParseISO8601FormattedDateTime text cultureInfo = + match DateTime.TryParse(text, cultureInfo, dateTimeStyles) with + | true, d -> d |> Some + | false, _ -> None // -------------------------------------------------------------------------------------- /// Conversions from string to string/int/int64/decimal/float/boolean/datetime/timespan/guid options -type TextConversions private() = - - /// `NaN` `NA` `N/A` `#N/A` `:` `-` `TBA` `TBD` - static member val DefaultMissingValues = [| "NaN"; "NA"; "N/A"; "#N/A"; ":"; "-"; "TBA"; "TBD" |] - - /// `%` `‰` `‱` - static member val DefaultNonCurrencyAdorners = [| '%'; '‰'; '‱' |] |> Set.ofArray - - /// `¤` `$` `¢` `£` `Â¥` `₱` `ï·¼` `₤` `â‚­` `₦` `₨` `â‚©` `â‚®` `€` `฿` `â‚¡` `៛` `Ø‹` `â‚´` `₪` `â‚«` `₹` `Æ’` - static member val DefaultCurrencyAdorners = [| '¤'; '$'; '¢'; '£'; 'Â¥'; '₱'; 'ï·¼'; '₤'; 'â‚­'; '₦'; '₨'; 'â‚©'; 'â‚®'; '€'; '฿'; 'â‚¡'; '៛'; 'Ø‹'; 'â‚´'; '₪'; 'â‚«'; '₹'; 'Æ’' |] |> Set.ofArray - - static member val private DefaultRemovableAdornerCharacters = - Set.union TextConversions.DefaultNonCurrencyAdorners TextConversions.DefaultCurrencyAdorners - - //This removes any adorners that might otherwise casue the inference to infer string. A notable a change is - //Currency Symbols are now treated as an Adorner like a '%' sign thus are now independant - //of the culture. Which is probably better since we have lots of scenarios where we want to - //consume values prefixed with € or $ but in a different culture. - static member private RemoveAdorners (value:string) = - String(value.ToCharArray() |> Array.filter (not << TextConversions.DefaultRemovableAdornerCharacters.Contains)) - - /// Turns empty or null string value into None, otherwise returns Some - static member AsString str = - if String.IsNullOrWhiteSpace str then None else Some str - - static member AsInteger cultureInfo text = - Int32.TryParse(TextConversions.RemoveAdorners text, NumberStyles.Integer, cultureInfo) |> asOption - - static member AsInteger64 cultureInfo text = - Int64.TryParse(TextConversions.RemoveAdorners text, NumberStyles.Integer, cultureInfo) |> asOption - - static member AsDecimal cultureInfo text = - Decimal.TryParse(TextConversions.RemoveAdorners text, NumberStyles.Currency, cultureInfo) |> asOption - - /// if useNoneForMissingValues is true, NAs are returned as None, otherwise Some Double.NaN is used - static member AsFloat missingValues useNoneForMissingValues cultureInfo (text:string) = - match text.Trim() with - | OneOfIgnoreCase missingValues -> if useNoneForMissingValues then None else Some Double.NaN - | _ -> Double.TryParse(text, NumberStyles.Any, cultureInfo) - |> asOption - |> Option.bind (fun f -> if useNoneForMissingValues && Double.IsNaN f then None else Some f) - - static member AsBoolean (text:string) = - match text.Trim() with - | StringEqualsIgnoreCase "true" | StringEqualsIgnoreCase "yes" | StringEqualsIgnoreCase "1" -> Some true - | StringEqualsIgnoreCase "false" | StringEqualsIgnoreCase "no" | StringEqualsIgnoreCase "0" -> Some false - | _ -> None - - /// Parse date time using either the JSON milliseconds format or using ISO 8601 - /// that is, either `/Date()/` or something - /// along the lines of `2013-01-28T00:37Z` - static member AsDateTime cultureInfo (text:string) = - // Try parse "Date()" style format - let matchesMS = msDateRegex.Value.Match (text.Trim()) - if matchesMS.Success then - matchesMS.Groups.[1].Value - |> Double.Parse - |> DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc).AddMilliseconds - |> Some - else - // Parse ISO 8601 format, fixing time zone if needed - match ParseISO8601FormattedDateTime text cultureInfo with - | Some d when d.Kind = DateTimeKind.Unspecified -> new DateTime(d.Ticks, DateTimeKind.Local) |> Some - | x -> x - - static member AsDateTimeOffset cultureInfo (text:string) = - // get TimeSpan presentation from 4-digt integers like 0000 or -0600 - let getTimeSpanFromHourMin (hourMin:int) = - let hr = (hourMin/100) |> float |> TimeSpan.FromHours - let min = (hourMin%100) |> float |> TimeSpan.FromMinutes - hr.Add min - - let offset str = - match Int32.TryParse str with - | true, v -> getTimeSpanFromHourMin v |> Some - | false, _ -> None - - let matchesMS = msDateRegex.Value.Match (text.Trim()) - if matchesMS.Success && matchesMS.Groups.[2].Success && matchesMS.Groups.[2].Value.Length = 5 then - // only if the timezone offset is specified with '-' or '+' prefix, after the millis - // e.g. 1231456+1000, 123123+0000, 123123-0500, etc. - match offset matchesMS.Groups.[2].Value with - | Some ofst -> - matchesMS.Groups.[1].Value - |> Double.Parse - |> DateTimeOffset(1970, 1, 1, 0, 0, 0, ofst).AddMilliseconds - |> Some - | None -> None - else - match ParseISO8601FormattedDateTime text cultureInfo with - | Some d when d.Kind <> DateTimeKind.Unspecified -> - match DateTimeOffset.TryParse(text, cultureInfo, dateTimeStyles) with - | true, dto -> dto |> Some - | false, _ -> None - | _ -> None - - static member AsTimeSpan (cultureInfo: CultureInfo) (text:string) = - match TimeSpan.TryParse(text, cultureInfo) with - | true, t -> Some t - | _ -> None - - static member AsGuid (text:string) = - Guid.TryParse(text.Trim()) |> asOption +type TextConversions private () = + + /// `NaN` `NA` `N/A` `#N/A` `:` `-` `TBA` `TBD` + static member val DefaultMissingValues = + [| "NaN" + "NA" + "N/A" + "#N/A" + ":" + "-" + "TBA" + "TBD" |] + + /// `%` `‰` `‱` + static member val DefaultNonCurrencyAdorners = [| '%'; '‰'; '‱' |] |> Set.ofArray + + /// `¤` `$` `¢` `£` `Â¥` `₱` `ï·¼` `₤` `â‚­` `₦` `₨` `â‚©` `â‚®` `€` `฿` `â‚¡` `៛` `Ø‹` `â‚´` `₪` `â‚«` `₹` `Æ’` + static member val DefaultCurrencyAdorners = + [| '¤' + '$' + '¢' + '£' + 'Â¥' + '₱' + 'ï·¼' + '₤' + 'â‚­' + '₦' + '₨' + 'â‚©' + 'â‚®' + '€' + '฿' + 'â‚¡' + '៛' + 'Ø‹' + 'â‚´' + '₪' + 'â‚«' + '₹' + 'Æ’' |] + |> Set.ofArray + + static member val private DefaultRemovableAdornerCharacters = + Set.union TextConversions.DefaultNonCurrencyAdorners TextConversions.DefaultCurrencyAdorners + + //This removes any adorners that might otherwise casue the inference to infer string. A notable a change is + //Currency Symbols are now treated as an Adorner like a '%' sign thus are now independant + //of the culture. Which is probably better since we have lots of scenarios where we want to + //consume values prefixed with € or $ but in a different culture. + static member private RemoveAdorners(value: string) = + String( + value.ToCharArray() + |> Array.filter ( + not + << TextConversions.DefaultRemovableAdornerCharacters.Contains + ) + ) + + /// Turns empty or null string value into None, otherwise returns Some + static member AsString str = + if String.IsNullOrWhiteSpace str then None else Some str + + static member AsInteger cultureInfo text = + Int32.TryParse(TextConversions.RemoveAdorners text, NumberStyles.Integer, cultureInfo) + |> asOption + + static member AsInteger64 cultureInfo text = + Int64.TryParse(TextConversions.RemoveAdorners text, NumberStyles.Integer, cultureInfo) + |> asOption + + static member AsDecimal cultureInfo text = + Decimal.TryParse(TextConversions.RemoveAdorners text, NumberStyles.Currency, cultureInfo) + |> asOption + + /// if useNoneForMissingValues is true, NAs are returned as None, otherwise Some Double.NaN is used + static member AsFloat missingValues useNoneForMissingValues cultureInfo (text: string) = + match text.Trim() with + | OneOfIgnoreCase missingValues -> if useNoneForMissingValues then None else Some Double.NaN + | _ -> + Double.TryParse(text, NumberStyles.Any, cultureInfo) + |> asOption + |> Option.bind (fun f -> + if useNoneForMissingValues && Double.IsNaN f then + None + else + Some f) + + static member AsBoolean(text: string) = + match text.Trim() with + | StringEqualsIgnoreCase "true" + | StringEqualsIgnoreCase "yes" + | StringEqualsIgnoreCase "1" -> Some true + | StringEqualsIgnoreCase "false" + | StringEqualsIgnoreCase "no" + | StringEqualsIgnoreCase "0" -> Some false + | _ -> None + + /// Parse date time using either the JSON milliseconds format or using ISO 8601 + /// that is, either `/Date()/` or something + /// along the lines of `2013-01-28T00:37Z` + static member AsDateTime cultureInfo (text: string) = + // Try parse "Date()" style format + let matchesMS = msDateRegex.Value.Match(text.Trim()) + + if matchesMS.Success then + matchesMS.Groups.[1].Value + |> Double.Parse + |> DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc).AddMilliseconds + |> Some + else + // Parse ISO 8601 format, fixing time zone if needed + match ParseISO8601FormattedDateTime text cultureInfo with + | Some d when d.Kind = DateTimeKind.Unspecified -> new DateTime(d.Ticks, DateTimeKind.Local) |> Some + | x -> x + + static member AsDateTimeOffset cultureInfo (text: string) = + // get TimeSpan presentation from 4-digt integers like 0000 or -0600 + let getTimeSpanFromHourMin (hourMin: int) = + let hr = (hourMin / 100) |> float |> TimeSpan.FromHours + let min = (hourMin % 100) |> float |> TimeSpan.FromMinutes + hr.Add min + + let offset str = + match Int32.TryParse str with + | true, v -> getTimeSpanFromHourMin v |> Some + | false, _ -> None + + let matchesMS = msDateRegex.Value.Match(text.Trim()) + + if matchesMS.Success + && matchesMS.Groups.[2].Success + && matchesMS.Groups.[2].Value.Length = 5 then + // only if the timezone offset is specified with '-' or '+' prefix, after the millis + // e.g. 1231456+1000, 123123+0000, 123123-0500, etc. + match offset matchesMS.Groups.[2].Value with + | Some ofst -> + matchesMS.Groups.[1].Value + |> Double.Parse + |> DateTimeOffset(1970, 1, 1, 0, 0, 0, ofst).AddMilliseconds + |> Some + | None -> None + else + match ParseISO8601FormattedDateTime text cultureInfo with + | Some d when d.Kind <> DateTimeKind.Unspecified -> + match DateTimeOffset.TryParse(text, cultureInfo, dateTimeStyles) with + | true, dto -> dto |> Some + | false, _ -> None + | _ -> None + + static member AsTimeSpan (cultureInfo: CultureInfo) (text: string) = + match TimeSpan.TryParse(text, cultureInfo) with + | true, t -> Some t + | _ -> None + + static member AsGuid(text: string) = Guid.TryParse(text.Trim()) |> asOption module internal UnicodeHelper = @@ -148,8 +212,8 @@ module internal UnicodeHelper = // only code points U+010000 to U+10FFFF supported // for coversion to UTF16 surrogate pair let codePoint = num - 0x010000u - let HIGH_TEN_BIT_MASK = 0xFFC00u // 1111|1111|1100|0000|0000 - let LOW_TEN_BIT_MASK = 0x003FFu // 0000|0000|0011|1111|1111 + let HIGH_TEN_BIT_MASK = 0xFFC00u // 1111|1111|1100|0000|0000 + let LOW_TEN_BIT_MASK = 0x003FFu // 0000|0000|0011|1111|1111 let leadSurrogate = (codePoint &&& HIGH_TEN_BIT_MASK >>> 10) + 0xD800u let trailSurrogate = (codePoint &&& LOW_TEN_BIT_MASK) + 0xDC00u char leadSurrogate, char trailSurrogate diff --git a/src/CommonRuntime/TextRuntime.fs b/src/CommonRuntime/TextRuntime.fs index 36e3af90f..3d06bc8ff 100644 --- a/src/CommonRuntime/TextRuntime.fs +++ b/src/CommonRuntime/TextRuntime.fs @@ -6,151 +6,168 @@ open FSharp.Data open FSharp.Data.Runtime /// Static helper methods called from the generated code for working with text -type TextRuntime = - - [] - [] - static val mutable private cultureInfoCache : Collections.Generic.Dictionary - - /// Returns CultureInfo matching the specified culture string - /// (or InvariantCulture if the argument is null or empty) - static member GetCulture(cultureStr) = - if String.IsNullOrWhiteSpace cultureStr - then CultureInfo.InvariantCulture - else - let mutable cache = TextRuntime.cultureInfoCache - if cache = null then - cache <- Collections.Generic.Dictionary () - TextRuntime.cultureInfoCache <- cache - match cache.TryGetValue cultureStr with - | true, v -> v - | _ , _ -> - let v = CultureInfo cultureStr - cache.[cultureStr] <- v - v - - static member GetMissingValues(missingValuesStr) = - if String.IsNullOrWhiteSpace missingValuesStr - then TextConversions.DefaultMissingValues - else missingValuesStr.Split([| ',' |], StringSplitOptions.RemoveEmptyEntries) - - // -------------------------------------------------------------------------------------- - // string option -> type - - static member ConvertString(text:string option) = text - - static member ConvertInteger(cultureStr, text) = - text |> Option.bind (TextConversions.AsInteger (TextRuntime.GetCulture cultureStr)) - - static member ConvertInteger64(cultureStr, text) = - text |> Option.bind (TextConversions.AsInteger64 (TextRuntime.GetCulture cultureStr)) - - static member ConvertDecimal(cultureStr, text) = - text |> Option.bind (TextConversions.AsDecimal (TextRuntime.GetCulture cultureStr)) - - static member ConvertFloat(cultureStr, missingValuesStr, text) = - text |> Option.bind (TextConversions.AsFloat (TextRuntime.GetMissingValues missingValuesStr) - true - (TextRuntime.GetCulture cultureStr)) - - static member ConvertBoolean(text) = - text |> Option.bind TextConversions.AsBoolean - - static member ConvertDateTime(cultureStr, text) = - text |> Option.bind (TextConversions.AsDateTime (TextRuntime.GetCulture cultureStr)) - - static member ConvertDateTimeOffset(cultureStr, text) = - text |> Option.bind (TextConversions.AsDateTimeOffset (TextRuntime.GetCulture cultureStr)) - - static member ConvertTimeSpan(cultureStr, text) = - text |> Option.bind (TextConversions.AsTimeSpan (TextRuntime.GetCulture cultureStr)) - - static member ConvertGuid(text) = - text |> Option.bind TextConversions.AsGuid - - // -------------------------------------------------------------------------------------- - // type -> string - - static member ConvertStringBack(value) = defaultArg value "" - - static member ConvertIntegerBack(cultureStr, value:int option) = - match value with - | Some value -> value.ToString(TextRuntime.GetCulture cultureStr) - | None -> "" - - static member ConvertInteger64Back(cultureStr, value:int64 option) = - match value with - | Some value -> value.ToString(TextRuntime.GetCulture cultureStr) - | None -> "" - - static member ConvertDecimalBack(cultureStr, value:decimal option) = - match value with - | Some value -> value.ToString(TextRuntime.GetCulture cultureStr) - | None -> "" - - static member ConvertFloatBack(cultureStr, missingValuesStr, value:float option) = - match value with - | Some value -> - if Double.IsNaN value then - let missingValues = TextRuntime.GetMissingValues missingValuesStr - if missingValues.Length = 0 - then (TextRuntime.GetCulture cultureStr).NumberFormat.NaNSymbol - else missingValues.[0] - else - value.ToString(TextRuntime.GetCulture cultureStr) - | None -> "" - - static member ConvertBooleanBack(value:bool option, use0and1) = - match value with - | Some value when use0and1 -> if value then "1" else "0" - | Some value -> if value then "true" else "false" - | None -> "" - - static member ConvertDateTimeBack(cultureStr, value:DateTime option) = - match value with - | Some value -> value.ToString("O", TextRuntime.GetCulture cultureStr) - | None -> "" - - static member ConvertDateTimeOffsetBack(cultureStr, value:DateTimeOffset option) = - match value with - | Some value -> value.ToString("O", TextRuntime.GetCulture cultureStr) - | None -> "" - - static member ConvertTimeSpanBack(cultureStr, value:TimeSpan option) = - match value with - | Some value -> value.ToString("g", TextRuntime.GetCulture cultureStr) - | None -> "" - - static member ConvertGuidBack(value:Guid option) = - match value with - | Some value -> value.ToString() - | None -> "" - - // -------------------------------------------------------------------------------------- - - /// Operation that extracts the value from an option and reports a meaningful error message when the value is not there - /// For missing strings we return "", and for missing doubles we return NaN - /// For other types an error is thrown - static member GetNonOptionalValue<'T>(name:string, opt:option<'T>, originalValue) : 'T = - match opt, originalValue with - | Some value, _ -> value - | None, _ when typeof<'T> = typeof -> "" |> unbox - | None, _ when typeof<'T> = typeof -> Double.NaN |> unbox - | None, None -> failwithf "%s is missing" name - | None, Some originalValue -> failwithf "Expecting %s in %s, got %s" (typeof<'T>.Name) name originalValue - - /// Turn an F# option type Option<'T> containing a primitive - /// value type into a .NET type Nullable<'T> - static member OptionToNullable opt = - match opt with - | Some v -> Nullable v - | _ -> Nullable() - - /// Turn a .NET type Nullable<'T> to an F# option type Option<'T> - static member NullableToOption (nullable:Nullable<_>) = - if nullable.HasValue then Some nullable.Value else None - - /// Turn a sync operation into an async operation - static member AsyncMap<'T, 'R>(valueAsync:Async<'T>, mapping:Func<'T, 'R>) = - async { let! value = valueAsync in return mapping.Invoke value } +type TextRuntime = + + [] + [] + static val mutable private cultureInfoCache: Collections.Generic.Dictionary + /// Returns CultureInfo matching the specified culture string + /// (or InvariantCulture if the argument is null or empty) + static member GetCulture(cultureStr) = + if String.IsNullOrWhiteSpace cultureStr then + CultureInfo.InvariantCulture + else + let mutable cache = TextRuntime.cultureInfoCache + + if cache = null then + cache <- Collections.Generic.Dictionary() + TextRuntime.cultureInfoCache <- cache + + match cache.TryGetValue cultureStr with + | true, v -> v + | _, _ -> + let v = CultureInfo cultureStr + cache.[cultureStr] <- v + v + + static member GetMissingValues(missingValuesStr) = + if String.IsNullOrWhiteSpace missingValuesStr then + TextConversions.DefaultMissingValues + else + missingValuesStr.Split([| ',' |], StringSplitOptions.RemoveEmptyEntries) + + // -------------------------------------------------------------------------------------- + // string option -> type + + static member ConvertString(text: string option) = text + + static member ConvertInteger(cultureStr, text) = + text + |> Option.bind (TextConversions.AsInteger(TextRuntime.GetCulture cultureStr)) + + static member ConvertInteger64(cultureStr, text) = + text + |> Option.bind (TextConversions.AsInteger64(TextRuntime.GetCulture cultureStr)) + + static member ConvertDecimal(cultureStr, text) = + text + |> Option.bind (TextConversions.AsDecimal(TextRuntime.GetCulture cultureStr)) + + static member ConvertFloat(cultureStr, missingValuesStr, text) = + text + |> Option.bind ( + TextConversions.AsFloat + (TextRuntime.GetMissingValues missingValuesStr) + true + (TextRuntime.GetCulture cultureStr) + ) + + static member ConvertBoolean(text) = + text |> Option.bind TextConversions.AsBoolean + + static member ConvertDateTime(cultureStr, text) = + text + |> Option.bind (TextConversions.AsDateTime(TextRuntime.GetCulture cultureStr)) + + static member ConvertDateTimeOffset(cultureStr, text) = + text + |> Option.bind (TextConversions.AsDateTimeOffset(TextRuntime.GetCulture cultureStr)) + + static member ConvertTimeSpan(cultureStr, text) = + text + |> Option.bind (TextConversions.AsTimeSpan(TextRuntime.GetCulture cultureStr)) + + static member ConvertGuid(text) = + text |> Option.bind TextConversions.AsGuid + + // -------------------------------------------------------------------------------------- + // type -> string + + static member ConvertStringBack(value) = defaultArg value "" + + static member ConvertIntegerBack(cultureStr, value: int option) = + match value with + | Some value -> value.ToString(TextRuntime.GetCulture cultureStr) + | None -> "" + + static member ConvertInteger64Back(cultureStr, value: int64 option) = + match value with + | Some value -> value.ToString(TextRuntime.GetCulture cultureStr) + | None -> "" + + static member ConvertDecimalBack(cultureStr, value: decimal option) = + match value with + | Some value -> value.ToString(TextRuntime.GetCulture cultureStr) + | None -> "" + + static member ConvertFloatBack(cultureStr, missingValuesStr, value: float option) = + match value with + | Some value -> + if Double.IsNaN value then + let missingValues = TextRuntime.GetMissingValues missingValuesStr + + if missingValues.Length = 0 then + (TextRuntime.GetCulture cultureStr).NumberFormat.NaNSymbol + else + missingValues.[0] + else + value.ToString(TextRuntime.GetCulture cultureStr) + | None -> "" + + static member ConvertBooleanBack(value: bool option, use0and1) = + match value with + | Some value when use0and1 -> if value then "1" else "0" + | Some value -> if value then "true" else "false" + | None -> "" + + static member ConvertDateTimeBack(cultureStr, value: DateTime option) = + match value with + | Some value -> value.ToString("O", TextRuntime.GetCulture cultureStr) + | None -> "" + + static member ConvertDateTimeOffsetBack(cultureStr, value: DateTimeOffset option) = + match value with + | Some value -> value.ToString("O", TextRuntime.GetCulture cultureStr) + | None -> "" + + static member ConvertTimeSpanBack(cultureStr, value: TimeSpan option) = + match value with + | Some value -> value.ToString("g", TextRuntime.GetCulture cultureStr) + | None -> "" + + static member ConvertGuidBack(value: Guid option) = + match value with + | Some value -> value.ToString() + | None -> "" + + // -------------------------------------------------------------------------------------- + + /// Operation that extracts the value from an option and reports a meaningful error message when the value is not there + /// For missing strings we return "", and for missing doubles we return NaN + /// For other types an error is thrown + static member GetNonOptionalValue<'T>(name: string, opt: option<'T>, originalValue) : 'T = + match opt, originalValue with + | Some value, _ -> value + | None, _ when typeof<'T> = typeof -> "" |> unbox + | None, _ when typeof<'T> = typeof -> Double.NaN |> unbox + | None, None -> failwithf "%s is missing" name + | None, Some originalValue -> failwithf "Expecting %s in %s, got %s" (typeof<'T>.Name) name originalValue + + /// Turn an F# option type Option<'T> containing a primitive + /// value type into a .NET type Nullable<'T> + static member OptionToNullable opt = + match opt with + | Some v -> Nullable v + | _ -> Nullable() + + /// Turn a .NET type Nullable<'T> to an F# option type Option<'T> + static member NullableToOption(nullable: Nullable<_>) = + if nullable.HasValue then Some nullable.Value else None + + /// Turn a sync operation into an async operation + static member AsyncMap<'T, 'R>(valueAsync: Async<'T>, mapping: Func<'T, 'R>) = + async { + let! value = valueAsync + return mapping.Invoke value + } diff --git a/src/Csv/CsvExtensions.fs b/src/Csv/CsvExtensions.fs index 80edb8088..f1ba590ab 100644 --- a/src/Csv/CsvExtensions.fs +++ b/src/Csv/CsvExtensions.fs @@ -13,71 +13,78 @@ open FSharp.Data.Runtime [] type StringExtensions = - [] - static member AsInteger(x:String, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match TextConversions.AsInteger cultureInfo x with - | Some i -> i - | _ -> failwithf "Not an int: %s" x - - [] - static member AsInteger64(x:String, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match TextConversions.AsInteger64 cultureInfo x with - | Some i -> i - | _ -> failwithf "Not an int64: %s" x - - [] - static member AsDecimal(x:String, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match TextConversions.AsDecimal cultureInfo x with - | Some d -> d - | _ -> failwithf "Not a decimal: %s" x - - [] - static member AsFloat(x:String, [] ?cultureInfo, [] ?missingValues) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues - match TextConversions.AsFloat missingValues false cultureInfo x with - | Some f -> f - | _ -> failwithf "Not a float: %s" x - - [] - static member AsBoolean(x:String) = - match TextConversions.AsBoolean x with - | Some b -> b - | _ -> failwithf "Not a boolean: %s" x - - [] - static member AsDateTime(x:String, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match TextConversions.AsDateTime cultureInfo x with - | Some d -> d - | _ -> failwithf "Not a datetime: %s" x - - [] - static member AsDateTimeOffset(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match TextConversions.AsDateTimeOffset cultureInfo x with - | Some d -> d - | _ -> failwithf "Not a datetime offset: %s" <| x - - [] - static member AsTimeSpan(x:String, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match TextConversions.AsTimeSpan cultureInfo x with - | Some t -> t - | _ -> failwithf "Not a time span: %s" x - - [] - static member AsGuid(x:String) = - match x |> TextConversions.AsGuid with - | Some g -> g - | _ -> failwithf "Not a guid: %s" x + [] + static member AsInteger(x: String, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match TextConversions.AsInteger cultureInfo x with + | Some i -> i + | _ -> failwithf "Not an int: %s" x + + [] + static member AsInteger64(x: String, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match TextConversions.AsInteger64 cultureInfo x with + | Some i -> i + | _ -> failwithf "Not an int64: %s" x + + [] + static member AsDecimal(x: String, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match TextConversions.AsDecimal cultureInfo x with + | Some d -> d + | _ -> failwithf "Not a decimal: %s" x + + [] + static member AsFloat(x: String, [] ?cultureInfo, [] ?missingValues) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues + + match TextConversions.AsFloat missingValues false cultureInfo x with + | Some f -> f + | _ -> failwithf "Not a float: %s" x + + [] + static member AsBoolean(x: String) = + match TextConversions.AsBoolean x with + | Some b -> b + | _ -> failwithf "Not a boolean: %s" x + + [] + static member AsDateTime(x: String, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match TextConversions.AsDateTime cultureInfo x with + | Some d -> d + | _ -> failwithf "Not a datetime: %s" x + + [] + static member AsDateTimeOffset(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match TextConversions.AsDateTimeOffset cultureInfo x with + | Some d -> d + | _ -> failwithf "Not a datetime offset: %s" <| x + + [] + static member AsTimeSpan(x: String, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match TextConversions.AsTimeSpan cultureInfo x with + | Some t -> t + | _ -> failwithf "Not a time span: %s" x + + [] + static member AsGuid(x: String) = + match x |> TextConversions.AsGuid with + | 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 - let (?) (csvRow:CsvRow) (columnName:string) = csvRow.[columnName] \ No newline at end of file + + /// Get the value of a column by name from a CSV row + let (?) (csvRow: CsvRow) (columnName: string) = csvRow.[columnName] diff --git a/src/Csv/CsvFile.fs b/src/Csv/CsvFile.fs index 1b4788ce0..e8767fad1 100644 --- a/src/Csv/CsvFile.fs +++ b/src/Csv/CsvFile.fs @@ -14,20 +14,25 @@ open System.Text [] /// Represents a CSV row. -type CsvRow(parent:CsvFile, columns:string[]) = +type CsvRow(parent: CsvFile, columns: string[]) = - /// The columns of the row - member __.Columns = columns - - /// Gets a column by index - member __.GetColumn index = columns.[index] - /// Gets a column by name - member __.GetColumn columnName = columns.[parent.GetColumnIndex columnName] + /// The columns of the row + member __.Columns = columns - /// Gets a column by index - member __.Item with get index = columns.[index] - /// Gets a column by name - member __.Item with get columnName = columns.[parent.GetColumnIndex columnName] + /// Gets a column by index + member __.GetColumn index = columns.[index] + + /// Gets a column by name + member __.GetColumn columnName = + columns.[parent.GetColumnIndex columnName] + + /// Gets a column by index + member __.Item + with get index = columns.[index] + + /// Gets a column by name + member __.Item + with get columnName = columns.[parent.GetColumnIndex columnName] /// /// Represents a CSV file. The lines are read on demand from reader. @@ -38,77 +43,195 @@ type CsvRow(parent:CsvFile, columns:string[]) = /// (or the first row if headers are not present) will be ignored. /// The first skipRows lines will be skipped. /// -and CsvFile private (readerFunc:Func, [] ?separators, [] ?quote, [] ?hasHeaders, [] ?ignoreErrors, [] ?skipRows) as this = - inherit CsvFile( - Func<_,_,_>(fun this columns -> CsvRow(this :?> CsvFile, columns)), - Func<_,_>(fun row -> row.Columns), - readerFunc, - defaultArg separators "", - defaultArg quote '"', - defaultArg hasHeaders true, - defaultArg ignoreErrors false, - defaultArg skipRows 0) - - let headerDic = - match this.Headers with - | Some headers -> - headers - |> Seq.mapi (fun index header -> header, index) - |> dict - | None -> [] |> dict - - /// Returns the index of the column with the given name - member __.GetColumnIndex columnName = headerDic.[columnName] - - /// Returns the index of the column with the given name, or returns None if no column is found - member __.TryGetColumnIndex columnName = - match headerDic.TryGetValue columnName with - | true, index -> Some index - | false, _ -> None - - /// Parses the specified CSV content - static member Parse(text, [] ?separators, [] ?quote, [] ?hasHeaders, [] ?ignoreErrors, [] ?skipRows) = - let readerFunc = Func<_>(fun () -> new StringReader(text) :> TextReader) - new CsvFile(readerFunc, ?separators=separators, ?quote=quote, ?hasHeaders=hasHeaders, ?ignoreErrors=ignoreErrors, ?skipRows=skipRows) - - /// Loads CSV from the specified stream - static member Load(stream:Stream, [] ?separators, [] ?quote, [] ?hasHeaders, [] ?ignoreErrors, [] ?skipRows) = - let firstTime = ref true - let readerFunc = Func<_>(fun () -> - if firstTime.Value then firstTime := false - else stream.Position <- 0L - new StreamReader(stream) :> TextReader) - new CsvFile(readerFunc, ?separators=separators, ?quote=quote, ?hasHeaders=hasHeaders, ?ignoreErrors=ignoreErrors, ?skipRows=skipRows) - - /// Loads CSV from the specified reader - static member Load(reader:TextReader, [] ?separators, [] ?quote, [] ?hasHeaders, [] ?ignoreErrors, [] ?skipRows) = - let firstTime = ref true - let readerFunc = Func<_>(fun () -> - if firstTime.Value then firstTime := false - elif reader :? StreamReader then - let sr = reader :?> StreamReader - sr.BaseStream.Position <- 0L - sr.DiscardBufferedData() - else invalidOp "The underlying source stream is not re-entrant. Use the Cache method to cache the data." - reader) - new CsvFile(readerFunc, ?separators=separators, ?quote=quote, ?hasHeaders=hasHeaders, ?ignoreErrors=ignoreErrors, ?skipRows=skipRows) - - /// Loads CSV from the specified uri - static member Load(uri:string, [] ?separators, [] ?quote, [] ?hasHeaders, [] ?ignoreErrors, [] ?skipRows, [] ?encoding) = - CsvFile.AsyncLoad(uri, ?separators=separators, ?quote=quote, ?hasHeaders=hasHeaders, ?ignoreErrors=ignoreErrors, ?skipRows=skipRows, ?encoding=encoding) |> Async.RunSynchronously - - /// Loads CSV from the specified uri asynchronously - static member AsyncLoad(uri:string, [] ?separators, [] ?quote, [] ?hasHeaders, [] ?ignoreErrors, [] ?skipRows, [] ?encoding) = async { - let separators = defaultArg separators "" - let separators = - if String.IsNullOrEmpty separators && uri.EndsWith(".tsv" , StringComparison.OrdinalIgnoreCase) - then "\t" else separators - let encoding = defaultArg encoding Encoding.UTF8 - let! reader = asyncReadTextAtRuntime false "" "" "CSV" encoding.WebName uri - let firstTime = ref true - let readerFunc = Func<_>(fun () -> - if firstTime.Value then firstTime := false; reader - else asyncReadTextAtRuntime false "" "" "CSV" encoding.WebName uri |> Async.RunSynchronously) - return new CsvFile(readerFunc, separators, ?quote=quote, ?hasHeaders=hasHeaders, ?ignoreErrors=ignoreErrors, ?skipRows=skipRows) - } +and CsvFile + private + ( + readerFunc: Func, + [] ?separators, + [] ?quote, + [] ?hasHeaders, + [] ?ignoreErrors, + [] ?skipRows + ) as this = + inherit CsvFile + ( + Func<_, _, _>(fun this columns -> CsvRow(this :?> CsvFile, columns)), + Func<_, _>(fun row -> row.Columns), + readerFunc, + defaultArg separators "", + defaultArg quote '"', + defaultArg hasHeaders true, + defaultArg ignoreErrors false, + defaultArg skipRows 0 + ) + + let headerDic = + match this.Headers with + | Some headers -> + headers + |> Seq.mapi (fun index header -> header, index) + |> dict + | None -> [] |> dict + + /// Returns the index of the column with the given name + member __.GetColumnIndex columnName = headerDic.[columnName] + + /// Returns the index of the column with the given name, or returns None if no column is found + member __.TryGetColumnIndex columnName = + match headerDic.TryGetValue columnName with + | true, index -> Some index + | false, _ -> None + + /// Parses the specified CSV content + static member Parse + ( + text, + [] ?separators, + [] ?quote, + [] ?hasHeaders, + [] ?ignoreErrors, + [] ?skipRows + ) = + let readerFunc = Func<_>(fun () -> new StringReader(text) :> TextReader) + + new CsvFile( + readerFunc, + ?separators = separators, + ?quote = quote, + ?hasHeaders = hasHeaders, + ?ignoreErrors = ignoreErrors, + ?skipRows = skipRows + ) + + /// Loads CSV from the specified stream + static member Load + ( + stream: Stream, + [] ?separators, + [] ?quote, + [] ?hasHeaders, + [] ?ignoreErrors, + [] ?skipRows + ) = + let firstTime = ref true + + let readerFunc = + Func<_>(fun () -> + if firstTime.Value then + firstTime := false + else + stream.Position <- 0L + + new StreamReader(stream) :> TextReader) + + new CsvFile( + readerFunc, + ?separators = separators, + ?quote = quote, + ?hasHeaders = hasHeaders, + ?ignoreErrors = ignoreErrors, + ?skipRows = skipRows + ) + + /// Loads CSV from the specified reader + static member Load + ( + reader: TextReader, + [] ?separators, + [] ?quote, + [] ?hasHeaders, + [] ?ignoreErrors, + [] ?skipRows + ) = + let firstTime = ref true + + let readerFunc = + Func<_>(fun () -> + if firstTime.Value then + firstTime := false + elif reader :? StreamReader then + let sr = reader :?> StreamReader + sr.BaseStream.Position <- 0L + sr.DiscardBufferedData() + else + invalidOp "The underlying source stream is not re-entrant. Use the Cache method to cache the data." + + reader) + + new CsvFile( + readerFunc, + ?separators = separators, + ?quote = quote, + ?hasHeaders = hasHeaders, + ?ignoreErrors = ignoreErrors, + ?skipRows = skipRows + ) + + /// Loads CSV from the specified uri + static member Load + ( + uri: string, + [] ?separators, + [] ?quote, + [] ?hasHeaders, + [] ?ignoreErrors, + [] ?skipRows, + [] ?encoding + ) = + CsvFile.AsyncLoad( + uri, + ?separators = separators, + ?quote = quote, + ?hasHeaders = hasHeaders, + ?ignoreErrors = ignoreErrors, + ?skipRows = skipRows, + ?encoding = encoding + ) + |> Async.RunSynchronously + + /// Loads CSV from the specified uri asynchronously + static member AsyncLoad + ( + uri: string, + [] ?separators, + [] ?quote, + [] ?hasHeaders, + [] ?ignoreErrors, + [] ?skipRows, + [] ?encoding + ) = + async { + let separators = defaultArg separators "" + + let separators = + if + String.IsNullOrEmpty separators + && uri.EndsWith(".tsv", StringComparison.OrdinalIgnoreCase) + then + "\t" + else + separators + + let encoding = defaultArg encoding Encoding.UTF8 + let! reader = asyncReadTextAtRuntime false "" "" "CSV" encoding.WebName uri + let firstTime = ref true + + let readerFunc = + Func<_>(fun () -> + if firstTime.Value then + firstTime := false + reader + else + asyncReadTextAtRuntime false "" "" "CSV" encoding.WebName uri + |> Async.RunSynchronously) + return + new CsvFile( + readerFunc, + separators, + ?quote = quote, + ?hasHeaders = hasHeaders, + ?ignoreErrors = ignoreErrors, + ?skipRows = skipRows + ) + } diff --git a/src/Csv/CsvGenerator.fs b/src/Csv/CsvGenerator.fs index 6c989472e..7f5f010eb 100644 --- a/src/Csv/CsvGenerator.fs +++ b/src/Csv/CsvGenerator.fs @@ -15,85 +15,127 @@ open ProviderImplementation.QuotationBuilder module internal CsvTypeBuilder = - type private FieldInfo = - { /// The representation type that is part of the tuple we extract the field from - TypeForTuple : Type - /// The provided property corresponding to the field - ProvidedProperty : ProvidedProperty - Convert: Expr -> Expr - ConvertBack: Expr -> Expr - /// The provided parameter corresponding to the field - ProvidedParameter : ProvidedParameter } - - let generateTypes asm ns typeName (missingValuesStr, cultureStr) inferredFields = - - let fields = inferredFields |> List.mapi (fun index field -> - let typ, typWithoutMeasure, conv, convBack = ConversionsGenerator.convertStringValue missingValuesStr cultureStr field - let propertyName = NameUtils.capitalizeFirstLetter field.Name - let prop = ProvidedProperty(propertyName, typ, getterCode = fun (Singleton row) -> - match inferredFields with - | [ _ ] -> row - | _ -> Expr.TupleGet(row, 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. - let rowErasedType = - match fields with - | [ field ] -> field.TypeForTuple - | _ -> FSharpType.MakeTupleType([| for field in fields -> field.TypeForTuple |]) - - let rowType = ProvidedTypeDefinition("Row", Some rowErasedType, hideObjectMethods = true, nonNullable = true) - - let ctor = - let parameters = [ for field in fields -> field.ProvidedParameter ] - let invoke args = - match args with - | [ arg ] -> arg - | _ -> Expr.NewTuple(args) - ProvidedConstructor(parameters, invokeCode = invoke) - - rowType.AddMember ctor - - // Each property of the generated row type will simply be a tuple get - for field in fields do - rowType.AddMember field.ProvidedProperty - - // The erased csv type will be parameterised by the tuple type - let csvErasedTypeWithRowErasedType = typedefof>.MakeGenericType(rowErasedType) - let csvErasedTypeWithGeneratedRowType = typedefof>.MakeGenericType(rowType) - - let csvType = ProvidedTypeDefinition(asm, ns, typeName, Some csvErasedTypeWithGeneratedRowType, hideObjectMethods = true, nonNullable = true) - csvType.AddMember rowType - - // Based on the set of fields, create a function that converts a string[] to the tuple type - let stringArrayToRow = - let parentVar = Var("parent", typeof) - let rowVar = Var("row", typeof) - let rowVarExpr = Expr.Var rowVar - - // Convert each element of the row using the appropriate conversion - let body = - match [ for field in fields -> field.Convert rowVarExpr ] with - | [ col ] -> col - | cols -> Expr.NewTuple cols - - let delegateType = typedefof>.MakeGenericType(typeof, typeof, rowErasedType) - - Expr.NewDelegate(delegateType, [parentVar; rowVar], body) - - // Create a function that converts the tuple type to a string[] - let rowToStringArray = - let rowVar = Var("row", rowErasedType) - let rowVarExpr = Expr.Var rowVar - let body = Expr.NewArray(typeof, [ for field in fields -> field.ConvertBack rowVarExpr ]) - let delegateType = typedefof>.MakeGenericType(rowErasedType, typeof) - - Expr.NewDelegate(delegateType, [rowVar], body) - - csvType, csvErasedTypeWithRowErasedType, rowType, stringArrayToRow, rowToStringArray + type private FieldInfo = + { + /// The representation type that is part of the tuple we extract the field from + TypeForTuple: Type + /// The provided property corresponding to the field + ProvidedProperty: ProvidedProperty + Convert: Expr -> Expr + ConvertBack: Expr -> Expr + /// The provided parameter corresponding to the field + ProvidedParameter: ProvidedParameter + } + + let generateTypes asm ns typeName (missingValuesStr, cultureStr) inferredFields = + + let fields = + inferredFields + |> List.mapi (fun index field -> + let typ, typWithoutMeasure, conv, convBack = + ConversionsGenerator.convertStringValue missingValuesStr cultureStr field + + let propertyName = NameUtils.capitalizeFirstLetter field.Name + + let prop = + ProvidedProperty( + propertyName, + typ, + getterCode = + fun (Singleton row) -> + match inferredFields with + | [ _ ] -> row + | _ -> Expr.TupleGet(row, 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. + let rowErasedType = + match fields with + | [ field ] -> field.TypeForTuple + | _ -> FSharpType.MakeTupleType([| for field in fields -> field.TypeForTuple |]) + + let rowType = + ProvidedTypeDefinition("Row", Some rowErasedType, hideObjectMethods = true, nonNullable = true) + + let ctor = + let parameters = [ for field in fields -> field.ProvidedParameter ] + + let invoke args = + match args with + | [ arg ] -> arg + | _ -> Expr.NewTuple(args) + + ProvidedConstructor(parameters, invokeCode = invoke) + + rowType.AddMember ctor + + // Each property of the generated row type will simply be a tuple get + for field in fields do + rowType.AddMember field.ProvidedProperty + + // The erased csv type will be parameterised by the tuple type + let csvErasedTypeWithRowErasedType = + typedefof>.MakeGenericType (rowErasedType) + + let csvErasedTypeWithGeneratedRowType = + typedefof>.MakeGenericType (rowType) + + let csvType = + ProvidedTypeDefinition( + asm, + ns, + typeName, + Some csvErasedTypeWithGeneratedRowType, + hideObjectMethods = true, + nonNullable = true + ) + + csvType.AddMember rowType + + // Based on the set of fields, create a function that converts a string[] to the tuple type + let stringArrayToRow = + let parentVar = Var("parent", typeof) + let rowVar = Var("row", typeof) + let rowVarExpr = Expr.Var rowVar + + // Convert each element of the row using the appropriate conversion + let body = + match [ for field in fields -> field.Convert rowVarExpr ] with + | [ col ] -> col + | cols -> Expr.NewTuple cols + + let delegateType = + typedefof>.MakeGenericType (typeof, typeof, rowErasedType) + + Expr.NewDelegate(delegateType, [ parentVar; rowVar ], body) + + // Create a function that converts the tuple type to a string[] + let rowToStringArray = + let rowVar = Var("row", rowErasedType) + let rowVarExpr = Expr.Var rowVar + + let body = + Expr.NewArray(typeof, [ for field in fields -> field.ConvertBack rowVarExpr ]) + + let delegateType = + typedefof>.MakeGenericType (rowErasedType, typeof) + + Expr.NewDelegate(delegateType, [ rowVar ], body) + + csvType, csvErasedTypeWithRowErasedType, rowType, stringArrayToRow, rowToStringArray diff --git a/src/Csv/CsvInference.fs b/src/Csv/CsvInference.fs index e94167eaa..055116a42 100644 --- a/src/Csv/CsvInference.fs +++ b/src/Csv/CsvInference.fs @@ -13,264 +13,339 @@ 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 )] - |> dict - -let private nameAndTypeRegex = lazy Regex(@"^(?.+)\((?.+)\)$", RegexOptions.Compiled ||| RegexOptions.RightToLeft) -let private typeAndUnitRegex = lazy Regex(@"^(?.+)<(?.+)>$", RegexOptions.Compiled ||| RegexOptions.RightToLeft) -let private overrideByNameRegex = lazy Regex(@"^(?.+)(->(?.+)(=(?.+))?|=(?.+))$", RegexOptions.Compiled ||| RegexOptions.RightToLeft) - + [ "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) ] + |> dict + +let private nameAndTypeRegex = + lazy Regex(@"^(?.+)\((?.+)\)$", RegexOptions.Compiled ||| RegexOptions.RightToLeft) + +let private typeAndUnitRegex = + lazy Regex(@"^(?.+)<(?.+)>$", RegexOptions.Compiled ||| RegexOptions.RightToLeft) + +let private overrideByNameRegex = + lazy + Regex( + @"^(?.+)(->(?.+)(=(?.+))?|=(?.+))$", + RegexOptions.Compiled ||| RegexOptions.RightToLeft + ) + [] type private SchemaParseResult = - | 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 + | 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 +let private asOption = + function + | true, x -> Some x + | false, _ -> None /// -/// Parses type specification in the schema for a single column. +/// 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 - +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 returne /// (if we succeed we override the inferred schema, otherwise, we just /// override the header name) -let private parseSchemaItem unitsOfMeasureProvider str forSchemaOverride = - let name, typ, unit, isOverrideByName, originalName = - let m = overrideByNameRegex.Value.Match str - if m.Success && forSchemaOverride then - // name=type|type - 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 - if typ.IsNone && typeAndUnit <> "" then - failwithf "Invalid type: %s" typeAndUnit - newName, typ, unit, true, originalName - else - let m = nameAndTypeRegex.Value.Match(str) - if m.Success then - // name (type|measure|type) - let name = m.Groups.["name"].Value.TrimEnd() - let typeAndUnit = m.Groups.["type"].Value.Trim() - let typ, unit = parseTypeAndUnit unitsOfMeasureProvider typeAndUnit - name, typ, unit, false, "" - elif forSchemaOverride then - // type|type - let typ, unit = parseTypeAndUnit unitsOfMeasureProvider str - match typ, unit with - | None, _ -> str, None, None, false, "" - | typ, unit -> "", typ, unit, false, "" - else - // name - str, None, None, false, "" - - match typ, unit with - | Some (typ, typWrapper), unit -> - let prop = PrimitiveInferedProperty.Create(name, typ, typWrapper, unit) - if isOverrideByName - then SchemaParseResult.FullByName(prop, originalName) - else SchemaParseResult.Full prop - | None, None when isOverrideByName -> SchemaParseResult.Rename(name, originalName) - | None, None -> SchemaParseResult.Name str - | None, Some _ when forSchemaOverride -> SchemaParseResult.Name str - | None, Some unit -> SchemaParseResult.NameAndUnit(name, unit) - -let internal inferCellType preferOptionals missingValues cultureInfo unit (value:string) = +let private parseSchemaItem unitsOfMeasureProvider str forSchemaOverride = + let name, typ, unit, isOverrideByName, originalName = + let m = overrideByNameRegex.Value.Match str + + if m.Success && forSchemaOverride then + // name=type|type + 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 + + if typ.IsNone && typeAndUnit <> "" then + failwithf "Invalid type: %s" typeAndUnit + + newName, typ, unit, true, originalName + else + let m = nameAndTypeRegex.Value.Match(str) + + if m.Success then + // name (type|measure|type) + let name = m.Groups.["name"].Value.TrimEnd() + let typeAndUnit = m.Groups.["type"].Value.Trim() + let typ, unit = parseTypeAndUnit unitsOfMeasureProvider typeAndUnit + name, typ, unit, false, "" + elif forSchemaOverride then + // type|type + let typ, unit = parseTypeAndUnit unitsOfMeasureProvider str + + match typ, unit with + | None, _ -> str, None, None, false, "" + | typ, unit -> "", typ, unit, false, "" + else + // name + str, None, None, false, "" + + match typ, unit with + | Some (typ, typWrapper), unit -> + let prop = PrimitiveInferedProperty.Create(name, typ, typWrapper, unit) + + if isOverrideByName then + SchemaParseResult.FullByName(prop, originalName) + else + SchemaParseResult.Full prop + | None, None when isOverrideByName -> SchemaParseResult.Rename(name, originalName) + | None, None -> SchemaParseResult.Name str + | None, Some _ when forSchemaOverride -> SchemaParseResult.Name str + | None, Some unit -> SchemaParseResult.NameAndUnit(name, unit) + +let internal inferCellType preferOptionals missingValues 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) + if Array.exists (value.Trim() |> (=)) missingValues then + if preferOptionals then + InferedType.Null + else + InferedType.Primitive(typeof, unit, 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 + elif String.IsNullOrWhiteSpace value then + InferedType.Null + else + getInferedTypeFromString cultureInfo value unit let internal parseHeaders headers numberOfColumns schema unitsOfMeasureProvider = - let makeUnique = NameUtils.uniqueGenerator id - - // If we do not have header names, then automatically generate names - let headers = - match headers with - | Some headers -> - headers |> Array.mapi (fun i header -> - if String.IsNullOrWhiteSpace header then - "Column" + (i+1).ToString() - else - header) - | None -> Array.init numberOfColumns (fun i -> "Column" + (i+1).ToString()) - - // If the schema is specified explicitly, then parse the schema - // (This can specify just types, names of columns or a mix of both) - let schema = - if String.IsNullOrWhiteSpace schema then - Array.zeroCreate headers.Length - else - use reader = new StringReader(schema) - let schemaStr = CsvReader.readCsvFile reader "," '"' |> Seq.exactlyOne |> fst - if schemaStr.Length > headers.Length then - failwithf "The provided schema contains %d columns, the inference found %d columns - please check the number of columns and the separator " schemaStr.Length headers.Length - let schema = Array.zeroCreate headers.Length - for index = 0 to schemaStr.Length-1 do - let item = schemaStr.[index].Trim() - match item with - | "" -> () - | item -> - let parseResult = parseSchemaItem unitsOfMeasureProvider item true - match parseResult with - | SchemaParseResult.Name name -> - headers.[index] <- name - | SchemaParseResult.Full prop -> - let name = - if prop.Name = "" then headers.[index] - else prop.Name - schema.[index] <- Some { prop with Name = makeUnique name } - | SchemaParseResult.Rename (name, originalName) -> - let index = headers |> Array.tryFindIndex (fun header -> header.Equals(originalName, StringComparison.OrdinalIgnoreCase)) - match index with - | Some index -> - headers.[index] <- name - | None -> failwithf "Column '%s' not found in '%s'" originalName (headers |> String.concat ",") - | SchemaParseResult.FullByName (prop, originalName) -> - let index = headers |> Array.tryFindIndex (fun header -> header.Equals(originalName, StringComparison.OrdinalIgnoreCase)) - match index with - | Some index -> - let name = - if prop.Name = "" then headers.[index] - else prop.Name - schema.[index] <- Some { prop with Name = makeUnique name } - | None -> failwithf "Column '%s' not found in '%s'" originalName (headers |> String.concat ",") - | _ -> failwithf "inferType: Unexpected SchemaParseResult for schema: %A" parseResult - schema - - // Merge the previous information with the header names that we get from the - // first row of the file (if the schema specifies just types, we want to use the - // names from the file; if the schema specifies name & type, it overrides the file) - let headerNamesAndUnits = headers |> Array.mapi (fun index item -> - match schema.[index] with - | Some prop -> prop.Name, None - | None -> - let parseResult = parseSchemaItem unitsOfMeasureProvider item false - match parseResult with - | SchemaParseResult.Name name -> - makeUnique name, None - | SchemaParseResult.NameAndUnit (name, unit) -> - // store the original header because the inferred type might not support units of measure - (makeUnique item) + "\n" + (makeUnique name), Some unit - | SchemaParseResult.Full prop -> - let prop = { prop with Name = makeUnique prop.Name } - schema.[index] <- Some prop - prop.Name, None - | _ -> failwithf "inferType: Unexpected SchemaParseResult for header: %A" parseResult) - - headerNamesAndUnits, schema + let makeUnique = NameUtils.uniqueGenerator id + + // If we do not have header names, then automatically generate names + let headers = + match headers with + | Some headers -> + headers + |> Array.mapi (fun i header -> + if String.IsNullOrWhiteSpace header then + "Column" + (i + 1).ToString() + else + header) + | None -> Array.init numberOfColumns (fun i -> "Column" + (i + 1).ToString()) + + // If the schema is specified explicitly, then parse the schema + // (This can specify just types, names of columns or a mix of both) + let schema = + if String.IsNullOrWhiteSpace schema then + Array.zeroCreate headers.Length + else + use reader = new StringReader(schema) + + let schemaStr = + CsvReader.readCsvFile reader "," '"' + |> Seq.exactlyOne + |> fst + + if schemaStr.Length > headers.Length then + failwithf + "The provided schema contains %d columns, the inference found %d columns - please check the number of columns and the separator " + schemaStr.Length + headers.Length + + let schema = Array.zeroCreate headers.Length + + for index = 0 to schemaStr.Length - 1 do + let item = schemaStr.[index].Trim() + + match item with + | "" -> () + | item -> + let parseResult = parseSchemaItem unitsOfMeasureProvider item true + + match parseResult with + | SchemaParseResult.Name name -> headers.[index] <- name + | SchemaParseResult.Full prop -> + let name = if prop.Name = "" then headers.[index] else prop.Name + schema.[index] <- Some { prop with Name = makeUnique name } + | SchemaParseResult.Rename (name, originalName) -> + let index = + headers + |> Array.tryFindIndex (fun header -> + header.Equals(originalName, StringComparison.OrdinalIgnoreCase)) + + match index with + | Some index -> headers.[index] <- name + | None -> failwithf "Column '%s' not found in '%s'" originalName (headers |> String.concat ",") + | SchemaParseResult.FullByName (prop, originalName) -> + let index = + headers + |> Array.tryFindIndex (fun header -> + header.Equals(originalName, StringComparison.OrdinalIgnoreCase)) + + match index with + | Some index -> + let name = if prop.Name = "" then headers.[index] else prop.Name + schema.[index] <- Some { prop with Name = makeUnique name } + | None -> failwithf "Column '%s' not found in '%s'" originalName (headers |> String.concat ",") + | _ -> failwithf "inferType: Unexpected SchemaParseResult for schema: %A" parseResult + + schema + + // Merge the previous information with the header names that we get from the + // first row of the file (if the schema specifies just types, we want to use the + // names from the file; if the schema specifies name & type, it overrides the file) + let headerNamesAndUnits = + headers + |> Array.mapi (fun index item -> + match schema.[index] with + | Some prop -> prop.Name, None + | None -> + let parseResult = parseSchemaItem unitsOfMeasureProvider item false + + match parseResult with + | SchemaParseResult.Name name -> makeUnique name, None + | SchemaParseResult.NameAndUnit (name, unit) -> + // store the original header because the inferred type might not support units of measure + (makeUnique item) + "\n" + (makeUnique name), Some unit + | SchemaParseResult.Full prop -> + let prop = { prop with Name = makeUnique prop.Name } + schema.[index] <- Some prop + prop.Name, None + | _ -> failwithf "inferType: Unexpected SchemaParseResult for header: %A" parseResult) + + headerNamesAndUnits, schema /// Infers the type of a CSV file using the specified number of rows /// (This handles units in the same way as the original MiniCSV provider) -let internal inferType (headerNamesAndUnits:_[]) schema (rows:seq<_>) inferRows missingValues cultureInfo assumeMissingValues preferOptionals = - - // If we have no data, generate one empty row with empty strings, - // so that we get a type with all the properties (returning string values) - let rowsIterator = rows.GetEnumerator() - let rows = - if rowsIterator.MoveNext() then - seq { - yield rowsIterator.Current - try - while rowsIterator.MoveNext() do - yield rowsIterator.Current - finally - rowsIterator.Dispose() - if assumeMissingValues then - yield Array.create headerNamesAndUnits.Length "" - } - else - Array.create headerNamesAndUnits.Length "" |> Seq.singleton - - let rows = if inferRows > 0 then Seq.truncate (if assumeMissingValues && inferRows < Int32.MaxValue then inferRows + 1 else inferRows) rows else rows - - // Infer the type of collection using structural inference - let types = - [ for row in rows -> - let fields = - [ for (name, unit), schema, value in Array.zip3 headerNamesAndUnits schema row -> - let typ = - match schema with - | Some _ -> InferedType.Null // this will be ignored, so just return anything - | None -> inferCellType preferOptionals missingValues cultureInfo unit value - { Name = name - Type = typ } ] - InferedType.Record(None, fields, false) ] - - let inferedType = - if schema |> Array.forall Option.isSome then - // all the columns types are already set, so all the rows will be the same - types |> List.head - else - List.reduce (StructuralInference.subtypeInfered (not preferOptionals)) types - - inferedType, schema +let internal inferType + (headerNamesAndUnits: _[]) + schema + (rows: seq<_>) + inferRows + missingValues + cultureInfo + assumeMissingValues + preferOptionals + = + + // If we have no data, generate one empty row with empty strings, + // so that we get a type with all the properties (returning string values) + let rowsIterator = rows.GetEnumerator() + + let rows = + if rowsIterator.MoveNext() then + seq { + yield rowsIterator.Current + + try + while rowsIterator.MoveNext() do + yield rowsIterator.Current + finally + rowsIterator.Dispose() + + if assumeMissingValues then + yield Array.create headerNamesAndUnits.Length "" + } + else + Array.create headerNamesAndUnits.Length "" + |> Seq.singleton + + let rows = + if inferRows > 0 then + Seq.truncate + (if assumeMissingValues && inferRows < Int32.MaxValue then + inferRows + 1 + else + inferRows) + rows + else + rows + + // Infer the type of collection using structural inference + let types = + [ for row in rows -> + let fields = + [ for (name, unit), schema, value in Array.zip3 headerNamesAndUnits schema row -> + let typ = + match schema with + | Some _ -> InferedType.Null // this will be ignored, so just return anything + | None -> inferCellType preferOptionals missingValues cultureInfo unit value + + { Name = name; Type = typ } ] + + InferedType.Record(None, fields, false) ] + + let inferedType = + if schema |> Array.forall Option.isSome then + // all the columns types are already set, so all the rows will be the same + types |> List.head + else + List.reduce (StructuralInference.subtypeInfered (not preferOptionals)) types + + inferedType, schema /// Generates the fields for a CSV row. The CSV provider should be /// numerical-friendly, so we do a few simple adjustments. /// When preferOptionals is false: -/// +/// /// - Optional fields of type 'int' are generated as Nullable /// - Optional fields of type 'int64' are generated as Nullable /// - Optional fields of type 'float' are just floats (and null becomes NaN) @@ -279,48 +354,68 @@ let internal inferType (headerNamesAndUnits:_[]) schema (rows:seq<_>) inferRows /// - All other types are simply strings. /// /// When preferOptionals is true: -/// +/// /// - All optional fields of type 'T' for any type become option, including strings and floats -let internal getFields preferOptionals inferedType schema = - - match inferedType with - | InferedType.Record(None, fields, false) -> fields |> List.mapi (fun index field -> - - match Array.get schema index with - | Some prop -> prop - | None -> - match field.Type with - | InferedType.Primitive(typ, unit, optional) -> - - // Transform the types as described above - let typ, typWrapper = - if optional then - if preferOptionals then typ, TypeWrapper.Option - elif typ = typeof then typ, TypeWrapper.None - elif typ = typeof then typeof, TypeWrapper.None - elif typ = typeof || typ = typeof || typ = typeof || typ = typeof then typ, TypeWrapper.Nullable - else typ, TypeWrapper.Option - else typ, TypeWrapper.None - - // Annotate the type with measure, if there is one - let typ, unit, name = - match unit with - | Some unit -> - if StructuralInference.supportsUnitsOfMeasure typ then - typ, Some unit, field.Name.Split('\n').[1] - else - typ, None, field.Name.Split('\n').[0] - | _ -> typ, None, field.Name.Split('\n').[0] - - PrimitiveInferedProperty.Create(name, typ, typWrapper, unit) - - | _ -> - PrimitiveInferedProperty.Create(field.Name.Split('\n').[0], typeof, preferOptionals, None) ) - - | _ -> failwithf "inferFields: Expected record type, got %A" inferedType - -let internal inferColumnTypes headerNamesAndUnits schema rows inferRows missingValues cultureInfo assumeMissingValues preferOptionals = +let internal getFields preferOptionals inferedType schema = + + match inferedType with + | InferedType.Record (None, fields, false) -> + fields + |> List.mapi (fun index field -> + + match Array.get schema index with + | Some prop -> prop + | None -> + match field.Type with + | InferedType.Primitive (typ, unit, optional) -> + + // Transform the types as described above + let typ, typWrapper = + if optional then + if preferOptionals then + typ, TypeWrapper.Option + elif typ = typeof then + typ, TypeWrapper.None + elif typ = typeof then + typeof, TypeWrapper.None + elif typ = typeof + || typ = typeof + || typ = typeof + || typ = typeof then + typ, TypeWrapper.Nullable + else + typ, TypeWrapper.Option + else + typ, TypeWrapper.None + + // Annotate the type with measure, if there is one + let typ, unit, name = + match unit with + | Some unit -> + if StructuralInference.supportsUnitsOfMeasure typ then + typ, Some unit, field.Name.Split('\n').[1] + else + typ, None, field.Name.Split('\n').[0] + | _ -> typ, None, field.Name.Split('\n').[0] + + PrimitiveInferedProperty.Create(name, typ, typWrapper, unit) + + | _ -> + PrimitiveInferedProperty.Create(field.Name.Split('\n').[0], typeof, preferOptionals, None)) + + | _ -> failwithf "inferFields: Expected record type, got %A" inferedType + +let internal inferColumnTypes + headerNamesAndUnits + schema + rows + inferRows + missingValues + cultureInfo + assumeMissingValues + preferOptionals + = inferType headerNamesAndUnits schema rows inferRows missingValues cultureInfo assumeMissingValues preferOptionals ||> getFields preferOptionals @@ -335,14 +430,28 @@ type CsvFile with /// - Assumes all columns can have missing values /// - when set to true, inference will prefer to use the option type instead of nullable types, double.NaN or "" for missing values /// - optional function to resolve Units of Measure - member x.InferColumnTypes(inferRows, missingValues, cultureInfo, schema, assumeMissingValues, preferOptionals, [] ?unitsOfMeasureProvider) = - let unitsOfMeasureProvider = defaultArg unitsOfMeasureProvider defaultUnitsOfMeasureProvider - let headerNamesAndUnits, schema = parseHeaders x.Headers x.NumberOfColumns schema unitsOfMeasureProvider - inferColumnTypes headerNamesAndUnits - schema - (x.Rows |> Seq.map (fun row -> row.Columns)) - inferRows - missingValues - cultureInfo - assumeMissingValues - preferOptionals + member x.InferColumnTypes + ( + inferRows, + missingValues, + cultureInfo, + schema, + assumeMissingValues, + preferOptionals, + [] ?unitsOfMeasureProvider + ) = + let unitsOfMeasureProvider = + defaultArg unitsOfMeasureProvider defaultUnitsOfMeasureProvider + + let headerNamesAndUnits, schema = + parseHeaders x.Headers x.NumberOfColumns schema unitsOfMeasureProvider + + inferColumnTypes + headerNamesAndUnits + schema + (x.Rows |> Seq.map (fun row -> row.Columns)) + inferRows + missingValues + cultureInfo + assumeMissingValues + preferOptionals diff --git a/src/Csv/CsvProvider.fs b/src/Csv/CsvProvider.fs index 965cd8cc5..9d3324c3e 100644 --- a/src/Csv/CsvProvider.fs +++ b/src/Csv/CsvProvider.fs @@ -18,17 +18,23 @@ open ProviderImplementation.QuotationBuilder // -------------------------------------------------------------------------------------- [] -type public CsvProvider(cfg:TypeProviderConfig) as this = - inherit DisposableTypeProviderForNamespaces(cfg, assemblyReplacementMap=[ "FSharp.Data.DesignTime", "FSharp.Data" ]) - +type public CsvProvider(cfg: TypeProviderConfig) as this = + inherit DisposableTypeProviderForNamespaces + ( + cfg, + assemblyReplacementMap = [ "FSharp.Data.DesignTime", "FSharp.Data" ] + ) + // Generate namespace and type 'FSharp.Data.CsvProvider' do AssemblyResolver.init () let asm = System.Reflection.Assembly.GetExecutingAssembly() let ns = "FSharp.Data" - let csvProvTy = ProvidedTypeDefinition(asm, ns, "CsvProvider", None, hideObjectMethods=true, nonNullable = true) - - let buildTypes (typeName:string) (args:obj[]) = - + + let csvProvTy = + ProvidedTypeDefinition(asm, ns, "CsvProvider", None, hideObjectMethods = true, nonNullable = true) + + let buildTypes (typeName: string) (args: obj[]) = + let sample = args.[0] :?> string let separators = args.[1] :?> string let inferRows = args.[2] :?> int @@ -45,93 +51,162 @@ type public CsvProvider(cfg:TypeProviderConfig) as this = let encodingStr = args.[13] :?> string let resolutionFolder = args.[14] :?> string let resource = args.[15] :?> string - + if sample = "" then if schema = "" then failwith "When the Sample parameter is not specified, the Schema parameter must be provided" + if hasHeaders then failwith "When the Sample parameter is not specified, the HasHeaders parameter must be set to false" - - let getSpec (extension:string) value = - - use sampleCsv = + + let getSpec (extension: string) value = + + use sampleCsv = use _holder = IO.logTime "Parsing" sample - let separators = - if String.IsNullOrEmpty separators && extension.ToLowerInvariant() = ".tsv" - then "\t" else separators - let value = - if sample = "" then + + let separators = + if String.IsNullOrEmpty separators + && extension.ToLowerInvariant() = ".tsv" then + "\t" + else + separators + + let value = + if sample = "" then // synthetize sample from the schema use reader = new StringReader(value) - let schemaStr = CsvReader.readCsvFile reader "," '"' |> Seq.exactlyOne |> fst + + let schemaStr = + CsvReader.readCsvFile reader "," '"' + |> Seq.exactlyOne + |> fst + Array.zeroCreate schemaStr.Length - |> String.concat (if String.IsNullOrEmpty separators then "," else separators.[0].ToString()) + |> String.concat ( + if String.IsNullOrEmpty separators then + "," + else + separators.[0].ToString() + ) else value - + CsvFile.Parse(value, separators, quote, hasHeaders, ignoreErrors, skipRows) - + let separators = sampleCsv.Separators - - let inferredFields = + + let inferredFields = use _holder = IO.logTime "Inference" sample - sampleCsv.InferColumnTypes(inferRows, TextRuntime.GetMissingValues missingValuesStr, TextRuntime.GetCulture cultureStr, schema, - assumeMissingValues, preferOptionals, ProviderHelpers.unitsOfMeasureProvider) - + + sampleCsv.InferColumnTypes( + inferRows, + TextRuntime.GetMissingValues missingValuesStr, + TextRuntime.GetCulture cultureStr, + schema, + assumeMissingValues, + preferOptionals, + ProviderHelpers.unitsOfMeasureProvider + ) + use _holder = IO.logTime "TypeGeneration" sample - - let csvType, csvErasedType, rowType, stringArrayToRow, rowToStringArray = - inferredFields - |> CsvTypeBuilder.generateTypes asm ns typeName (missingValuesStr, cultureStr) - + + let csvType, csvErasedType, rowType, stringArrayToRow, rowToStringArray = + inferredFields + |> CsvTypeBuilder.generateTypes asm ns typeName (missingValuesStr, cultureStr) + let stringArrayToRowVar = Var("stringArrayToRow", stringArrayToRow.Type) let rowToStringArrayVar = Var("rowToStringArray", rowToStringArray.Type) - - let paramType = typedefof>.MakeGenericType(rowType) - let headers = - match sampleCsv.Headers with - | 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 paramType = typedefof>.MakeGenericType (rowType) + + let headers = + match sampleCsv.Headers with + | 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 ctorCode (Singleton paramValue: Expr list) = - let body = csvErasedType?CreateEmpty () (Expr.Var rowToStringArrayVar, paramValue, headers, sampleCsv.NumberOfColumns, separators, quote) + 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 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) + 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(), + + let parseRows = + ProvidedMethod( + "ParseRows", + [ ProvidedParameter("text", typeof) ], + rowType.MakeArrayType(), isStatic = true, - invokeCode = parseRowsCode) + invokeCode = parseRowsCode + ) + csvType.AddMember parseRows - + { GeneratedType = csvType RepresentationType = csvType - CreateFromTextReader = fun reader -> - let body = - csvErasedType?Create () (Expr.Var stringArrayToRowVar, Expr.Var rowToStringArrayVar, reader, - separators, quote, hasHeaders, ignoreErrors, skipRows, cacheRows) - Expr.Let(stringArrayToRowVar, stringArrayToRow, Expr.Let(rowToStringArrayVar, rowToStringArray, body)) + CreateFromTextReader = + fun reader -> + let body = + csvErasedType?Create + () + (Expr.Var stringArrayToRowVar, + Expr.Var rowToStringArrayVar, + reader, + separators, + quote, + hasHeaders, + ignoreErrors, + skipRows, + cacheRows) + + Expr.Let( + stringArrayToRowVar, + stringArrayToRow, + Expr.Let(rowToStringArrayVar, rowToStringArray, body) + ) CreateListFromTextReader = None CreateFromTextReaderForSampleList = fun _ -> failwith "Not Applicable" - CreateFromValue = None - } + CreateFromValue = None } let maxNumberOfRows = if inferRows > 0 then Some inferRows else None - + // On the CsvProvider the schema might be partial and we will still infer from the sample // So we handle it in a custom way - generateType "CSV" (if sample <> "" then Sample sample else Schema schema) getSpec this cfg encodingStr resolutionFolder resource typeName maxNumberOfRows - - // Add static parameter that specifies the API we want to get (compile-time) - let parameters = - [ ProvidedStaticParameter("Sample", typeof, parameterDefaultValue = "") - ProvidedStaticParameter("Separators", typeof, parameterDefaultValue = "") + generateType + "CSV" + (if sample <> "" then Sample sample else Schema schema) + getSpec + this + cfg + encodingStr + resolutionFolder + resource + typeName + maxNumberOfRows + + // Add static parameter that specifies the API we want to get (compile-time) + let parameters = + [ ProvidedStaticParameter("Sample", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("Separators", typeof, parameterDefaultValue = "") ProvidedStaticParameter("InferRows", typeof, parameterDefaultValue = 1000) ProvidedStaticParameter("Schema", typeof, parameterDefaultValue = "") ProvidedStaticParameter("HasHeaders", typeof, parameterDefaultValue = true) @@ -143,11 +218,11 @@ type public CsvProvider(cfg:TypeProviderConfig) as this = ProvidedStaticParameter("MissingValues", typeof, parameterDefaultValue = "") ProvidedStaticParameter("CacheRows", typeof, parameterDefaultValue = true) ProvidedStaticParameter("Culture", typeof, parameterDefaultValue = "") - ProvidedStaticParameter("Encoding", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("Encoding", typeof, parameterDefaultValue = "") ProvidedStaticParameter("ResolutionFolder", typeof, parameterDefaultValue = "") ProvidedStaticParameter("EmbeddedResource", typeof, parameterDefaultValue = "") ] - - let helpText = + + let helpText = """Typed representation of a CSV file. Location of a CSV sample file or a string containing a sample CSV document. Column delimiter(s). Defaults to ,. @@ -160,16 +235,18 @@ type public CsvProvider(cfg:TypeProviderConfig) as this = When set to true, the type provider will assume all columns can have missing values, even if in the provided sample all values are present. Defaults to false. When set to true, inference will prefer to use the option type instead of nullable types, double.NaN or "" for missing values. Defaults to false. The quotation mark (for surrounding values containing the delimiter). Defaults to ". - The set of strings recogized as missing values specified as a comma-separated string (e.g., "NA,N/A"). Defaults to """ + String.Join(",", TextConversions.DefaultMissingValues) + """. + The set of strings recogized as missing values specified as a comma-separated string (e.g., "NA,N/A"). Defaults to """ + + String.Join(",", TextConversions.DefaultMissingValues) + + """. Whether the rows should be caches so they can be iterated multiple times. Defaults to true. Disable for large datasets. The culture used for parsing numbers and dates. Defaults to the invariant culture. 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.csv'). This is useful when exposing types generated by the type provider.""" - + do csvProvTy.AddXmlDoc helpText do csvProvTy.DefineStaticParameters(parameters, buildTypes) - + // Register the main type with F# compiler do this.AddNamespace(ns, [ csvProvTy ]) diff --git a/src/Csv/CsvRuntime.fs b/src/Csv/CsvRuntime.fs index d707fdf15..89a6899aa 100644 --- a/src/Csv/CsvRuntime.fs +++ b/src/Csv/CsvRuntime.fs @@ -15,397 +15,524 @@ open System.Text // -------------------------------------------------------------------------------------- -// Parser for the CSV format -module internal CsvReader = - - /// Lazily reads the specified CSV file using the specified separators - /// (Handles most of the RFC 4180 - most notably quoted values and also - /// quoted newline characters in columns) - let readCsvFile (reader:TextReader) (separators:string) quote = - - let inline (|Char|) (n:int) = char n - let inline (|Quote|_|) (n:int) = if char n = quote then Some() else None - - let separators = separators.ToCharArray() - let inline (|Separator|_|) (n:int) = - if separators.Length = 1 then - if (char n) = separators.[0] then Some() else None - else - if Array.exists ((=) (char n)) separators then Some() else None - - /// Read quoted string value until the end (ends with end of stream or - /// the " character, which can be encoded using double ") - let rec readString (chars:StringBuilder) = - match reader.Read() with - | -1 -> chars - | Quote when reader.Peek() = int quote -> - reader.Read() |> ignore - readString (chars.Append quote) - | Quote -> chars - | Char c -> readString (chars.Append c) - - /// Reads a line with data that are separated using specified separators - /// and may be quoted. Ends with newline or end of input. - let rec readLine data (chars:StringBuilder) = - match reader.Read() with - | -1 | Char '\r' | Char '\n' -> - let item = chars.ToString() - item::data - | Separator -> - let item = chars.ToString() - readLine (item::data) (StringBuilder()) - | Quote -> - readLine data (readString chars) - | Char c -> - readLine data (chars.Append c) - - /// Reads multiple lines from the input, skipping newline characters - let rec readLines lineNumber = seq { - match reader.Peek() with - | -1 -> () - | Char '\r' | Char '\n' -> - reader.Read() |> ignore - yield! readLines lineNumber - | _ -> - yield readLine [] (StringBuilder()) |> List.rev |> Array.ofList, lineNumber - yield! readLines (lineNumber + 1) } - - readLines 0 +// Parser for the CSV format +module internal CsvReader = + + /// Lazily reads the specified CSV file using the specified separators + /// (Handles most of the RFC 4180 - most notably quoted values and also + /// quoted newline characters in columns) + let readCsvFile (reader: TextReader) (separators: string) quote = + + let inline (|Char|) (n: int) = char n + let inline (|Quote|_|) (n: int) = if char n = quote then Some() else None + + let separators = separators.ToCharArray() + + let inline (|Separator|_|) (n: int) = + if separators.Length = 1 then + if (char n) = separators.[0] then Some() else None + else if Array.exists ((=) (char n)) separators then + Some() + else + None + + /// Read quoted string value until the end (ends with end of stream or + /// the " character, which can be encoded using double ") + let rec readString (chars: StringBuilder) = + match reader.Read() with + | -1 -> chars + | Quote when reader.Peek() = int quote -> + reader.Read() |> ignore + readString (chars.Append quote) + | Quote -> chars + | Char c -> readString (chars.Append c) + + /// Reads a line with data that are separated using specified separators + /// and may be quoted. Ends with newline or end of input. + let rec readLine data (chars: StringBuilder) = + match reader.Read() with + | -1 + | Char '\r' + | Char '\n' -> + let item = chars.ToString() + item :: data + | Separator -> + let item = chars.ToString() + readLine (item :: data) (StringBuilder()) + | Quote -> readLine data (readString chars) + | Char c -> readLine data (chars.Append c) + + /// Reads multiple lines from the input, skipping newline characters + let rec readLines lineNumber = + seq { + match reader.Peek() with + | -1 -> () + | Char '\r' + | Char '\n' -> + reader.Read() |> ignore + yield! readLines lineNumber + | _ -> + yield + readLine [] (StringBuilder()) + |> List.rev + |> Array.ofList, + lineNumber + + yield! readLines (lineNumber + 1) + } + + readLines 0 // -------------------------------------------------------------------------------------- [] -module private CsvHelpers = - - type ParsedCsvLines = - { FirstLine : string[] * int - SecondLine : (string[] * int) option - Headers : string[] option - LineIterator : IEnumerator - ColumnCount : int - HasHeaders : bool - Separators : string - Quote : char } - - /// An enumerable that will return elements from the 'firstSeq' first time it - /// is accessed and then will call 'nextSeq' each time for all future GetEnumerator calls - type private ReentrantEnumerable<'T>(firstSeq:seq<'T>, nextSeq:unit -> seq<'T>) = - let mutable first = true - interface seq<'T> with - member x.GetEnumerator() = - if first then - first <- false - firstSeq.GetEnumerator() - else nextSeq().GetEnumerator() - interface System.Collections.IEnumerable with - member x.GetEnumerator() = (x :> seq<'T>).GetEnumerator() :> System.Collections.IEnumerator - - let parseIntoLines newReader separators quote hasHeaders skipRows = - - // Get the first iterator and read the first line - let firstReader : TextReader = newReader() - - let linesIterator = (CsvReader.readCsvFile firstReader separators quote).GetEnumerator() - - for i = 1 to skipRows do - linesIterator.MoveNext() |> ignore - - let firstLine = - if linesIterator.MoveNext() then - linesIterator.Current - else - // If it does not have any lines, that's wrong... - linesIterator.Dispose() - if hasHeaders then failwithf "Invalid CSV file: header row not found" - else failwithf "Invalid CSV file: no data rows found" - - let headers = - if not hasHeaders then None - else firstLine |> fst |> Array.map (fun columnName -> columnName.Trim()) |> Some - - // If there are no headers, use the number of columns of the first line - let numberOfColumns = - match headers, firstLine with - | Some headers, _ -> headers.Length - | _, (columns, _) -> columns.Length - - { FirstLine = firstLine - SecondLine = None - Headers = headers - LineIterator = linesIterator - ColumnCount = numberOfColumns - HasHeaders = hasHeaders - Separators = separators - Quote = quote } - - // Always ignore empty rows - let inline ignoreRow untypedRow = - Array.forall String.IsNullOrWhiteSpace untypedRow - - let parseIntoTypedRows newReader - ignoreErrors - stringArrayToRow - { FirstLine = firstLine - SecondLine = secondLine - LineIterator = linesIterator - ColumnCount = numberOfColumns - HasHeaders = hasHeaders - Separators = separators - Quote = quote } = - - // On the first read, finish reading the opened reader - // On future reads, get a new reader (and skip headers) - let firstSeq = seq { - use linesIterator = linesIterator - if not hasHeaders then yield firstLine - match secondLine with - | Some line -> yield line - | None -> () - while linesIterator.MoveNext() do yield linesIterator.Current } - - let nextSeq() = - let reader : TextReader = newReader() - let csv = CsvReader.readCsvFile reader separators quote - if hasHeaders then Seq.skip 1 csv else csv - - let untypedRows = ReentrantEnumerable<_>(firstSeq, nextSeq) - // Return data with parsed columns - seq { - for untypedRow, lineNumber in untypedRows do - let hasCorrectNumberOfColumns, untypedRow = - match untypedRow.Length with - | length when length = numberOfColumns -> true, untypedRow - //row is also valid when it ends with single separator - | length when length = numberOfColumns + 1 && String.IsNullOrEmpty(untypedRow.[untypedRow.Length-1]) - -> true, untypedRow.[..numberOfColumns-1] - | _ -> false, untypedRow - - if not hasCorrectNumberOfColumns then - // Ignore rows with different number of columns when ignoreErrors is set to true - if not ignoreErrors then - let lineNumber = if hasHeaders then lineNumber else lineNumber + 1 - failwithf "Couldn't parse row %d according to schema: Expected %d columns, got %d" lineNumber numberOfColumns untypedRow.Length - else - if not (ignoreRow untypedRow) then - // Try to convert the untyped rows to 'RowType - let convertedRow = - try - Choice1Of2 (stringArrayToRow untypedRow) - with exn -> - Choice2Of2 exn - match convertedRow, ignoreErrors with - | Choice1Of2 convertedRow, _ -> yield convertedRow - | Choice2Of2 _, true -> () - | Choice2Of2 exn, false -> - let lineNumber = if hasHeaders then lineNumber else lineNumber + 1 - failwithf "Couldn't parse row %d according to schema: %s" lineNumber exn.Message - } +module private CsvHelpers = + + type ParsedCsvLines = + { FirstLine: string[] * int + SecondLine: (string[] * int) option + Headers: string[] option + LineIterator: IEnumerator + ColumnCount: int + HasHeaders: bool + Separators: string + Quote: char } + + /// An enumerable that will return elements from the 'firstSeq' first time it + /// is accessed and then will call 'nextSeq' each time for all future GetEnumerator calls + type private ReentrantEnumerable<'T>(firstSeq: seq<'T>, nextSeq: unit -> seq<'T>) = + let mutable first = true + + interface seq<'T> with + member x.GetEnumerator() = + if first then + first <- false + firstSeq.GetEnumerator() + else + nextSeq().GetEnumerator() + + interface System.Collections.IEnumerable with + member x.GetEnumerator() = + (x :> seq<'T>).GetEnumerator() :> System.Collections.IEnumerator + + let parseIntoLines newReader separators quote hasHeaders skipRows = + + // Get the first iterator and read the first line + let firstReader: TextReader = newReader () + + let linesIterator = + (CsvReader.readCsvFile firstReader separators quote).GetEnumerator() + + for i = 1 to skipRows do + linesIterator.MoveNext() |> ignore + + let firstLine = + if linesIterator.MoveNext() then + linesIterator.Current + else + // If it does not have any lines, that's wrong... + linesIterator.Dispose() + + if hasHeaders then + failwithf "Invalid CSV file: header row not found" + else + failwithf "Invalid CSV file: no data rows found" + + let headers = + if not hasHeaders then + None + else + firstLine + |> fst + |> Array.map (fun columnName -> columnName.Trim()) + |> Some + + // If there are no headers, use the number of columns of the first line + let numberOfColumns = + match headers, firstLine with + | Some headers, _ -> headers.Length + | _, (columns, _) -> columns.Length + + { FirstLine = firstLine + SecondLine = None + Headers = headers + LineIterator = linesIterator + ColumnCount = numberOfColumns + HasHeaders = hasHeaders + Separators = separators + Quote = quote } + + // Always ignore empty rows + let inline ignoreRow untypedRow = + Array.forall String.IsNullOrWhiteSpace untypedRow + + let parseIntoTypedRows + newReader + ignoreErrors + stringArrayToRow + { FirstLine = firstLine + SecondLine = secondLine + LineIterator = linesIterator + ColumnCount = numberOfColumns + HasHeaders = hasHeaders + Separators = separators + Quote = quote } + = + + // On the first read, finish reading the opened reader + // On future reads, get a new reader (and skip headers) + let firstSeq = + seq { + use linesIterator = linesIterator + if not hasHeaders then yield firstLine + + match secondLine with + | Some line -> yield line + | None -> () + + while linesIterator.MoveNext() do + yield linesIterator.Current + } + + let nextSeq () = + let reader: TextReader = newReader () + let csv = CsvReader.readCsvFile reader separators quote + if hasHeaders then Seq.skip 1 csv else csv + + let untypedRows = ReentrantEnumerable<_>(firstSeq, nextSeq) + // Return data with parsed columns + seq { + for untypedRow, lineNumber in untypedRows do + let hasCorrectNumberOfColumns, untypedRow = + match untypedRow.Length with + | length when length = numberOfColumns -> true, untypedRow + //row is also valid when it ends with single separator + | length when + length = numberOfColumns + 1 + && String.IsNullOrEmpty(untypedRow.[untypedRow.Length - 1]) + -> + true, untypedRow.[.. numberOfColumns - 1] + | _ -> false, untypedRow + + if not hasCorrectNumberOfColumns then + // Ignore rows with different number of columns when ignoreErrors is set to true + if not ignoreErrors then + let lineNumber = if hasHeaders then lineNumber else lineNumber + 1 + + failwithf + "Couldn't parse row %d according to schema: Expected %d columns, got %d" + lineNumber + numberOfColumns + untypedRow.Length + else if not (ignoreRow untypedRow) then + // Try to convert the untyped rows to 'RowType + let convertedRow = + try + Choice1Of2(stringArrayToRow untypedRow) + with exn -> + Choice2Of2 exn + + match convertedRow, ignoreErrors with + | Choice1Of2 convertedRow, _ -> yield convertedRow + | Choice2Of2 _, true -> () + | Choice2Of2 exn, false -> + let lineNumber = if hasHeaders then lineNumber else lineNumber + 1 + failwithf "Couldn't parse row %d according to schema: %s" lineNumber exn.Message + } // -------------------------------------------------------------------------------------- /// -type CsvFile<'RowType> private (rowToStringArray:Func<'RowType,string[]>, disposer:IDisposable, rows:seq<'RowType>, headers, numberOfColumns, separators, quote) = - - /// The rows with data - member __.Rows = rows - - /// The names of the columns - member __.Headers = headers - - /// The number of columns - member __.NumberOfColumns = numberOfColumns - - /// The character(s) used as column separator(s) - member __.Separators = separators - - /// The quotation mark use for surrounding values containing separator chars - member __.Quote = quote - - interface IDisposable with - member __.Dispose() = disposer.Dispose() - - /// - [] - [] - static member CreateEmpty (rowToStringArray, rows:seq<'RowType>, headers, numberOfColumns, separators, quote) = - new CsvFile<'RowType>(rowToStringArray, { new IDisposable with member x.Dispose() = () }, rows, headers, numberOfColumns, separators, quote) - - /// - [] - [] - static member Create (stringArrayToRow, rowToStringArray, reader:TextReader, separators, quote, hasHeaders, ignoreErrors, skipRows, cacheRows) = - let uncachedCsv = new CsvFile<'RowType>(stringArrayToRow, rowToStringArray, Func<_>(fun _ -> reader), separators, quote, hasHeaders, ignoreErrors, skipRows) - if cacheRows then uncachedCsv.Cache() else uncachedCsv - - /// - [] - [] - static member ParseRows (text, stringArrayToRow: Func, separators, quote, ignoreErrors) = - let reader = new StringReader(text) :> TextReader - let csv = CsvFile<_>.Create (stringArrayToRow, null, reader, separators, quote, hasHeaders=false, ignoreErrors=ignoreErrors, skipRows=0, cacheRows=false) - csv.Rows |> Seq.toArray - - /// - new (stringArrayToRow:Func, rowToStringArray, readerFunc:Func, separators, quote, hasHeaders, ignoreErrors, skipRows) as this = - - // Track created Readers so that we can dispose of all of them - let disposeFuncs = new ResizeArray<_>() - let mutable disposed = false - let disposer = - { new IDisposable with - member x.Dispose() = - if not disposed then - Seq.iter (fun f -> f()) disposeFuncs - disposed <- true } - - let newReader() = - if disposed then - raise <| ObjectDisposedException(this.GetType().Name) - let reader = readerFunc.Invoke() - disposeFuncs.Add reader.Dispose - reader - - let noSeparatorsSpecified = String.IsNullOrEmpty separators - let separators = if noSeparatorsSpecified then "," else separators - - let parsedCsvLines = parseIntoLines newReader separators quote hasHeaders skipRows - - // Auto-Detect tab separated files that may not have .TSV extension when no explicit separators defined - let probablyTabSeparated = - parsedCsvLines.ColumnCount < 2 && noSeparatorsSpecified && - fst parsedCsvLines.FirstLine |> Array.exists (fun c -> c.Contains("\t")) - - let parsedCsvLines = - if probablyTabSeparated - then parseIntoLines newReader "\t" quote hasHeaders skipRows - else parsedCsvLines - - // Detect header that has empty trailing column name that doesn't correspond to a column in - // the following data lines. This is checked if headers exist and the last column in the header - // is empty. The secondLine field of the parsedCsvLines record is used to store the second line - // that is read when testing the length of the first data row following the header. - let parsedCsvLines = - match parsedCsvLines.Headers with - | None -> parsedCsvLines - | Some headers -> let columnCount = parsedCsvLines.ColumnCount - if String.IsNullOrWhiteSpace headers.[columnCount-1] - then let secondline = if parsedCsvLines.LineIterator.MoveNext() then - Some (parsedCsvLines.LineIterator.Current) - else - None - match secondline with - | Some line -> let linecontents = fst line - if linecontents.Length = columnCount - 1 - then { parsedCsvLines with SecondLine = secondline; - ColumnCount = columnCount - 1; - Headers = Some headers.[..columnCount-2] } - else { parsedCsvLines with SecondLine = secondline } - | None -> parsedCsvLines - else parsedCsvLines - - let rows = - parsedCsvLines - |> parseIntoTypedRows newReader ignoreErrors (fun untypedRow -> stringArrayToRow.Invoke(this, untypedRow)) - - new CsvFile<'RowType>(rowToStringArray, - disposer, - rows, - parsedCsvLines.Headers, - parsedCsvLines.ColumnCount, - parsedCsvLines.Separators, - parsedCsvLines.Quote) - - /// Saves CSV to the specified writer - member x.Save(writer:TextWriter, [] ?separator, [] ?quote) = - - let separator = (defaultArg separator x.Separators.[0]).ToString() - let quote = (defaultArg quote x.Quote).ToString() - let doubleQuote = quote + quote - - use writer = writer - - let nullSafeguard str = - match str with - | null -> String.Empty - | _ -> str - - let writeLine writeItem (items:string[]) = - for i = 0 to items.Length-2 do - writeItem items.[i] - writer.Write separator - writeItem items.[items.Length-1] - writer.WriteLine() - - match x.Headers with - | Some headers -> headers |> writeLine writer.Write - | None -> () - - for row in x.Rows do - row |> rowToStringArray.Invoke |> writeLine (fun item -> - let item = item |> nullSafeguard - if item.Contains separator || item.Contains quote || item.Contains "\n" then - writer.Write quote - writer.Write (item.Replace(quote, doubleQuote)) - writer.Write quote - else - writer.Write item) - - /// Saves CSV to the specified stream - member x.Save(stream:Stream, [] ?separator, [] ?quote) = - use writer = new StreamWriter(stream, System.Text.UTF8Encoding(false, true), 1024, true) - x.Save(writer, ?separator=separator, ?quote=quote) - - /// Saves CSV to the specified file - member x.Save(path:string, [] ?separator, [] ?quote) = - use writer = new StreamWriter(path) - x.Save(writer, ?separator=separator, ?quote=quote) - - /// Saves CSV to a string - member x.SaveToString([] ?separator, [] ?quote) = - use writer = new StringWriter() - x.Save(writer, ?separator=separator, ?quote=quote) - writer.ToString() - - member inline private x.withRows rows = - new CsvFile<'RowType>(rowToStringArray, disposer, rows, x.Headers, x.NumberOfColumns, x.Separators, x.Quote) - - member inline private x.mapRows f = x.withRows (f x.Rows) - - /// Returns a new csv with the same rows as the original but which guarantees - /// that each row will be only be read and parsed from the input at most once. - member x.Cache() = - Seq.cache |> x.mapRows - - /// Returns a new csv where every row has been transformed by the provided mapping function. - member x.Map (mapping:Func<_,_>) = - Seq.map mapping.Invoke |> x.mapRows - - /// Returns a new csv containing only the rows for which the given predicate returns "true". - member x.Filter (predicate:Func<_,_>) = - Seq.filter predicate.Invoke |> x.mapRows - - /// Returns a new csv with only the first N rows of the underlying csv. - member x.Take count = - Seq.take count |> x.mapRows - - /// Returns a csv that, when iterated, yields rowswhile the given predicate - /// returns true, and then returns no further rows. - member x.TakeWhile (predicate:Func<_,_>) = - Seq.takeWhile predicate.Invoke |> x.mapRows - - /// Returns a csv that skips N rows and then yields the remaining rows. - member x.Skip count = - Seq.skip count |> x.mapRows - - /// Returns a csv that, when iterated, skips rows while the given predicate returns - /// true, and then yields the remaining rows. - member x.SkipWhile (predicate:Func<_,_>) = - Seq.skipWhile predicate.Invoke |> x.mapRows - - /// Returns a csv that when enumerated returns at most N rows. - member x.Truncate count = - Seq.truncate count |> x.mapRows - - /// Returns a csv with the same rows as the original plus the provided rows appended - member x.Append rows = - Seq.append x.Rows rows |> x.withRows +type CsvFile<'RowType> + private + ( + rowToStringArray: Func<'RowType, string[]>, + disposer: IDisposable, + rows: seq<'RowType>, + headers, + numberOfColumns, + separators, + quote + ) = + + /// The rows with data + member __.Rows = rows + + /// The names of the columns + member __.Headers = headers + + /// The number of columns + member __.NumberOfColumns = numberOfColumns + + /// The character(s) used as column separator(s) + member __.Separators = separators + + /// The quotation mark use for surrounding values containing separator chars + member __.Quote = quote + + interface IDisposable with + member __.Dispose() = disposer.Dispose() + + /// + [] + [] + static member CreateEmpty(rowToStringArray, rows: seq<'RowType>, headers, numberOfColumns, separators, quote) = + new CsvFile<'RowType>( + rowToStringArray, + { new IDisposable with + member x.Dispose() = () }, + rows, + headers, + numberOfColumns, + separators, + quote + ) + + /// + [] + [] + static member Create + ( + stringArrayToRow, + rowToStringArray, + reader: TextReader, + separators, + quote, + hasHeaders, + ignoreErrors, + skipRows, + cacheRows + ) = + let uncachedCsv = + new CsvFile<'RowType>( + stringArrayToRow, + rowToStringArray, + Func<_>(fun _ -> reader), + separators, + quote, + hasHeaders, + ignoreErrors, + skipRows + ) + + if cacheRows then uncachedCsv.Cache() else uncachedCsv + + /// + [] + [] + static member ParseRows(text, stringArrayToRow: Func, separators, quote, ignoreErrors) = + let reader = new StringReader(text) :> TextReader + + let csv = + CsvFile<_>.Create + (stringArrayToRow, + null, + reader, + separators, + quote, + hasHeaders = false, + ignoreErrors = ignoreErrors, + skipRows = 0, + cacheRows = false) + + csv.Rows |> Seq.toArray + + /// + new(stringArrayToRow: Func, + rowToStringArray, + readerFunc: Func, + separators, + quote, + hasHeaders, + ignoreErrors, + skipRows) as this = + + // Track created Readers so that we can dispose of all of them + let disposeFuncs = new ResizeArray<_>() + let mutable disposed = false + + let disposer = + { new IDisposable with + member x.Dispose() = + if not disposed then + Seq.iter (fun f -> f ()) disposeFuncs + disposed <- true } + + let newReader () = + if disposed then + raise + <| ObjectDisposedException(this.GetType().Name) + + let reader = readerFunc.Invoke() + disposeFuncs.Add reader.Dispose + reader + + let noSeparatorsSpecified = String.IsNullOrEmpty separators + let separators = if noSeparatorsSpecified then "," else separators + + let parsedCsvLines = parseIntoLines newReader separators quote hasHeaders skipRows + + // Auto-Detect tab separated files that may not have .TSV extension when no explicit separators defined + let probablyTabSeparated = + parsedCsvLines.ColumnCount < 2 + && noSeparatorsSpecified + && fst parsedCsvLines.FirstLine + |> Array.exists (fun c -> c.Contains("\t")) + + let parsedCsvLines = + if probablyTabSeparated then + parseIntoLines newReader "\t" quote hasHeaders skipRows + else + parsedCsvLines + + // Detect header that has empty trailing column name that doesn't correspond to a column in + // the following data lines. This is checked if headers exist and the last column in the header + // is empty. The secondLine field of the parsedCsvLines record is used to store the second line + // that is read when testing the length of the first data row following the header. + let parsedCsvLines = + match parsedCsvLines.Headers with + | None -> parsedCsvLines + | Some headers -> + let columnCount = parsedCsvLines.ColumnCount + + if String.IsNullOrWhiteSpace headers.[columnCount - 1] then + let secondline = + if parsedCsvLines.LineIterator.MoveNext() then + Some(parsedCsvLines.LineIterator.Current) + else + None + + match secondline with + | Some line -> + let linecontents = fst line + + if linecontents.Length = columnCount - 1 then + { parsedCsvLines with + SecondLine = secondline + ColumnCount = columnCount - 1 + Headers = Some headers.[.. columnCount - 2] } + else + { parsedCsvLines with SecondLine = secondline } + | None -> parsedCsvLines + else + parsedCsvLines + + let rows = + parsedCsvLines + |> parseIntoTypedRows newReader ignoreErrors (fun untypedRow -> stringArrayToRow.Invoke(this, untypedRow)) + + new CsvFile<'RowType>( + rowToStringArray, + disposer, + rows, + parsedCsvLines.Headers, + parsedCsvLines.ColumnCount, + parsedCsvLines.Separators, + parsedCsvLines.Quote + ) + + /// Saves CSV to the specified writer + member x.Save(writer: TextWriter, [] ?separator, [] ?quote) = + + let separator = (defaultArg separator x.Separators.[0]).ToString() + let quote = (defaultArg quote x.Quote).ToString() + let doubleQuote = quote + quote + + use writer = writer + + let nullSafeguard str = + match str with + | null -> String.Empty + | _ -> str + + let writeLine writeItem (items: string[]) = + for i = 0 to items.Length - 2 do + writeItem items.[i] + writer.Write separator + + writeItem items.[items.Length - 1] + writer.WriteLine() + + match x.Headers with + | Some headers -> headers |> writeLine writer.Write + | None -> () + + for row in x.Rows do + row + |> rowToStringArray.Invoke + |> writeLine (fun item -> + let item = item |> nullSafeguard + + if item.Contains separator + || item.Contains quote + || item.Contains "\n" then + writer.Write quote + writer.Write(item.Replace(quote, doubleQuote)) + writer.Write quote + else + writer.Write item) + + /// Saves CSV to the specified stream + member x.Save(stream: Stream, [] ?separator, [] ?quote) = + use writer = + new StreamWriter(stream, System.Text.UTF8Encoding(false, true), 1024, true) + + x.Save(writer, ?separator = separator, ?quote = quote) + + /// Saves CSV to the specified file + member x.Save(path: string, [] ?separator, [] ?quote) = + use writer = new StreamWriter(path) + x.Save(writer, ?separator = separator, ?quote = quote) + + /// Saves CSV to a string + member x.SaveToString([] ?separator, [] ?quote) = + use writer = new StringWriter() + x.Save(writer, ?separator = separator, ?quote = quote) + writer.ToString() + + member inline private x.withRows rows = + new CsvFile<'RowType>(rowToStringArray, disposer, rows, x.Headers, x.NumberOfColumns, x.Separators, x.Quote) + + member inline private x.mapRows f = x.withRows (f x.Rows) + + /// Returns a new csv with the same rows as the original but which guarantees + /// that each row will be only be read and parsed from the input at most once. + member x.Cache() = Seq.cache |> x.mapRows + + /// Returns a new csv where every row has been transformed by the provided mapping function. + member x.Map(mapping: Func<_, _>) = Seq.map mapping.Invoke |> x.mapRows + + /// Returns a new csv containing only the rows for which the given predicate returns "true". + member x.Filter(predicate: Func<_, _>) = + Seq.filter predicate.Invoke |> x.mapRows + + /// Returns a new csv with only the first N rows of the underlying csv. + member x.Take count = Seq.take count |> x.mapRows + + /// Returns a csv that, when iterated, yields rowswhile the given predicate + /// returns true, and then returns no further rows. + member x.TakeWhile(predicate: Func<_, _>) = + Seq.takeWhile predicate.Invoke |> x.mapRows + + /// Returns a csv that skips N rows and then yields the remaining rows. + member x.Skip count = Seq.skip count |> x.mapRows + + /// Returns a csv that, when iterated, skips rows while the given predicate returns + /// true, and then yields the remaining rows. + member x.SkipWhile(predicate: Func<_, _>) = + Seq.skipWhile predicate.Invoke |> x.mapRows + + /// Returns a csv that when enumerated returns at most N rows. + member x.Truncate count = Seq.truncate count |> x.mapRows + + /// Returns a csv with the same rows as the original plus the provided rows appended + member x.Append rows = Seq.append x.Rows rows |> x.withRows diff --git a/src/Html/HtmlActivePatterns.fs b/src/Html/HtmlActivePatterns.fs index 2225a7969..c2b3cd45a 100644 --- a/src/Html/HtmlActivePatterns.fs +++ b/src/Html/HtmlActivePatterns.fs @@ -1,13 +1,13 @@ namespace FSharp.Data module HtmlActivePatterns = - let (|HtmlElement|HtmlText|HtmlComment|HtmlCData|) (node:HtmlNode) = + let (|HtmlElement|HtmlText|HtmlComment|HtmlCData|) (node: HtmlNode) = match node with - | HtmlNode.HtmlText content -> HtmlText (content) - | HtmlNode.HtmlComment content -> HtmlComment (content) - | HtmlNode.HtmlCData content -> HtmlCData (content) - | HtmlNode.HtmlElement(name, attributes, elements) -> HtmlElement(name,attributes,elements) + | HtmlNode.HtmlText content -> HtmlText(content) + | HtmlNode.HtmlComment content -> HtmlComment(content) + | HtmlNode.HtmlCData content -> HtmlCData(content) + | HtmlNode.HtmlElement (name, attributes, elements) -> HtmlElement(name, attributes, elements) - let (|HtmlAttribute|) (attribute:HtmlAttribute) = + let (|HtmlAttribute|) (attribute: HtmlAttribute) = match attribute with - | HtmlAttribute.HtmlAttribute (name, value) -> HtmlAttribute (name, value) + | HtmlAttribute.HtmlAttribute (name, value) -> HtmlAttribute(name, value) diff --git a/src/Html/HtmlCharRefs.fs b/src/Html/HtmlCharRefs.fs index 899203501..deb5a1389 100644 --- a/src/Html/HtmlCharRefs.fs +++ b/src/Html/HtmlCharRefs.fs @@ -3,2271 +3,2277 @@ open System open System.Globalization -module internal HtmlCharRefs = +module internal HtmlCharRefs = - let private refs = - [| - "Á", "\u00C1"; - "Á", "\u00C1"; - "á", "\u00E1"; - "á", "\u00E1"; - "Ă", "\u0102"; - "ă", "\u0103"; - "∾", "\u223E"; - "∿", "\u223F"; - "∾̳", "\u223E\u0333"; - "Â", "\u00C2"; - "Â", "\u00C2"; - "â", "\u00E2"; - "â", "\u00E2"; - "´", "\u00B4"; - "´", "\u00B4"; - "А", "\u0410"; - "а", "\u0430"; - "Æ", "\u00C6"; - "Æ", "\u00C6"; - "æ", "\u00E6"; - "æ", "\u00E6"; - "⁡", "\u2061"; - "𝔄", "\uD835\uDD04"; - "𝔞", "\uD835\uDD1E"; - "À", "\u00C0"; - "À", "\u00C0"; - "à", "\u00E0"; - "à", "\u00E0"; - "ℵ", "\u2135"; - "ℵ", "\u2135"; - "Α", "\u0391"; - "α", "\u03B1"; - "Ā", "\u0100"; - "ā", "\u0101"; - "⨿", "\u2A3F"; - "&", "\u0026"; - "&", "\u0026"; - "&", "\u0026"; - "&", "\u0026"; - "⩕", "\u2A55"; - "⩓", "\u2A53"; - "∧", "\u2227"; - "⩜", "\u2A5C"; - "⩘", "\u2A58"; - "⩚", "\u2A5A"; - "∠", "\u2220"; - "⦤", "\u29A4"; - "∠", "\u2220"; - "⦨", "\u29A8"; - "⦩", "\u29A9"; - "⦪", "\u29AA"; - "⦫", "\u29AB"; - "⦬", "\u29AC"; - "⦭", "\u29AD"; - "⦮", "\u29AE"; - "⦯", "\u29AF"; - "∡", "\u2221"; - "∟", "\u221F"; - "⊾", "\u22BE"; - "⦝", "\u299D"; - "∢", "\u2222"; - "Å", "\u00C5"; - "⍼", "\u237C"; - "Ą", "\u0104"; - "ą", "\u0105"; - "𝔸", "\uD835\uDD38"; - "𝕒", "\uD835\uDD52"; - "⩯", "\u2A6F"; - "≈", "\u2248"; - "⩰", "\u2A70"; - "≊", "\u224A"; - "≋", "\u224B"; - "'", "\u0027"; - "⁡", "\u2061"; - "≈", "\u2248"; - "≊", "\u224A"; - "Å", "\u00C5"; - "Å", "\u00C5"; - "å", "\u00E5"; - "å", "\u00E5"; - "𝒜", "\uD835\uDC9C"; - "𝒶", "\uD835\uDCB6"; - "≔", "\u2254"; - "*", "\u002A"; - "≈", "\u2248"; - "≍", "\u224D"; - "Ã", "\u00C3"; - "Ã", "\u00C3"; - "ã", "\u00E3"; - "ã", "\u00E3"; - "Ä", "\u00C4"; - "Ä", "\u00C4"; - "ä", "\u00E4"; - "ä", "\u00E4"; - "∳", "\u2233"; - "⨑", "\u2A11"; - "≌", "\u224C"; - "϶", "\u03F6"; - "‵", "\u2035"; - "∽", "\u223D"; - "⋍", "\u22CD"; - "∖", "\u2216"; - "⫧", "\u2AE7"; - "⊽", "\u22BD"; - "⌅", "\u2305"; - "⌆", "\u2306"; - "⌅", "\u2305"; - "⎵", "\u23B5"; - "⎶", "\u23B6"; - "≌", "\u224C"; - "Б", "\u0411"; - "б", "\u0431"; - "„", "\u201E"; - "∵", "\u2235"; - "∵", "\u2235"; - "∵", "\u2235"; - "⦰", "\u29B0"; - "϶", "\u03F6"; - "ℬ", "\u212C"; - "ℬ", "\u212C"; - "Β", "\u0392"; - "β", "\u03B2"; - "ℶ", "\u2136"; - "≬", "\u226C"; - "𝔅", "\uD835\uDD05"; - "𝔟", "\uD835\uDD1F"; - "⋂", "\u22C2"; - "◯", "\u25EF"; - "⋃", "\u22C3"; - "⨀", "\u2A00"; - "⨁", "\u2A01"; - "⨂", "\u2A02"; - "⨆", "\u2A06"; - "★", "\u2605"; - "▽", "\u25BD"; - "△", "\u25B3"; - "⨄", "\u2A04"; - "⋁", "\u22C1"; - "⋀", "\u22C0"; - "⤍", "\u290D"; - "⧫", "\u29EB"; - "▪", "\u25AA"; - "▴", "\u25B4"; - "▾", "\u25BE"; - "◂", "\u25C2"; - "▸", "\u25B8"; - "␣", "\u2423"; - "▒", "\u2592"; - "░", "\u2591"; - "▓", "\u2593"; - "█", "\u2588"; - "=⃥", "\u003D\u20E5"; - "≡⃥", "\u2261\u20E5"; - "⫭", "\u2AED"; - "⌐", "\u2310"; - "𝔹", "\uD835\uDD39"; - "𝕓", "\uD835\uDD53"; - "⊥", "\u22A5"; - "⊥", "\u22A5"; - "⋈", "\u22C8"; - "⧉", "\u29C9"; - "┐", "\u2510"; - "╕", "\u2555"; - "╖", "\u2556"; - "╗", "\u2557"; - "┌", "\u250C"; - "╒", "\u2552"; - "╓", "\u2553"; - "╔", "\u2554"; - "─", "\u2500"; - "═", "\u2550"; - "┬", "\u252C"; - "╤", "\u2564"; - "╥", "\u2565"; - "╦", "\u2566"; - "┴", "\u2534"; - "╧", "\u2567"; - "╨", "\u2568"; - "╩", "\u2569"; - "⊟", "\u229F"; - "⊞", "\u229E"; - "⊠", "\u22A0"; - "┘", "\u2518"; - "╛", "\u255B"; - "╜", "\u255C"; - "╝", "\u255D"; - "└", "\u2514"; - "╘", "\u2558"; - "╙", "\u2559"; - "╚", "\u255A"; - "│", "\u2502"; - "║", "\u2551"; - "┼", "\u253C"; - "╪", "\u256A"; - "╫", "\u256B"; - "╬", "\u256C"; - "┤", "\u2524"; - "╡", "\u2561"; - "╢", "\u2562"; - "╣", "\u2563"; - "├", "\u251C"; - "╞", "\u255E"; - "╟", "\u255F"; - "╠", "\u2560"; - "‵", "\u2035"; - "˘", "\u02D8"; - "˘", "\u02D8"; - "¦", "\u00A6"; - "¦", "\u00A6"; - "𝒷", "\uD835\uDCB7"; - "ℬ", "\u212C"; - "⁏", "\u204F"; - "∽", "\u223D"; - "⋍", "\u22CD"; - "⧅", "\u29C5"; - "\", "\u005C"; - "⟈", "\u27C8"; - "•", "\u2022"; - "•", "\u2022"; - "≎", "\u224E"; - "⪮", "\u2AAE"; - "≏", "\u224F"; - "≎", "\u224E"; - "≏", "\u224F"; - "Ć", "\u0106"; - "ć", "\u0107"; - "⩄", "\u2A44"; - "⩉", "\u2A49"; - "⩋", "\u2A4B"; - "∩", "\u2229"; - "⋒", "\u22D2"; - "⩇", "\u2A47"; - "⩀", "\u2A40"; - "ⅅ", "\u2145"; - "∩︀", "\u2229\uFE00"; - "⁁", "\u2041"; - "ˇ", "\u02C7"; - "ℭ", "\u212D"; - "⩍", "\u2A4D"; - "Č", "\u010C"; - "č", "\u010D"; - "Ç", "\u00C7"; - "Ç", "\u00C7"; - "ç", "\u00E7"; - "ç", "\u00E7"; - "Ĉ", "\u0108"; - "ĉ", "\u0109"; - "∰", "\u2230"; - "⩌", "\u2A4C"; - "⩐", "\u2A50"; - "Ċ", "\u010A"; - "ċ", "\u010B"; - "¸", "\u00B8"; - "¸", "\u00B8"; - "¸", "\u00B8"; - "⦲", "\u29B2"; - "¢", "\u00A2"; - "¢", "\u00A2"; - "·", "\u00B7"; - "·", "\u00B7"; - "𝔠", "\uD835\uDD20"; - "ℭ", "\u212D"; - "Ч", "\u0427"; - "ч", "\u0447"; - "✓", "\u2713"; - "✓", "\u2713"; - "Χ", "\u03A7"; - "χ", "\u03C7"; - "ˆ", "\u02C6"; - "≗", "\u2257"; - "↺", "\u21BA"; - "↻", "\u21BB"; - "⊛", "\u229B"; - "⊚", "\u229A"; - "⊝", "\u229D"; - "⊙", "\u2299"; - "®", "\u00AE"; - "Ⓢ", "\u24C8"; - "⊖", "\u2296"; - "⊕", "\u2295"; - "⊗", "\u2297"; - "○", "\u25CB"; - "⧃", "\u29C3"; - "≗", "\u2257"; - "⨐", "\u2A10"; - "⫯", "\u2AEF"; - "⧂", "\u29C2"; - "∲", "\u2232"; - "”", "\u201D"; - "’", "\u2019"; - "♣", "\u2663"; - "♣", "\u2663"; - ":", "\u003A"; - "∷", "\u2237"; - "⩴", "\u2A74"; - "≔", "\u2254"; - "≔", "\u2254"; - ",", "\u002C"; - "@", "\u0040"; - "∁", "\u2201"; - "∘", "\u2218"; - "∁", "\u2201"; - "ℂ", "\u2102"; - "≅", "\u2245"; - "⩭", "\u2A6D"; - "≡", "\u2261"; - "∮", "\u222E"; - "∯", "\u222F"; - "∮", "\u222E"; - "𝕔", "\uD835\uDD54"; - "ℂ", "\u2102"; - "∐", "\u2210"; - "∐", "\u2210"; - "©", "\u00A9"; - "©", "\u00A9"; - "©", "\u00A9"; - "©", "\u00A9"; - "℗", "\u2117"; - "∳", "\u2233"; - "↵", "\u21B5"; - "✗", "\u2717"; - "⨯", "\u2A2F"; - "𝒞", "\uD835\uDC9E"; - "𝒸", "\uD835\uDCB8"; - "⫏", "\u2ACF"; - "⫑", "\u2AD1"; - "⫐", "\u2AD0"; - "⫒", "\u2AD2"; - "⋯", "\u22EF"; - "⤸", "\u2938"; - "⤵", "\u2935"; - "⋞", "\u22DE"; - "⋟", "\u22DF"; - "↶", "\u21B6"; - "⤽", "\u293D"; - "⩈", "\u2A48"; - "⩆", "\u2A46"; - "≍", "\u224D"; - "∪", "\u222A"; - "⋓", "\u22D3"; - "⩊", "\u2A4A"; - "⊍", "\u228D"; - "⩅", "\u2A45"; - "∪︀", "\u222A\uFE00"; - "↷", "\u21B7"; - "⤼", "\u293C"; - "⋞", "\u22DE"; - "⋟", "\u22DF"; - "⋎", "\u22CE"; - "⋏", "\u22CF"; - "¤", "\u00A4"; - "¤", "\u00A4"; - "↶", "\u21B6"; - "↷", "\u21B7"; - "⋎", "\u22CE"; - "⋏", "\u22CF"; - "∲", "\u2232"; - "∱", "\u2231"; - "⌭", "\u232D"; - "†", "\u2020"; - "‡", "\u2021"; - "ℸ", "\u2138"; - "↓", "\u2193"; - "↡", "\u21A1"; - "⇓", "\u21D3"; - "‐", "\u2010"; - "⫤", "\u2AE4"; - "⊣", "\u22A3"; - "⤏", "\u290F"; - "˝", "\u02DD"; - "Ď", "\u010E"; - "ď", "\u010F"; - "Д", "\u0414"; - "д", "\u0434"; - "‡", "\u2021"; - "⇊", "\u21CA"; - "ⅅ", "\u2145"; - "ⅆ", "\u2146"; - "⤑", "\u2911"; - "⩷", "\u2A77"; - "°", "\u00B0"; - "°", "\u00B0"; - "∇", "\u2207"; - "Δ", "\u0394"; - "δ", "\u03B4"; - "⦱", "\u29B1"; - "⥿", "\u297F"; - "𝔇", "\uD835\uDD07"; - "𝔡", "\uD835\uDD21"; - "⥥", "\u2965"; - "⇃", "\u21C3"; - "⇂", "\u21C2"; - "´", "\u00B4"; - "˙", "\u02D9"; - "˝", "\u02DD"; - "`", "\u0060"; - "˜", "\u02DC"; - "⋄", "\u22C4"; - "⋄", "\u22C4"; - "⋄", "\u22C4"; - "♦", "\u2666"; - "♦", "\u2666"; - "¨", "\u00A8"; - "ⅆ", "\u2146"; - "ϝ", "\u03DD"; - "⋲", "\u22F2"; - "÷", "\u00F7"; - "÷", "\u00F7"; - "÷", "\u00F7"; - "⋇", "\u22C7"; - "⋇", "\u22C7"; - "Ђ", "\u0402"; - "ђ", "\u0452"; - "⌞", "\u231E"; - "⌍", "\u230D"; - "$", "\u0024"; - "𝔻", "\uD835\uDD3B"; - "𝕕", "\uD835\uDD55"; - "¨", "\u00A8"; - "˙", "\u02D9"; - "⃜", "\u20DC"; - "≐", "\u2250"; - "≑", "\u2251"; - "≐", "\u2250"; - "∸", "\u2238"; - "∔", "\u2214"; - "⊡", "\u22A1"; - "⌆", "\u2306"; - "∯", "\u222F"; - "¨", "\u00A8"; - "⇓", "\u21D3"; - "⇐", "\u21D0"; - "⇔", "\u21D4"; - "⫤", "\u2AE4"; - "⟸", "\u27F8"; - "⟺", "\u27FA"; - "⟹", "\u27F9"; - "⇒", "\u21D2"; - "⊨", "\u22A8"; - "⇑", "\u21D1"; - "⇕", "\u21D5"; - "∥", "\u2225"; - "⤓", "\u2913"; - "↓", "\u2193"; - "↓", "\u2193"; - "⇓", "\u21D3"; - "⇵", "\u21F5"; - "̑", "\u0311"; - "⇊", "\u21CA"; - "⇃", "\u21C3"; - "⇂", "\u21C2"; - "⥐", "\u2950"; - "⥞", "\u295E"; - "⥖", "\u2956"; - "↽", "\u21BD"; - "⥟", "\u295F"; - "⥗", "\u2957"; - "⇁", "\u21C1"; - "↧", "\u21A7"; - "⊤", "\u22A4"; - "⤐", "\u2910"; - "⌟", "\u231F"; - "⌌", "\u230C"; - "𝒟", "\uD835\uDC9F"; - "𝒹", "\uD835\uDCB9"; - "Ѕ", "\u0405"; - "ѕ", "\u0455"; - "⧶", "\u29F6"; - "Đ", "\u0110"; - "đ", "\u0111"; - "⋱", "\u22F1"; - "▿", "\u25BF"; - "▾", "\u25BE"; - "⇵", "\u21F5"; - "⥯", "\u296F"; - "⦦", "\u29A6"; - "Џ", "\u040F"; - "џ", "\u045F"; - "⟿", "\u27FF"; - "É", "\u00C9"; - "É", "\u00C9"; - "é", "\u00E9"; - "é", "\u00E9"; - "⩮", "\u2A6E"; - "Ě", "\u011A"; - "ě", "\u011B"; - "Ê", "\u00CA"; - "Ê", "\u00CA"; - "ê", "\u00EA"; - "ê", "\u00EA"; - "≖", "\u2256"; - "≕", "\u2255"; - "Э", "\u042D"; - "э", "\u044D"; - "⩷", "\u2A77"; - "Ė", "\u0116"; - "ė", "\u0117"; - "≑", "\u2251"; - "ⅇ", "\u2147"; - "≒", "\u2252"; - "𝔈", "\uD835\uDD08"; - "𝔢", "\uD835\uDD22"; - "⪚", "\u2A9A"; - "È", "\u00C8"; - "È", "\u00C8"; - "è", "\u00E8"; - "è", "\u00E8"; - "⪖", "\u2A96"; - "⪘", "\u2A98"; - "⪙", "\u2A99"; - "∈", "\u2208"; - "⏧", "\u23E7"; - "ℓ", "\u2113"; - "⪕", "\u2A95"; - "⪗", "\u2A97"; - "Ē", "\u0112"; - "ē", "\u0113"; - "∅", "\u2205"; - "∅", "\u2205"; - "◻", "\u25FB"; - "∅", "\u2205"; - "▫", "\u25AB"; - " ", "\u2004"; - " ", "\u2005"; - " ", "\u2003"; - "Ŋ", "\u014A"; - "ŋ", "\u014B"; - " ", "\u2002"; - "Ę", "\u0118"; - "ę", "\u0119"; - "𝔼", "\uD835\uDD3C"; - "𝕖", "\uD835\uDD56"; - "⋕", "\u22D5"; - "⧣", "\u29E3"; - "⩱", "\u2A71"; - "ε", "\u03B5"; - "Ε", "\u0395"; - "ε", "\u03B5"; - "ϵ", "\u03F5"; - "≖", "\u2256"; - "≕", "\u2255"; - "≂", "\u2242"; - "⪖", "\u2A96"; - "⪕", "\u2A95"; - "⩵", "\u2A75"; - "=", "\u003D"; - "≂", "\u2242"; - "≟", "\u225F"; - "⇌", "\u21CC"; - "≡", "\u2261"; - "⩸", "\u2A78"; - "⧥", "\u29E5"; - "⥱", "\u2971"; - "≓", "\u2253"; - "ℯ", "\u212F"; - "ℰ", "\u2130"; - "≐", "\u2250"; - "⩳", "\u2A73"; - "≂", "\u2242"; - "Η", "\u0397"; - "η", "\u03B7"; - "Ð", "\u00D0"; - "Ð", "\u00D0"; - "ð", "\u00F0"; - "ð", "\u00F0"; - "Ë", "\u00CB"; - "Ë", "\u00CB"; - "ë", "\u00EB"; - "ë", "\u00EB"; - "€", "\u20AC"; - "!", "\u0021"; - "∃", "\u2203"; - "∃", "\u2203"; - "ℰ", "\u2130"; - "ⅇ", "\u2147"; - "ⅇ", "\u2147"; - "≒", "\u2252"; - "Ф", "\u0424"; - "ф", "\u0444"; - "♀", "\u2640"; - "ffi", "\uFB03"; - "ff", "\uFB00"; - "ffl", "\uFB04"; - "𝔉", "\uD835\uDD09"; - "𝔣", "\uD835\uDD23"; - "fi", "\uFB01"; - "◼", "\u25FC"; - "▪", "\u25AA"; - "fj", "\u0066\u006A"; - "♭", "\u266D"; - "fl", "\uFB02"; - "▱", "\u25B1"; - "ƒ", "\u0192"; - "𝔽", "\uD835\uDD3D"; - "𝕗", "\uD835\uDD57"; - "∀", "\u2200"; - "∀", "\u2200"; - "⋔", "\u22D4"; - "⫙", "\u2AD9"; - "ℱ", "\u2131"; - "⨍", "\u2A0D"; - "½", "\u00BD"; - "½", "\u00BD"; - "⅓", "\u2153"; - "¼", "\u00BC"; - "¼", "\u00BC"; - "⅕", "\u2155"; - "⅙", "\u2159"; - "⅛", "\u215B"; - "⅔", "\u2154"; - "⅖", "\u2156"; - "¾", "\u00BE"; - "¾", "\u00BE"; - "⅗", "\u2157"; - "⅜", "\u215C"; - "⅘", "\u2158"; - "⅚", "\u215A"; - "⅝", "\u215D"; - "⅞", "\u215E"; - "⁄", "\u2044"; - "⌢", "\u2322"; - "𝒻", "\uD835\uDCBB"; - "ℱ", "\u2131"; - "ǵ", "\u01F5"; - "Γ", "\u0393"; - "γ", "\u03B3"; - "Ϝ", "\u03DC"; - "ϝ", "\u03DD"; - "⪆", "\u2A86"; - "Ğ", "\u011E"; - "ğ", "\u011F"; - "Ģ", "\u0122"; - "Ĝ", "\u011C"; - "ĝ", "\u011D"; - "Г", "\u0413"; - "г", "\u0433"; - "Ġ", "\u0120"; - "ġ", "\u0121"; - "≥", "\u2265"; - "≧", "\u2267"; - "⪌", "\u2A8C"; - "⋛", "\u22DB"; - "≥", "\u2265"; - "≧", "\u2267"; - "⩾", "\u2A7E"; - "⪩", "\u2AA9"; - "⩾", "\u2A7E"; - "⪀", "\u2A80"; - "⪂", "\u2A82"; - "⪄", "\u2A84"; - "⋛︀", "\u22DB\uFE00"; - "⪔", "\u2A94"; - "𝔊", "\uD835\uDD0A"; - "𝔤", "\uD835\uDD24"; - "≫", "\u226B"; - "⋙", "\u22D9"; - "⋙", "\u22D9"; - "ℷ", "\u2137"; - "Ѓ", "\u0403"; - "ѓ", "\u0453"; - "⪥", "\u2AA5"; - "≷", "\u2277"; - "⪒", "\u2A92"; - "⪤", "\u2AA4"; - "⪊", "\u2A8A"; - "⪊", "\u2A8A"; - "⪈", "\u2A88"; - "≩", "\u2269"; - "⪈", "\u2A88"; - "≩", "\u2269"; - "⋧", "\u22E7"; - "𝔾", "\uD835\uDD3E"; - "𝕘", "\uD835\uDD58"; - "`", "\u0060"; - "≥", "\u2265"; - "⋛", "\u22DB"; - "≧", "\u2267"; - "⪢", "\u2AA2"; - "≷", "\u2277"; - "⩾", "\u2A7E"; - "≳", "\u2273"; - "𝒢", "\uD835\uDCA2"; - "ℊ", "\u210A"; - "≳", "\u2273"; - "⪎", "\u2A8E"; - "⪐", "\u2A90"; - "⪧", "\u2AA7"; - "⩺", "\u2A7A"; - ">", "\u003E"; - ">", "\u003E"; - ">", "\u003E"; - ">", "\u003E"; - "≫", "\u226B"; - "⋗", "\u22D7"; - "⦕", "\u2995"; - "⩼", "\u2A7C"; - "⪆", "\u2A86"; - "⥸", "\u2978"; - "⋗", "\u22D7"; - "⋛", "\u22DB"; - "⪌", "\u2A8C"; - "≷", "\u2277"; - "≳", "\u2273"; - "≩︀", "\u2269\uFE00"; - "≩︀", "\u2269\uFE00"; - "ˇ", "\u02C7"; - " ", "\u200A"; - "½", "\u00BD"; - "ℋ", "\u210B"; - "Ъ", "\u042A"; - "ъ", "\u044A"; - "⥈", "\u2948"; - "↔", "\u2194"; - "⇔", "\u21D4"; - "↭", "\u21AD"; - "^", "\u005E"; - "ℏ", "\u210F"; - "Ĥ", "\u0124"; - "ĥ", "\u0125"; - "♥", "\u2665"; - "♥", "\u2665"; - "…", "\u2026"; - "⊹", "\u22B9"; - "𝔥", "\uD835\uDD25"; - "ℌ", "\u210C"; - "ℋ", "\u210B"; - "⤥", "\u2925"; - "⤦", "\u2926"; - "⇿", "\u21FF"; - "∻", "\u223B"; - "↩", "\u21A9"; - "↪", "\u21AA"; - "𝕙", "\uD835\uDD59"; - "ℍ", "\u210D"; - "―", "\u2015"; - "─", "\u2500"; - "𝒽", "\uD835\uDCBD"; - "ℋ", "\u210B"; - "ℏ", "\u210F"; - "Ħ", "\u0126"; - "ħ", "\u0127"; - "≎", "\u224E"; - "≏", "\u224F"; - "⁃", "\u2043"; - "‐", "\u2010"; - "Í", "\u00CD"; - "Í", "\u00CD"; - "í", "\u00ED"; - "í", "\u00ED"; - "⁣", "\u2063"; - "Î", "\u00CE"; - "Î", "\u00CE"; - "î", "\u00EE"; - "î", "\u00EE"; - "И", "\u0418"; - "и", "\u0438"; - "İ", "\u0130"; - "Е", "\u0415"; - "е", "\u0435"; - "¡", "\u00A1"; - "¡", "\u00A1"; - "⇔", "\u21D4"; - "𝔦", "\uD835\uDD26"; - "ℑ", "\u2111"; - "Ì", "\u00CC"; - "Ì", "\u00CC"; - "ì", "\u00EC"; - "ì", "\u00EC"; - "ⅈ", "\u2148"; - "⨌", "\u2A0C"; - "∭", "\u222D"; - "⧜", "\u29DC"; - "℩", "\u2129"; - "IJ", "\u0132"; - "ij", "\u0133"; - "Ī", "\u012A"; - "ī", "\u012B"; - "ℑ", "\u2111"; - "ⅈ", "\u2148"; - "ℐ", "\u2110"; - "ℑ", "\u2111"; - "ı", "\u0131"; - "ℑ", "\u2111"; - "⊷", "\u22B7"; - "Ƶ", "\u01B5"; - "⇒", "\u21D2"; - "℅", "\u2105"; - "∈", "\u2208"; - "∞", "\u221E"; - "⧝", "\u29DD"; - "ı", "\u0131"; - "⊺", "\u22BA"; - "∫", "\u222B"; - "∬", "\u222C"; - "ℤ", "\u2124"; - "∫", "\u222B"; - "⊺", "\u22BA"; - "⋂", "\u22C2"; - "⨗", "\u2A17"; - "⨼", "\u2A3C"; - "⁣", "\u2063"; - "⁢", "\u2062"; - "Ё", "\u0401"; - "ё", "\u0451"; - "Į", "\u012E"; - "į", "\u012F"; - "𝕀", "\uD835\uDD40"; - "𝕚", "\uD835\uDD5A"; - "Ι", "\u0399"; - "ι", "\u03B9"; - "⨼", "\u2A3C"; - "¿", "\u00BF"; - "¿", "\u00BF"; - "𝒾", "\uD835\uDCBE"; - "ℐ", "\u2110"; - "∈", "\u2208"; - "⋵", "\u22F5"; - "⋹", "\u22F9"; - "⋴", "\u22F4"; - "⋳", "\u22F3"; - "∈", "\u2208"; - "⁢", "\u2062"; - "Ĩ", "\u0128"; - "ĩ", "\u0129"; - "І", "\u0406"; - "і", "\u0456"; - "Ï", "\u00CF"; - "Ï", "\u00CF"; - "ï", "\u00EF"; - "ï", "\u00EF"; - "Ĵ", "\u0134"; - "ĵ", "\u0135"; - "Й", "\u0419"; - "й", "\u0439"; - "𝔍", "\uD835\uDD0D"; - "𝔧", "\uD835\uDD27"; - "ȷ", "\u0237"; - "𝕁", "\uD835\uDD41"; - "𝕛", "\uD835\uDD5B"; - "𝒥", "\uD835\uDCA5"; - "𝒿", "\uD835\uDCBF"; - "Ј", "\u0408"; - "ј", "\u0458"; - "Є", "\u0404"; - "є", "\u0454"; - "Κ", "\u039A"; - "κ", "\u03BA"; - "ϰ", "\u03F0"; - "Ķ", "\u0136"; - "ķ", "\u0137"; - "К", "\u041A"; - "к", "\u043A"; - "𝔎", "\uD835\uDD0E"; - "𝔨", "\uD835\uDD28"; - "ĸ", "\u0138"; - "Х", "\u0425"; - "х", "\u0445"; - "Ќ", "\u040C"; - "ќ", "\u045C"; - "𝕂", "\uD835\uDD42"; - "𝕜", "\uD835\uDD5C"; - "𝒦", "\uD835\uDCA6"; - "𝓀", "\uD835\uDCC0"; - "⇚", "\u21DA"; - "Ĺ", "\u0139"; - "ĺ", "\u013A"; - "⦴", "\u29B4"; - "ℒ", "\u2112"; - "Λ", "\u039B"; - "λ", "\u03BB"; - "⟨", "\u27E8"; - "⟪", "\u27EA"; - "⦑", "\u2991"; - "⟨", "\u27E8"; - "⪅", "\u2A85"; - "ℒ", "\u2112"; - "«", "\u00AB"; - "«", "\u00AB"; - "⇤", "\u21E4"; - "⤟", "\u291F"; - "←", "\u2190"; - "↞", "\u219E"; - "⇐", "\u21D0"; - "⤝", "\u291D"; - "↩", "\u21A9"; - "↫", "\u21AB"; - "⤹", "\u2939"; - "⥳", "\u2973"; - "↢", "\u21A2"; - "⤙", "\u2919"; - "⤛", "\u291B"; - "⪫", "\u2AAB"; - "⪭", "\u2AAD"; - "⪭︀", "\u2AAD\uFE00"; - "⤌", "\u290C"; - "⤎", "\u290E"; - "❲", "\u2772"; - "{", "\u007B"; - "[", "\u005B"; - "⦋", "\u298B"; - "⦏", "\u298F"; - "⦍", "\u298D"; - "Ľ", "\u013D"; - "ľ", "\u013E"; - "Ļ", "\u013B"; - "ļ", "\u013C"; - "⌈", "\u2308"; - "{", "\u007B"; - "Л", "\u041B"; - "л", "\u043B"; - "⤶", "\u2936"; - "“", "\u201C"; - "„", "\u201E"; - "⥧", "\u2967"; - "⥋", "\u294B"; - "↲", "\u21B2"; - "≤", "\u2264"; - "≦", "\u2266"; - "⟨", "\u27E8"; - "⇤", "\u21E4"; - "←", "\u2190"; - "←", "\u2190"; - "⇐", "\u21D0"; - "⇆", "\u21C6"; - "↢", "\u21A2"; - "⌈", "\u2308"; - "⟦", "\u27E6"; - "⥡", "\u2961"; - "⥙", "\u2959"; - "⇃", "\u21C3"; - "⌊", "\u230A"; - "↽", "\u21BD"; - "↼", "\u21BC"; - "⇇", "\u21C7"; - "↔", "\u2194"; - "↔", "\u2194"; - "⇔", "\u21D4"; - "⇆", "\u21C6"; - "⇋", "\u21CB"; - "↭", "\u21AD"; - "⥎", "\u294E"; - "↤", "\u21A4"; - "⊣", "\u22A3"; - "⥚", "\u295A"; - "⋋", "\u22CB"; - "⧏", "\u29CF"; - "⊲", "\u22B2"; - "⊴", "\u22B4"; - "⥑", "\u2951"; - "⥠", "\u2960"; - "⥘", "\u2958"; - "↿", "\u21BF"; - "⥒", "\u2952"; - "↼", "\u21BC"; - "⪋", "\u2A8B"; - "⋚", "\u22DA"; - "≤", "\u2264"; - "≦", "\u2266"; - "⩽", "\u2A7D"; - "⪨", "\u2AA8"; - "⩽", "\u2A7D"; - "⩿", "\u2A7F"; - "⪁", "\u2A81"; - "⪃", "\u2A83"; - "⋚︀", "\u22DA\uFE00"; - "⪓", "\u2A93"; - "⪅", "\u2A85"; - "⋖", "\u22D6"; - "⋚", "\u22DA"; - "⪋", "\u2A8B"; - "⋚", "\u22DA"; - "≦", "\u2266"; - "≶", "\u2276"; - "≶", "\u2276"; - "⪡", "\u2AA1"; - "≲", "\u2272"; - "⩽", "\u2A7D"; - "≲", "\u2272"; - "⥼", "\u297C"; - "⌊", "\u230A"; - "𝔏", "\uD835\uDD0F"; - "𝔩", "\uD835\uDD29"; - "≶", "\u2276"; - "⪑", "\u2A91"; - "⥢", "\u2962"; - "↽", "\u21BD"; - "↼", "\u21BC"; - "⥪", "\u296A"; - "▄", "\u2584"; - "Љ", "\u0409"; - "љ", "\u0459"; - "⇇", "\u21C7"; - "≪", "\u226A"; - "⋘", "\u22D8"; - "⌞", "\u231E"; - "⇚", "\u21DA"; - "⥫", "\u296B"; - "◺", "\u25FA"; - "Ŀ", "\u013F"; - "ŀ", "\u0140"; - "⎰", "\u23B0"; - "⎰", "\u23B0"; - "⪉", "\u2A89"; - "⪉", "\u2A89"; - "⪇", "\u2A87"; - "≨", "\u2268"; - "⪇", "\u2A87"; - "≨", "\u2268"; - "⋦", "\u22E6"; - "⟬", "\u27EC"; - "⇽", "\u21FD"; - "⟦", "\u27E6"; - "⟵", "\u27F5"; - "⟵", "\u27F5"; - "⟸", "\u27F8"; - "⟷", "\u27F7"; - "⟷", "\u27F7"; - "⟺", "\u27FA"; - "⟼", "\u27FC"; - "⟶", "\u27F6"; - "⟶", "\u27F6"; - "⟹", "\u27F9"; - "↫", "\u21AB"; - "↬", "\u21AC"; - "⦅", "\u2985"; - "𝕃", "\uD835\uDD43"; - "𝕝", "\uD835\uDD5D"; - "⨭", "\u2A2D"; - "⨴", "\u2A34"; - "∗", "\u2217"; - "_", "\u005F"; - "↙", "\u2199"; - "↘", "\u2198"; - "◊", "\u25CA"; - "◊", "\u25CA"; - "⧫", "\u29EB"; - "(", "\u0028"; - "⦓", "\u2993"; - "⇆", "\u21C6"; - "⌟", "\u231F"; - "⇋", "\u21CB"; - "⥭", "\u296D"; - "‎", "\u200E"; - "⊿", "\u22BF"; - "‹", "\u2039"; - "𝓁", "\uD835\uDCC1"; - "ℒ", "\u2112"; - "↰", "\u21B0"; - "↰", "\u21B0"; - "≲", "\u2272"; - "⪍", "\u2A8D"; - "⪏", "\u2A8F"; - "[", "\u005B"; - "‘", "\u2018"; - "‚", "\u201A"; - "Ł", "\u0141"; - "ł", "\u0142"; - "⪦", "\u2AA6"; - "⩹", "\u2A79"; - "<", "\u003C"; - "<", "\u003C"; - "<", "\u003C"; - "<", "\u003C"; - "≪", "\u226A"; - "⋖", "\u22D6"; - "⋋", "\u22CB"; - "⋉", "\u22C9"; - "⥶", "\u2976"; - "⩻", "\u2A7B"; - "◃", "\u25C3"; - "⊴", "\u22B4"; - "◂", "\u25C2"; - "⦖", "\u2996"; - "⥊", "\u294A"; - "⥦", "\u2966"; - "≨︀", "\u2268\uFE00"; - "≨︀", "\u2268\uFE00"; - "¯", "\u00AF"; - "¯", "\u00AF"; - "♂", "\u2642"; - "✠", "\u2720"; - "✠", "\u2720"; - "⤅", "\u2905"; - "↦", "\u21A6"; - "↦", "\u21A6"; - "↧", "\u21A7"; - "↤", "\u21A4"; - "↥", "\u21A5"; - "▮", "\u25AE"; - "⨩", "\u2A29"; - "М", "\u041C"; - "м", "\u043C"; - "—", "\u2014"; - "∺", "\u223A"; - "∡", "\u2221"; - " ", "\u205F"; - "ℳ", "\u2133"; - "𝔐", "\uD835\uDD10"; - "𝔪", "\uD835\uDD2A"; - "℧", "\u2127"; - "µ", "\u00B5"; - "µ", "\u00B5"; - "*", "\u002A"; - "⫰", "\u2AF0"; - "∣", "\u2223"; - "·", "\u00B7"; - "·", "\u00B7"; - "⊟", "\u229F"; - "−", "\u2212"; - "∸", "\u2238"; - "⨪", "\u2A2A"; - "∓", "\u2213"; - "⫛", "\u2ADB"; - "…", "\u2026"; - "∓", "\u2213"; - "⊧", "\u22A7"; - "𝕄", "\uD835\uDD44"; - "𝕞", "\uD835\uDD5E"; - "∓", "\u2213"; - "𝓂", "\uD835\uDCC2"; - "ℳ", "\u2133"; - "∾", "\u223E"; - "Μ", "\u039C"; - "μ", "\u03BC"; - "⊸", "\u22B8"; - "⊸", "\u22B8"; - "∇", "\u2207"; - "Ń", "\u0143"; - "ń", "\u0144"; - "∠⃒", "\u2220\u20D2"; - "≉", "\u2249"; - "⩰̸", "\u2A70\u0338"; - "≋̸", "\u224B\u0338"; - "ʼn", "\u0149"; - "≉", "\u2249"; - "♮", "\u266E"; - "ℕ", "\u2115"; - "♮", "\u266E"; - " ", "\u00A0"; - " ", "\u00A0"; - "≎̸", "\u224E\u0338"; - "≏̸", "\u224F\u0338"; - "⩃", "\u2A43"; - "Ň", "\u0147"; - "ň", "\u0148"; - "Ņ", "\u0145"; - "ņ", "\u0146"; - "≇", "\u2247"; - "⩭̸", "\u2A6D\u0338"; - "⩂", "\u2A42"; - "Н", "\u041D"; - "н", "\u043D"; - "–", "\u2013"; - "⤤", "\u2924"; - "↗", "\u2197"; - "⇗", "\u21D7"; - "↗", "\u2197"; - "≠", "\u2260"; - "≐̸", "\u2250\u0338"; - "​", "\u200B"; - "​", "\u200B"; - "​", "\u200B"; - "​", "\u200B"; - "≢", "\u2262"; - "⤨", "\u2928"; - "≂̸", "\u2242\u0338"; - "≫", "\u226B"; - "≪", "\u226A"; - " ", "\u000A"; - "∄", "\u2204"; - "∄", "\u2204"; - "𝔑", "\uD835\uDD11"; - "𝔫", "\uD835\uDD2B"; - "≧̸", "\u2267\u0338"; - "≱", "\u2271"; - "≱", "\u2271"; - "≧̸", "\u2267\u0338"; - "⩾̸", "\u2A7E\u0338"; - "⩾̸", "\u2A7E\u0338"; - "⋙̸", "\u22D9\u0338"; - "≵", "\u2275"; - "≫⃒", "\u226B\u20D2"; - "≯", "\u226F"; - "≯", "\u226F"; - "≫̸", "\u226B\u0338"; - "↮", "\u21AE"; - "⇎", "\u21CE"; - "⫲", "\u2AF2"; - "∋", "\u220B"; - "⋼", "\u22FC"; - "⋺", "\u22FA"; - "∋", "\u220B"; - "Њ", "\u040A"; - "њ", "\u045A"; - "↚", "\u219A"; - "⇍", "\u21CD"; - "‥", "\u2025"; - "≦̸", "\u2266\u0338"; - "≰", "\u2270"; - "↚", "\u219A"; - "⇍", "\u21CD"; - "↮", "\u21AE"; - "⇎", "\u21CE"; - "≰", "\u2270"; - "≦̸", "\u2266\u0338"; - "⩽̸", "\u2A7D\u0338"; - "⩽̸", "\u2A7D\u0338"; - "≮", "\u226E"; - "⋘̸", "\u22D8\u0338"; - "≴", "\u2274"; - "≪⃒", "\u226A\u20D2"; - "≮", "\u226E"; - "⋪", "\u22EA"; - "⋬", "\u22EC"; - "≪̸", "\u226A\u0338"; - "∤", "\u2224"; - "⁠", "\u2060"; - " ", "\u00A0"; - "𝕟", "\uD835\uDD5F"; - "ℕ", "\u2115"; - "⫬", "\u2AEC"; - "¬", "\u00AC"; - "¬", "\u00AC"; - "≢", "\u2262"; - "≭", "\u226D"; - "∦", "\u2226"; - "∉", "\u2209"; - "≠", "\u2260"; - "≂̸", "\u2242\u0338"; - "∄", "\u2204"; - "≯", "\u226F"; - "≱", "\u2271"; - "≧̸", "\u2267\u0338"; - "≫̸", "\u226B\u0338"; - "≹", "\u2279"; - "⩾̸", "\u2A7E\u0338"; - "≵", "\u2275"; - "≎̸", "\u224E\u0338"; - "≏̸", "\u224F\u0338"; - "∉", "\u2209"; - "⋵̸", "\u22F5\u0338"; - "⋹̸", "\u22F9\u0338"; - "∉", "\u2209"; - "⋷", "\u22F7"; - "⋶", "\u22F6"; - "⧏̸", "\u29CF\u0338"; - "⋪", "\u22EA"; - "⋬", "\u22EC"; - "≮", "\u226E"; - "≰", "\u2270"; - "≸", "\u2278"; - "≪̸", "\u226A\u0338"; - "⩽̸", "\u2A7D\u0338"; - "≴", "\u2274"; - "⪢̸", "\u2AA2\u0338"; - "⪡̸", "\u2AA1\u0338"; - "∌", "\u220C"; - "∌", "\u220C"; - "⋾", "\u22FE"; - "⋽", "\u22FD"; - "⊀", "\u2280"; - "⪯̸", "\u2AAF\u0338"; - "⋠", "\u22E0"; - "∌", "\u220C"; - "⧐̸", "\u29D0\u0338"; - "⋫", "\u22EB"; - "⋭", "\u22ED"; - "⊏̸", "\u228F\u0338"; - "⋢", "\u22E2"; - "⊐̸", "\u2290\u0338"; - "⋣", "\u22E3"; - "⊂⃒", "\u2282\u20D2"; - "⊈", "\u2288"; - "⊁", "\u2281"; - "⪰̸", "\u2AB0\u0338"; - "⋡", "\u22E1"; - "≿̸", "\u227F\u0338"; - "⊃⃒", "\u2283\u20D2"; - "⊉", "\u2289"; - "≁", "\u2241"; - "≄", "\u2244"; - "≇", "\u2247"; - "≉", "\u2249"; - "∤", "\u2224"; - "∦", "\u2226"; - "∦", "\u2226"; - "⫽⃥", "\u2AFD\u20E5"; - "∂̸", "\u2202\u0338"; - "⨔", "\u2A14"; - "⊀", "\u2280"; - "⋠", "\u22E0"; - "⊀", "\u2280"; - "⪯̸", "\u2AAF\u0338"; - "⪯̸", "\u2AAF\u0338"; - "⤳̸", "\u2933\u0338"; - "↛", "\u219B"; - "⇏", "\u21CF"; - "↝̸", "\u219D\u0338"; - "↛", "\u219B"; - "⇏", "\u21CF"; - "⋫", "\u22EB"; - "⋭", "\u22ED"; - "⊁", "\u2281"; - "⋡", "\u22E1"; - "⪰̸", "\u2AB0\u0338"; - "𝒩", "\uD835\uDCA9"; - "𝓃", "\uD835\uDCC3"; - "∤", "\u2224"; - "∦", "\u2226"; - "≁", "\u2241"; - "≄", "\u2244"; - "≄", "\u2244"; - "∤", "\u2224"; - "∦", "\u2226"; - "⋢", "\u22E2"; - "⋣", "\u22E3"; - "⊄", "\u2284"; - "⫅̸", "\u2AC5\u0338"; - "⊈", "\u2288"; - "⊂⃒", "\u2282\u20D2"; - "⊈", "\u2288"; - "⫅̸", "\u2AC5\u0338"; - "⊁", "\u2281"; - "⪰̸", "\u2AB0\u0338"; - "⊅", "\u2285"; - "⫆̸", "\u2AC6\u0338"; - "⊉", "\u2289"; - "⊃⃒", "\u2283\u20D2"; - "⊉", "\u2289"; - "⫆̸", "\u2AC6\u0338"; - "≹", "\u2279"; - "Ñ", "\u00D1"; - "Ñ", "\u00D1"; - "ñ", "\u00F1"; - "ñ", "\u00F1"; - "≸", "\u2278"; - "⋪", "\u22EA"; - "⋬", "\u22EC"; - "⋫", "\u22EB"; - "⋭", "\u22ED"; - "Ν", "\u039D"; - "ν", "\u03BD"; - "#", "\u0023"; - "№", "\u2116"; - " ", "\u2007"; - "≍⃒", "\u224D\u20D2"; - "⊬", "\u22AC"; - "⊭", "\u22AD"; - "⊮", "\u22AE"; - "⊯", "\u22AF"; - "≥⃒", "\u2265\u20D2"; - ">⃒", "\u003E\u20D2"; - "⤄", "\u2904"; - "⧞", "\u29DE"; - "⤂", "\u2902"; - "≤⃒", "\u2264\u20D2"; - "<⃒", "\u003C\u20D2"; - "⊴⃒", "\u22B4\u20D2"; - "⤃", "\u2903"; - "⊵⃒", "\u22B5\u20D2"; - "∼⃒", "\u223C\u20D2"; - "⤣", "\u2923"; - "↖", "\u2196"; - "⇖", "\u21D6"; - "↖", "\u2196"; - "⤧", "\u2927"; - "Ó", "\u00D3"; - "Ó", "\u00D3"; - "ó", "\u00F3"; - "ó", "\u00F3"; - "⊛", "\u229B"; - "Ô", "\u00D4"; - "Ô", "\u00D4"; - "ô", "\u00F4"; - "ô", "\u00F4"; - "⊚", "\u229A"; - "О", "\u041E"; - "о", "\u043E"; - "⊝", "\u229D"; - "Ő", "\u0150"; - "ő", "\u0151"; - "⨸", "\u2A38"; - "⊙", "\u2299"; - "⦼", "\u29BC"; - "Œ", "\u0152"; - "œ", "\u0153"; - "⦿", "\u29BF"; - "𝔒", "\uD835\uDD12"; - "𝔬", "\uD835\uDD2C"; - "˛", "\u02DB"; - "Ò", "\u00D2"; - "Ò", "\u00D2"; - "ò", "\u00F2"; - "ò", "\u00F2"; - "⧁", "\u29C1"; - "⦵", "\u29B5"; - "Ω", "\u03A9"; - "∮", "\u222E"; - "↺", "\u21BA"; - "⦾", "\u29BE"; - "⦻", "\u29BB"; - "‾", "\u203E"; - "⧀", "\u29C0"; - "Ō", "\u014C"; - "ō", "\u014D"; - "Ω", "\u03A9"; - "ω", "\u03C9"; - "Ο", "\u039F"; - "ο", "\u03BF"; - "⦶", "\u29B6"; - "⊖", "\u2296"; - "𝕆", "\uD835\uDD46"; - "𝕠", "\uD835\uDD60"; - "⦷", "\u29B7"; - "“", "\u201C"; - "‘", "\u2018"; - "⦹", "\u29B9"; - "⊕", "\u2295"; - "↻", "\u21BB"; - "⩔", "\u2A54"; - "∨", "\u2228"; - "⩝", "\u2A5D"; - "ℴ", "\u2134"; - "ℴ", "\u2134"; - "ª", "\u00AA"; - "ª", "\u00AA"; - "º", "\u00BA"; - "º", "\u00BA"; - "⊶", "\u22B6"; - "⩖", "\u2A56"; - "⩗", "\u2A57"; - "⩛", "\u2A5B"; - "Ⓢ", "\u24C8"; - "𝒪", "\uD835\uDCAA"; - "ℴ", "\u2134"; - "Ø", "\u00D8"; - "Ø", "\u00D8"; - "ø", "\u00F8"; - "ø", "\u00F8"; - "⊘", "\u2298"; - "Õ", "\u00D5"; - "Õ", "\u00D5"; - "õ", "\u00F5"; - "õ", "\u00F5"; - "⨶", "\u2A36"; - "⨷", "\u2A37"; - "⊗", "\u2297"; - "Ö", "\u00D6"; - "Ö", "\u00D6"; - "ö", "\u00F6"; - "ö", "\u00F6"; - "⌽", "\u233D"; - "‾", "\u203E"; - "⏞", "\u23DE"; - "⎴", "\u23B4"; - "⏜", "\u23DC"; - "¶", "\u00B6"; - "¶", "\u00B6"; - "∥", "\u2225"; - "∥", "\u2225"; - "⫳", "\u2AF3"; - "⫽", "\u2AFD"; - "∂", "\u2202"; - "∂", "\u2202"; - "П", "\u041F"; - "п", "\u043F"; - "%", "\u0025"; - ".", "\u002E"; - "‰", "\u2030"; - "⊥", "\u22A5"; - "‱", "\u2031"; - "𝔓", "\uD835\uDD13"; - "𝔭", "\uD835\uDD2D"; - "Φ", "\u03A6"; - "φ", "\u03C6"; - "ϕ", "\u03D5"; - "ℳ", "\u2133"; - "☎", "\u260E"; - "Π", "\u03A0"; - "π", "\u03C0"; - "⋔", "\u22D4"; - "ϖ", "\u03D6"; - "ℏ", "\u210F"; - "ℎ", "\u210E"; - "ℏ", "\u210F"; - "⨣", "\u2A23"; - "⊞", "\u229E"; - "⨢", "\u2A22"; - "+", "\u002B"; - "∔", "\u2214"; - "⨥", "\u2A25"; - "⩲", "\u2A72"; - "±", "\u00B1"; - "±", "\u00B1"; - "±", "\u00B1"; - "⨦", "\u2A26"; - "⨧", "\u2A27"; - "±", "\u00B1"; - "ℌ", "\u210C"; - "⨕", "\u2A15"; - "𝕡", "\uD835\uDD61"; - "ℙ", "\u2119"; - "£", "\u00A3"; - "£", "\u00A3"; - "⪷", "\u2AB7"; - "⪻", "\u2ABB"; - "≺", "\u227A"; - "≼", "\u227C"; - "⪷", "\u2AB7"; - "≺", "\u227A"; - "≼", "\u227C"; - "≺", "\u227A"; - "⪯", "\u2AAF"; - "≼", "\u227C"; - "≾", "\u227E"; - "⪯", "\u2AAF"; - "⪹", "\u2AB9"; - "⪵", "\u2AB5"; - "⋨", "\u22E8"; - "⪯", "\u2AAF"; - "⪳", "\u2AB3"; - "≾", "\u227E"; - "′", "\u2032"; - "″", "\u2033"; - "ℙ", "\u2119"; - "⪹", "\u2AB9"; - "⪵", "\u2AB5"; - "⋨", "\u22E8"; - "∏", "\u220F"; - "∏", "\u220F"; - "⌮", "\u232E"; - "⌒", "\u2312"; - "⌓", "\u2313"; - "∝", "\u221D"; - "∝", "\u221D"; - "∷", "\u2237"; - "∝", "\u221D"; - "≾", "\u227E"; - "⊰", "\u22B0"; - "𝒫", "\uD835\uDCAB"; - "𝓅", "\uD835\uDCC5"; - "Ψ", "\u03A8"; - "ψ", "\u03C8"; - " ", "\u2008"; - "𝔔", "\uD835\uDD14"; - "𝔮", "\uD835\uDD2E"; - "⨌", "\u2A0C"; - "𝕢", "\uD835\uDD62"; - "ℚ", "\u211A"; - "⁗", "\u2057"; - "𝒬", "\uD835\uDCAC"; - "𝓆", "\uD835\uDCC6"; - "ℍ", "\u210D"; - "⨖", "\u2A16"; - "?", "\u003F"; - "≟", "\u225F"; - """, "\u0022"; - """, "\u0022"; - """, "\u0022"; - """, "\u0022"; - "⇛", "\u21DB"; - "∽̱", "\u223D\u0331"; - "Ŕ", "\u0154"; - "ŕ", "\u0155"; - "√", "\u221A"; - "⦳", "\u29B3"; - "⟩", "\u27E9"; - "⟫", "\u27EB"; - "⦒", "\u2992"; - "⦥", "\u29A5"; - "⟩", "\u27E9"; - "»", "\u00BB"; - "»", "\u00BB"; - "⥵", "\u2975"; - "⇥", "\u21E5"; - "⤠", "\u2920"; - "⤳", "\u2933"; - "→", "\u2192"; - "↠", "\u21A0"; - "⇒", "\u21D2"; - "⤞", "\u291E"; - "↪", "\u21AA"; - "↬", "\u21AC"; - "⥅", "\u2945"; - "⥴", "\u2974"; - "⤖", "\u2916"; - "↣", "\u21A3"; - "↝", "\u219D"; - "⤚", "\u291A"; - "⤜", "\u291C"; - "∶", "\u2236"; - "ℚ", "\u211A"; - "⤍", "\u290D"; - "⤏", "\u290F"; - "⤐", "\u2910"; - "❳", "\u2773"; - "}", "\u007D"; - "]", "\u005D"; - "⦌", "\u298C"; - "⦎", "\u298E"; - "⦐", "\u2990"; - "Ř", "\u0158"; - "ř", "\u0159"; - "Ŗ", "\u0156"; - "ŗ", "\u0157"; - "⌉", "\u2309"; - "}", "\u007D"; - "Р", "\u0420"; - "р", "\u0440"; - "⤷", "\u2937"; - "⥩", "\u2969"; - "”", "\u201D"; - "”", "\u201D"; - "↳", "\u21B3"; - "ℜ", "\u211C"; - "ℛ", "\u211B"; - "ℜ", "\u211C"; - "ℝ", "\u211D"; - "ℜ", "\u211C"; - "▭", "\u25AD"; - "®", "\u00AE"; - "®", "\u00AE"; - "®", "\u00AE"; - "®", "\u00AE"; - "∋", "\u220B"; - "⇋", "\u21CB"; - "⥯", "\u296F"; - "⥽", "\u297D"; - "⌋", "\u230B"; - "𝔯", "\uD835\uDD2F"; - "ℜ", "\u211C"; - "⥤", "\u2964"; - "⇁", "\u21C1"; - "⇀", "\u21C0"; - "⥬", "\u296C"; - "Ρ", "\u03A1"; - "ρ", "\u03C1"; - "ϱ", "\u03F1"; - "⟩", "\u27E9"; - "⇥", "\u21E5"; - "→", "\u2192"; - "→", "\u2192"; - "⇒", "\u21D2"; - "⇄", "\u21C4"; - "↣", "\u21A3"; - "⌉", "\u2309"; - "⟧", "\u27E7"; - "⥝", "\u295D"; - "⥕", "\u2955"; - "⇂", "\u21C2"; - "⌋", "\u230B"; - "⇁", "\u21C1"; - "⇀", "\u21C0"; - "⇄", "\u21C4"; - "⇌", "\u21CC"; - "⇉", "\u21C9"; - "↝", "\u219D"; - "↦", "\u21A6"; - "⊢", "\u22A2"; - "⥛", "\u295B"; - "⋌", "\u22CC"; - "⧐", "\u29D0"; - "⊳", "\u22B3"; - "⊵", "\u22B5"; - "⥏", "\u294F"; - "⥜", "\u295C"; - "⥔", "\u2954"; - "↾", "\u21BE"; - "⥓", "\u2953"; - "⇀", "\u21C0"; - "˚", "\u02DA"; - "≓", "\u2253"; - "⇄", "\u21C4"; - "⇌", "\u21CC"; - "‏", "\u200F"; - "⎱", "\u23B1"; - "⎱", "\u23B1"; - "⫮", "\u2AEE"; - "⟭", "\u27ED"; - "⇾", "\u21FE"; - "⟧", "\u27E7"; - "⦆", "\u2986"; - "𝕣", "\uD835\uDD63"; - "ℝ", "\u211D"; - "⨮", "\u2A2E"; - "⨵", "\u2A35"; - "⥰", "\u2970"; - ")", "\u0029"; - "⦔", "\u2994"; - "⨒", "\u2A12"; - "⇉", "\u21C9"; - "⇛", "\u21DB"; - "›", "\u203A"; - "𝓇", "\uD835\uDCC7"; - "ℛ", "\u211B"; - "↱", "\u21B1"; - "↱", "\u21B1"; - "]", "\u005D"; - "’", "\u2019"; - "’", "\u2019"; - "⋌", "\u22CC"; - "⋊", "\u22CA"; - "▹", "\u25B9"; - "⊵", "\u22B5"; - "▸", "\u25B8"; - "⧎", "\u29CE"; - "⧴", "\u29F4"; - "⥨", "\u2968"; - "℞", "\u211E"; - "Ś", "\u015A"; - "ś", "\u015B"; - "‚", "\u201A"; - "⪸", "\u2AB8"; - "Š", "\u0160"; - "š", "\u0161"; - "⪼", "\u2ABC"; - "≻", "\u227B"; - "≽", "\u227D"; - "⪰", "\u2AB0"; - "⪴", "\u2AB4"; - "Ş", "\u015E"; - "ş", "\u015F"; - "Ŝ", "\u015C"; - "ŝ", "\u015D"; - "⪺", "\u2ABA"; - "⪶", "\u2AB6"; - "⋩", "\u22E9"; - "⨓", "\u2A13"; - "≿", "\u227F"; - "С", "\u0421"; - "с", "\u0441"; - "⊡", "\u22A1"; - "⋅", "\u22C5"; - "⩦", "\u2A66"; - "⤥", "\u2925"; - "↘", "\u2198"; - "⇘", "\u21D8"; - "↘", "\u2198"; - "§", "\u00A7"; - "§", "\u00A7"; - ";", "\u003B"; - "⤩", "\u2929"; - "∖", "\u2216"; - "∖", "\u2216"; - "✶", "\u2736"; - "𝔖", "\uD835\uDD16"; - "𝔰", "\uD835\uDD30"; - "⌢", "\u2322"; - "♯", "\u266F"; - "Щ", "\u0429"; - "щ", "\u0449"; - "Ш", "\u0428"; - "ш", "\u0448"; - "↓", "\u2193"; - "←", "\u2190"; - "∣", "\u2223"; - "∥", "\u2225"; - "→", "\u2192"; - "↑", "\u2191"; - "­", "\u00AD"; - "­", "\u00AD"; - "Σ", "\u03A3"; - "σ", "\u03C3"; - "ς", "\u03C2"; - "ς", "\u03C2"; - "∼", "\u223C"; - "⩪", "\u2A6A"; - "≃", "\u2243"; - "≃", "\u2243"; - "⪞", "\u2A9E"; - "⪠", "\u2AA0"; - "⪝", "\u2A9D"; - "⪟", "\u2A9F"; - "≆", "\u2246"; - "⨤", "\u2A24"; - "⥲", "\u2972"; - "←", "\u2190"; - "∘", "\u2218"; - "∖", "\u2216"; - "⨳", "\u2A33"; - "⧤", "\u29E4"; - "∣", "\u2223"; - "⌣", "\u2323"; - "⪪", "\u2AAA"; - "⪬", "\u2AAC"; - "⪬︀", "\u2AAC\uFE00"; - "Ь", "\u042C"; - "ь", "\u044C"; - "⌿", "\u233F"; - "⧄", "\u29C4"; - "/", "\u002F"; - "𝕊", "\uD835\uDD4A"; - "𝕤", "\uD835\uDD64"; - "♠", "\u2660"; - "♠", "\u2660"; - "∥", "\u2225"; - "⊓", "\u2293"; - "⊓︀", "\u2293\uFE00"; - "⊔", "\u2294"; - "⊔︀", "\u2294\uFE00"; - "√", "\u221A"; - "⊏", "\u228F"; - "⊑", "\u2291"; - "⊏", "\u228F"; - "⊑", "\u2291"; - "⊐", "\u2290"; - "⊒", "\u2292"; - "⊐", "\u2290"; - "⊒", "\u2292"; - "□", "\u25A1"; - "□", "\u25A1"; - "⊓", "\u2293"; - "⊏", "\u228F"; - "⊑", "\u2291"; - "⊐", "\u2290"; - "⊒", "\u2292"; - "⊔", "\u2294"; - "▪", "\u25AA"; - "□", "\u25A1"; - "▪", "\u25AA"; - "→", "\u2192"; - "𝒮", "\uD835\uDCAE"; - "𝓈", "\uD835\uDCC8"; - "∖", "\u2216"; - "⌣", "\u2323"; - "⋆", "\u22C6"; - "⋆", "\u22C6"; - "☆", "\u2606"; - "★", "\u2605"; - "ϵ", "\u03F5"; - "ϕ", "\u03D5"; - "¯", "\u00AF"; - "⊂", "\u2282"; - "⋐", "\u22D0"; - "⪽", "\u2ABD"; - "⫅", "\u2AC5"; - "⊆", "\u2286"; - "⫃", "\u2AC3"; - "⫁", "\u2AC1"; - "⫋", "\u2ACB"; - "⊊", "\u228A"; - "⪿", "\u2ABF"; - "⥹", "\u2979"; - "⊂", "\u2282"; - "⋐", "\u22D0"; - "⊆", "\u2286"; - "⫅", "\u2AC5"; - "⊆", "\u2286"; - "⊊", "\u228A"; - "⫋", "\u2ACB"; - "⫇", "\u2AC7"; - "⫕", "\u2AD5"; - "⫓", "\u2AD3"; - "⪸", "\u2AB8"; - "≻", "\u227B"; - "≽", "\u227D"; - "≻", "\u227B"; - "⪰", "\u2AB0"; - "≽", "\u227D"; - "≿", "\u227F"; - "⪰", "\u2AB0"; - "⪺", "\u2ABA"; - "⪶", "\u2AB6"; - "⋩", "\u22E9"; - "≿", "\u227F"; - "∋", "\u220B"; - "∑", "\u2211"; - "∑", "\u2211"; - "♪", "\u266A"; - "¹", "\u00B9"; - "¹", "\u00B9"; - "²", "\u00B2"; - "²", "\u00B2"; - "³", "\u00B3"; - "³", "\u00B3"; - "⊃", "\u2283"; - "⋑", "\u22D1"; - "⪾", "\u2ABE"; - "⫘", "\u2AD8"; - "⫆", "\u2AC6"; - "⊇", "\u2287"; - "⫄", "\u2AC4"; - "⊃", "\u2283"; - "⊇", "\u2287"; - "⟉", "\u27C9"; - "⫗", "\u2AD7"; - "⥻", "\u297B"; - "⫂", "\u2AC2"; - "⫌", "\u2ACC"; - "⊋", "\u228B"; - "⫀", "\u2AC0"; - "⊃", "\u2283"; - "⋑", "\u22D1"; - "⊇", "\u2287"; - "⫆", "\u2AC6"; - "⊋", "\u228B"; - "⫌", "\u2ACC"; - "⫈", "\u2AC8"; - "⫔", "\u2AD4"; - "⫖", "\u2AD6"; - "⤦", "\u2926"; - "↙", "\u2199"; - "⇙", "\u21D9"; - "↙", "\u2199"; - "⤪", "\u292A"; - "ß", "\u00DF"; - "ß", "\u00DF"; - " ", "\u0009"; - "⌖", "\u2316"; - "Τ", "\u03A4"; - "τ", "\u03C4"; - "⎴", "\u23B4"; - "Ť", "\u0164"; - "ť", "\u0165"; - "Ţ", "\u0162"; - "ţ", "\u0163"; - "Т", "\u0422"; - "т", "\u0442"; - "⃛", "\u20DB"; - "⌕", "\u2315"; - "𝔗", "\uD835\uDD17"; - "𝔱", "\uD835\uDD31"; - "∴", "\u2234"; - "∴", "\u2234"; - "∴", "\u2234"; - "Θ", "\u0398"; - "θ", "\u03B8"; - "ϑ", "\u03D1"; - "ϑ", "\u03D1"; - "≈", "\u2248"; - "∼", "\u223C"; - "  ", "\u205F\u200A"; - " ", "\u2009"; - " ", "\u2009"; - "≈", "\u2248"; - "∼", "\u223C"; - "Þ", "\u00DE"; - "Þ", "\u00DE"; - "þ", "\u00FE"; - "þ", "\u00FE"; - "˜", "\u02DC"; - "∼", "\u223C"; - "≃", "\u2243"; - "≅", "\u2245"; - "≈", "\u2248"; - "⨱", "\u2A31"; - "⊠", "\u22A0"; - "×", "\u00D7"; - "×", "\u00D7"; - "⨰", "\u2A30"; - "∭", "\u222D"; - "⤨", "\u2928"; - "⌶", "\u2336"; - "⫱", "\u2AF1"; - "⊤", "\u22A4"; - "𝕋", "\uD835\uDD4B"; - "𝕥", "\uD835\uDD65"; - "⫚", "\u2ADA"; - "⤩", "\u2929"; - "‴", "\u2034"; - "™", "\u2122"; - "™", "\u2122"; - "▵", "\u25B5"; - "▿", "\u25BF"; - "◃", "\u25C3"; - "⊴", "\u22B4"; - "≜", "\u225C"; - "▹", "\u25B9"; - "⊵", "\u22B5"; - "◬", "\u25EC"; - "≜", "\u225C"; - "⨺", "\u2A3A"; - "⃛", "\u20DB"; - "⨹", "\u2A39"; - "⧍", "\u29CD"; - "⨻", "\u2A3B"; - "⏢", "\u23E2"; - "𝒯", "\uD835\uDCAF"; - "𝓉", "\uD835\uDCC9"; - "Ц", "\u0426"; - "ц", "\u0446"; - "Ћ", "\u040B"; - "ћ", "\u045B"; - "Ŧ", "\u0166"; - "ŧ", "\u0167"; - "≬", "\u226C"; - "↞", "\u219E"; - "↠", "\u21A0"; - "Ú", "\u00DA"; - "Ú", "\u00DA"; - "ú", "\u00FA"; - "ú", "\u00FA"; - "↑", "\u2191"; - "↟", "\u219F"; - "⇑", "\u21D1"; - "⥉", "\u2949"; - "Ў", "\u040E"; - "ў", "\u045E"; - "Ŭ", "\u016C"; - "ŭ", "\u016D"; - "Û", "\u00DB"; - "Û", "\u00DB"; - "û", "\u00FB"; - "û", "\u00FB"; - "У", "\u0423"; - "у", "\u0443"; - "⇅", "\u21C5"; - "Ű", "\u0170"; - "ű", "\u0171"; - "⥮", "\u296E"; - "⥾", "\u297E"; - "𝔘", "\uD835\uDD18"; - "𝔲", "\uD835\uDD32"; - "Ù", "\u00D9"; - "Ù", "\u00D9"; - "ù", "\u00F9"; - "ù", "\u00F9"; - "⥣", "\u2963"; - "↿", "\u21BF"; - "↾", "\u21BE"; - "▀", "\u2580"; - "⌜", "\u231C"; - "⌜", "\u231C"; - "⌏", "\u230F"; - "◸", "\u25F8"; - "Ū", "\u016A"; - "ū", "\u016B"; - "¨", "\u00A8"; - "¨", "\u00A8"; - "_", "\u005F"; - "⏟", "\u23DF"; - "⎵", "\u23B5"; - "⏝", "\u23DD"; - "⋃", "\u22C3"; - "⊎", "\u228E"; - "Ų", "\u0172"; - "ų", "\u0173"; - "𝕌", "\uD835\uDD4C"; - "𝕦", "\uD835\uDD66"; - "⤒", "\u2912"; - "↑", "\u2191"; - "↑", "\u2191"; - "⇑", "\u21D1"; - "⇅", "\u21C5"; - "↕", "\u2195"; - "↕", "\u2195"; - "⇕", "\u21D5"; - "⥮", "\u296E"; - "↿", "\u21BF"; - "↾", "\u21BE"; - "⊎", "\u228E"; - "↖", "\u2196"; - "↗", "\u2197"; - "υ", "\u03C5"; - "ϒ", "\u03D2"; - "ϒ", "\u03D2"; - "Υ", "\u03A5"; - "υ", "\u03C5"; - "↥", "\u21A5"; - "⊥", "\u22A5"; - "⇈", "\u21C8"; - "⌝", "\u231D"; - "⌝", "\u231D"; - "⌎", "\u230E"; - "Ů", "\u016E"; - "ů", "\u016F"; - "◹", "\u25F9"; - "𝒰", "\uD835\uDCB0"; - "𝓊", "\uD835\uDCCA"; - "⋰", "\u22F0"; - "Ũ", "\u0168"; - "ũ", "\u0169"; - "▵", "\u25B5"; - "▴", "\u25B4"; - "⇈", "\u21C8"; - "Ü", "\u00DC"; - "Ü", "\u00DC"; - "ü", "\u00FC"; - "ü", "\u00FC"; - "⦧", "\u29A7"; - "⦜", "\u299C"; - "ϵ", "\u03F5"; - "ϰ", "\u03F0"; - "∅", "\u2205"; - "ϕ", "\u03D5"; - "ϖ", "\u03D6"; - "∝", "\u221D"; - "↕", "\u2195"; - "⇕", "\u21D5"; - "ϱ", "\u03F1"; - "ς", "\u03C2"; - "⊊︀", "\u228A\uFE00"; - "⫋︀", "\u2ACB\uFE00"; - "⊋︀", "\u228B\uFE00"; - "⫌︀", "\u2ACC\uFE00"; - "ϑ", "\u03D1"; - "⊲", "\u22B2"; - "⊳", "\u22B3"; - "⫨", "\u2AE8"; - "⫫", "\u2AEB"; - "⫩", "\u2AE9"; - "В", "\u0412"; - "в", "\u0432"; - "⊢", "\u22A2"; - "⊨", "\u22A8"; - "⊩", "\u22A9"; - "⊫", "\u22AB"; - "⫦", "\u2AE6"; - "⊻", "\u22BB"; - "∨", "\u2228"; - "⋁", "\u22C1"; - "≚", "\u225A"; - "⋮", "\u22EE"; - "|", "\u007C"; - "‖", "\u2016"; - "|", "\u007C"; - "‖", "\u2016"; - "∣", "\u2223"; - "|", "\u007C"; - "❘", "\u2758"; - "≀", "\u2240"; - " ", "\u200A"; - "𝔙", "\uD835\uDD19"; - "𝔳", "\uD835\uDD33"; - "⊲", "\u22B2"; - "⊂⃒", "\u2282\u20D2"; - "⊃⃒", "\u2283\u20D2"; - "𝕍", "\uD835\uDD4D"; - "𝕧", "\uD835\uDD67"; - "∝", "\u221D"; - "⊳", "\u22B3"; - "𝒱", "\uD835\uDCB1"; - "𝓋", "\uD835\uDCCB"; - "⫋︀", "\u2ACB\uFE00"; - "⊊︀", "\u228A\uFE00"; - "⫌︀", "\u2ACC\uFE00"; - "⊋︀", "\u228B\uFE00"; - "⊪", "\u22AA"; - "⦚", "\u299A"; - "Ŵ", "\u0174"; - "ŵ", "\u0175"; - "⩟", "\u2A5F"; - "∧", "\u2227"; - "⋀", "\u22C0"; - "≙", "\u2259"; - "℘", "\u2118"; - "𝔚", "\uD835\uDD1A"; - "𝔴", "\uD835\uDD34"; - "𝕎", "\uD835\uDD4E"; - "𝕨", "\uD835\uDD68"; - "℘", "\u2118"; - "≀", "\u2240"; - "≀", "\u2240"; - "𝒲", "\uD835\uDCB2"; - "𝓌", "\uD835\uDCCC"; - "⋂", "\u22C2"; - "◯", "\u25EF"; - "⋃", "\u22C3"; - "▽", "\u25BD"; - "𝔛", "\uD835\uDD1B"; - "𝔵", "\uD835\uDD35"; - "⟷", "\u27F7"; - "⟺", "\u27FA"; - "Ξ", "\u039E"; - "ξ", "\u03BE"; - "⟵", "\u27F5"; - "⟸", "\u27F8"; - "⟼", "\u27FC"; - "⋻", "\u22FB"; - "⨀", "\u2A00"; - "𝕏", "\uD835\uDD4F"; - "𝕩", "\uD835\uDD69"; - "⨁", "\u2A01"; - "⨂", "\u2A02"; - "⟶", "\u27F6"; - "⟹", "\u27F9"; - "𝒳", "\uD835\uDCB3"; - "𝓍", "\uD835\uDCCD"; - "⨆", "\u2A06"; - "⨄", "\u2A04"; - "△", "\u25B3"; - "⋁", "\u22C1"; - "⋀", "\u22C0"; - "Ý", "\u00DD"; - "Ý", "\u00DD"; - "ý", "\u00FD"; - "ý", "\u00FD"; - "Я", "\u042F"; - "я", "\u044F"; - "Ŷ", "\u0176"; - "ŷ", "\u0177"; - "Ы", "\u042B"; - "ы", "\u044B"; - "¥", "\u00A5"; - "¥", "\u00A5"; - "𝔜", "\uD835\uDD1C"; - "𝔶", "\uD835\uDD36"; - "Ї", "\u0407"; - "ї", "\u0457"; - "𝕐", "\uD835\uDD50"; - "𝕪", "\uD835\uDD6A"; - "𝒴", "\uD835\uDCB4"; - "𝓎", "\uD835\uDCCE"; - "Ю", "\u042E"; - "ю", "\u044E"; - "ÿ", "\u00FF"; - "ÿ", "\u00FF"; - "Ÿ", "\u0178"; - "Ź", "\u0179"; - "ź", "\u017A"; - "Ž", "\u017D"; - "ž", "\u017E"; - "З", "\u0417"; - "з", "\u0437"; - "Ż", "\u017B"; - "ż", "\u017C"; - "ℨ", "\u2128"; - "​", "\u200B"; - "Ζ", "\u0396"; - "ζ", "\u03B6"; - "𝔷", "\uD835\uDD37"; - "ℨ", "\u2128"; - "Ж", "\u0416"; - "ж", "\u0436"; - "⇝", "\u21DD"; - "𝕫", "\uD835\uDD6B"; - "ℤ", "\u2124"; - "𝒵", "\uD835\uDCB5"; - "𝓏", "\uD835\uDCCF"; - "‍", "\u200D"; - "‌", "\u200C"; - |] |> Map.ofArray + let private refs = + [| "Á", "\u00C1" + "Á", "\u00C1" + "á", "\u00E1" + "á", "\u00E1" + "Ă", "\u0102" + "ă", "\u0103" + "∾", "\u223E" + "∿", "\u223F" + "∾̳", "\u223E\u0333" + "Â", "\u00C2" + "Â", "\u00C2" + "â", "\u00E2" + "â", "\u00E2" + "´", "\u00B4" + "´", "\u00B4" + "А", "\u0410" + "а", "\u0430" + "Æ", "\u00C6" + "Æ", "\u00C6" + "æ", "\u00E6" + "æ", "\u00E6" + "⁡", "\u2061" + "𝔄", "\uD835\uDD04" + "𝔞", "\uD835\uDD1E" + "À", "\u00C0" + "À", "\u00C0" + "à", "\u00E0" + "à", "\u00E0" + "ℵ", "\u2135" + "ℵ", "\u2135" + "Α", "\u0391" + "α", "\u03B1" + "Ā", "\u0100" + "ā", "\u0101" + "⨿", "\u2A3F" + "&", "\u0026" + "&", "\u0026" + "&", "\u0026" + "&", "\u0026" + "⩕", "\u2A55" + "⩓", "\u2A53" + "∧", "\u2227" + "⩜", "\u2A5C" + "⩘", "\u2A58" + "⩚", "\u2A5A" + "∠", "\u2220" + "⦤", "\u29A4" + "∠", "\u2220" + "⦨", "\u29A8" + "⦩", "\u29A9" + "⦪", "\u29AA" + "⦫", "\u29AB" + "⦬", "\u29AC" + "⦭", "\u29AD" + "⦮", "\u29AE" + "⦯", "\u29AF" + "∡", "\u2221" + "∟", "\u221F" + "⊾", "\u22BE" + "⦝", "\u299D" + "∢", "\u2222" + "Å", "\u00C5" + "⍼", "\u237C" + "Ą", "\u0104" + "ą", "\u0105" + "𝔸", "\uD835\uDD38" + "𝕒", "\uD835\uDD52" + "⩯", "\u2A6F" + "≈", "\u2248" + "⩰", "\u2A70" + "≊", "\u224A" + "≋", "\u224B" + "'", "\u0027" + "⁡", "\u2061" + "≈", "\u2248" + "≊", "\u224A" + "Å", "\u00C5" + "Å", "\u00C5" + "å", "\u00E5" + "å", "\u00E5" + "𝒜", "\uD835\uDC9C" + "𝒶", "\uD835\uDCB6" + "≔", "\u2254" + "*", "\u002A" + "≈", "\u2248" + "≍", "\u224D" + "Ã", "\u00C3" + "Ã", "\u00C3" + "ã", "\u00E3" + "ã", "\u00E3" + "Ä", "\u00C4" + "Ä", "\u00C4" + "ä", "\u00E4" + "ä", "\u00E4" + "∳", "\u2233" + "⨑", "\u2A11" + "≌", "\u224C" + "϶", "\u03F6" + "‵", "\u2035" + "∽", "\u223D" + "⋍", "\u22CD" + "∖", "\u2216" + "⫧", "\u2AE7" + "⊽", "\u22BD" + "⌅", "\u2305" + "⌆", "\u2306" + "⌅", "\u2305" + "⎵", "\u23B5" + "⎶", "\u23B6" + "≌", "\u224C" + "Б", "\u0411" + "б", "\u0431" + "„", "\u201E" + "∵", "\u2235" + "∵", "\u2235" + "∵", "\u2235" + "⦰", "\u29B0" + "϶", "\u03F6" + "ℬ", "\u212C" + "ℬ", "\u212C" + "Β", "\u0392" + "β", "\u03B2" + "ℶ", "\u2136" + "≬", "\u226C" + "𝔅", "\uD835\uDD05" + "𝔟", "\uD835\uDD1F" + "⋂", "\u22C2" + "◯", "\u25EF" + "⋃", "\u22C3" + "⨀", "\u2A00" + "⨁", "\u2A01" + "⨂", "\u2A02" + "⨆", "\u2A06" + "★", "\u2605" + "▽", "\u25BD" + "△", "\u25B3" + "⨄", "\u2A04" + "⋁", "\u22C1" + "⋀", "\u22C0" + "⤍", "\u290D" + "⧫", "\u29EB" + "▪", "\u25AA" + "▴", "\u25B4" + "▾", "\u25BE" + "◂", "\u25C2" + "▸", "\u25B8" + "␣", "\u2423" + "▒", "\u2592" + "░", "\u2591" + "▓", "\u2593" + "█", "\u2588" + "=⃥", "\u003D\u20E5" + "≡⃥", "\u2261\u20E5" + "⫭", "\u2AED" + "⌐", "\u2310" + "𝔹", "\uD835\uDD39" + "𝕓", "\uD835\uDD53" + "⊥", "\u22A5" + "⊥", "\u22A5" + "⋈", "\u22C8" + "⧉", "\u29C9" + "┐", "\u2510" + "╕", "\u2555" + "╖", "\u2556" + "╗", "\u2557" + "┌", "\u250C" + "╒", "\u2552" + "╓", "\u2553" + "╔", "\u2554" + "─", "\u2500" + "═", "\u2550" + "┬", "\u252C" + "╤", "\u2564" + "╥", "\u2565" + "╦", "\u2566" + "┴", "\u2534" + "╧", "\u2567" + "╨", "\u2568" + "╩", "\u2569" + "⊟", "\u229F" + "⊞", "\u229E" + "⊠", "\u22A0" + "┘", "\u2518" + "╛", "\u255B" + "╜", "\u255C" + "╝", "\u255D" + "└", "\u2514" + "╘", "\u2558" + "╙", "\u2559" + "╚", "\u255A" + "│", "\u2502" + "║", "\u2551" + "┼", "\u253C" + "╪", "\u256A" + "╫", "\u256B" + "╬", "\u256C" + "┤", "\u2524" + "╡", "\u2561" + "╢", "\u2562" + "╣", "\u2563" + "├", "\u251C" + "╞", "\u255E" + "╟", "\u255F" + "╠", "\u2560" + "‵", "\u2035" + "˘", "\u02D8" + "˘", "\u02D8" + "¦", "\u00A6" + "¦", "\u00A6" + "𝒷", "\uD835\uDCB7" + "ℬ", "\u212C" + "⁏", "\u204F" + "∽", "\u223D" + "⋍", "\u22CD" + "⧅", "\u29C5" + "\", "\u005C" + "⟈", "\u27C8" + "•", "\u2022" + "•", "\u2022" + "≎", "\u224E" + "⪮", "\u2AAE" + "≏", "\u224F" + "≎", "\u224E" + "≏", "\u224F" + "Ć", "\u0106" + "ć", "\u0107" + "⩄", "\u2A44" + "⩉", "\u2A49" + "⩋", "\u2A4B" + "∩", "\u2229" + "⋒", "\u22D2" + "⩇", "\u2A47" + "⩀", "\u2A40" + "ⅅ", "\u2145" + "∩︀", "\u2229\uFE00" + "⁁", "\u2041" + "ˇ", "\u02C7" + "ℭ", "\u212D" + "⩍", "\u2A4D" + "Č", "\u010C" + "č", "\u010D" + "Ç", "\u00C7" + "Ç", "\u00C7" + "ç", "\u00E7" + "ç", "\u00E7" + "Ĉ", "\u0108" + "ĉ", "\u0109" + "∰", "\u2230" + "⩌", "\u2A4C" + "⩐", "\u2A50" + "Ċ", "\u010A" + "ċ", "\u010B" + "¸", "\u00B8" + "¸", "\u00B8" + "¸", "\u00B8" + "⦲", "\u29B2" + "¢", "\u00A2" + "¢", "\u00A2" + "·", "\u00B7" + "·", "\u00B7" + "𝔠", "\uD835\uDD20" + "ℭ", "\u212D" + "Ч", "\u0427" + "ч", "\u0447" + "✓", "\u2713" + "✓", "\u2713" + "Χ", "\u03A7" + "χ", "\u03C7" + "ˆ", "\u02C6" + "≗", "\u2257" + "↺", "\u21BA" + "↻", "\u21BB" + "⊛", "\u229B" + "⊚", "\u229A" + "⊝", "\u229D" + "⊙", "\u2299" + "®", "\u00AE" + "Ⓢ", "\u24C8" + "⊖", "\u2296" + "⊕", "\u2295" + "⊗", "\u2297" + "○", "\u25CB" + "⧃", "\u29C3" + "≗", "\u2257" + "⨐", "\u2A10" + "⫯", "\u2AEF" + "⧂", "\u29C2" + "∲", "\u2232" + "”", "\u201D" + "’", "\u2019" + "♣", "\u2663" + "♣", "\u2663" + ":", "\u003A" + "∷", "\u2237" + "⩴", "\u2A74" + "≔", "\u2254" + "≔", "\u2254" + ",", "\u002C" + "@", "\u0040" + "∁", "\u2201" + "∘", "\u2218" + "∁", "\u2201" + "ℂ", "\u2102" + "≅", "\u2245" + "⩭", "\u2A6D" + "≡", "\u2261" + "∮", "\u222E" + "∯", "\u222F" + "∮", "\u222E" + "𝕔", "\uD835\uDD54" + "ℂ", "\u2102" + "∐", "\u2210" + "∐", "\u2210" + "©", "\u00A9" + "©", "\u00A9" + "©", "\u00A9" + "©", "\u00A9" + "℗", "\u2117" + "∳", "\u2233" + "↵", "\u21B5" + "✗", "\u2717" + "⨯", "\u2A2F" + "𝒞", "\uD835\uDC9E" + "𝒸", "\uD835\uDCB8" + "⫏", "\u2ACF" + "⫑", "\u2AD1" + "⫐", "\u2AD0" + "⫒", "\u2AD2" + "⋯", "\u22EF" + "⤸", "\u2938" + "⤵", "\u2935" + "⋞", "\u22DE" + "⋟", "\u22DF" + "↶", "\u21B6" + "⤽", "\u293D" + "⩈", "\u2A48" + "⩆", "\u2A46" + "≍", "\u224D" + "∪", "\u222A" + "⋓", "\u22D3" + "⩊", "\u2A4A" + "⊍", "\u228D" + "⩅", "\u2A45" + "∪︀", "\u222A\uFE00" + "↷", "\u21B7" + "⤼", "\u293C" + "⋞", "\u22DE" + "⋟", "\u22DF" + "⋎", "\u22CE" + "⋏", "\u22CF" + "¤", "\u00A4" + "¤", "\u00A4" + "↶", "\u21B6" + "↷", "\u21B7" + "⋎", "\u22CE" + "⋏", "\u22CF" + "∲", "\u2232" + "∱", "\u2231" + "⌭", "\u232D" + "†", "\u2020" + "‡", "\u2021" + "ℸ", "\u2138" + "↓", "\u2193" + "↡", "\u21A1" + "⇓", "\u21D3" + "‐", "\u2010" + "⫤", "\u2AE4" + "⊣", "\u22A3" + "⤏", "\u290F" + "˝", "\u02DD" + "Ď", "\u010E" + "ď", "\u010F" + "Д", "\u0414" + "д", "\u0434" + "‡", "\u2021" + "⇊", "\u21CA" + "ⅅ", "\u2145" + "ⅆ", "\u2146" + "⤑", "\u2911" + "⩷", "\u2A77" + "°", "\u00B0" + "°", "\u00B0" + "∇", "\u2207" + "Δ", "\u0394" + "δ", "\u03B4" + "⦱", "\u29B1" + "⥿", "\u297F" + "𝔇", "\uD835\uDD07" + "𝔡", "\uD835\uDD21" + "⥥", "\u2965" + "⇃", "\u21C3" + "⇂", "\u21C2" + "´", "\u00B4" + "˙", "\u02D9" + "˝", "\u02DD" + "`", "\u0060" + "˜", "\u02DC" + "⋄", "\u22C4" + "⋄", "\u22C4" + "⋄", "\u22C4" + "♦", "\u2666" + "♦", "\u2666" + "¨", "\u00A8" + "ⅆ", "\u2146" + "ϝ", "\u03DD" + "⋲", "\u22F2" + "÷", "\u00F7" + "÷", "\u00F7" + "÷", "\u00F7" + "⋇", "\u22C7" + "⋇", "\u22C7" + "Ђ", "\u0402" + "ђ", "\u0452" + "⌞", "\u231E" + "⌍", "\u230D" + "$", "\u0024" + "𝔻", "\uD835\uDD3B" + "𝕕", "\uD835\uDD55" + "¨", "\u00A8" + "˙", "\u02D9" + "⃜", "\u20DC" + "≐", "\u2250" + "≑", "\u2251" + "≐", "\u2250" + "∸", "\u2238" + "∔", "\u2214" + "⊡", "\u22A1" + "⌆", "\u2306" + "∯", "\u222F" + "¨", "\u00A8" + "⇓", "\u21D3" + "⇐", "\u21D0" + "⇔", "\u21D4" + "⫤", "\u2AE4" + "⟸", "\u27F8" + "⟺", "\u27FA" + "⟹", "\u27F9" + "⇒", "\u21D2" + "⊨", "\u22A8" + "⇑", "\u21D1" + "⇕", "\u21D5" + "∥", "\u2225" + "⤓", "\u2913" + "↓", "\u2193" + "↓", "\u2193" + "⇓", "\u21D3" + "⇵", "\u21F5" + "̑", "\u0311" + "⇊", "\u21CA" + "⇃", "\u21C3" + "⇂", "\u21C2" + "⥐", "\u2950" + "⥞", "\u295E" + "⥖", "\u2956" + "↽", "\u21BD" + "⥟", "\u295F" + "⥗", "\u2957" + "⇁", "\u21C1" + "↧", "\u21A7" + "⊤", "\u22A4" + "⤐", "\u2910" + "⌟", "\u231F" + "⌌", "\u230C" + "𝒟", "\uD835\uDC9F" + "𝒹", "\uD835\uDCB9" + "Ѕ", "\u0405" + "ѕ", "\u0455" + "⧶", "\u29F6" + "Đ", "\u0110" + "đ", "\u0111" + "⋱", "\u22F1" + "▿", "\u25BF" + "▾", "\u25BE" + "⇵", "\u21F5" + "⥯", "\u296F" + "⦦", "\u29A6" + "Џ", "\u040F" + "џ", "\u045F" + "⟿", "\u27FF" + "É", "\u00C9" + "É", "\u00C9" + "é", "\u00E9" + "é", "\u00E9" + "⩮", "\u2A6E" + "Ě", "\u011A" + "ě", "\u011B" + "Ê", "\u00CA" + "Ê", "\u00CA" + "ê", "\u00EA" + "ê", "\u00EA" + "≖", "\u2256" + "≕", "\u2255" + "Э", "\u042D" + "э", "\u044D" + "⩷", "\u2A77" + "Ė", "\u0116" + "ė", "\u0117" + "≑", "\u2251" + "ⅇ", "\u2147" + "≒", "\u2252" + "𝔈", "\uD835\uDD08" + "𝔢", "\uD835\uDD22" + "⪚", "\u2A9A" + "È", "\u00C8" + "È", "\u00C8" + "è", "\u00E8" + "è", "\u00E8" + "⪖", "\u2A96" + "⪘", "\u2A98" + "⪙", "\u2A99" + "∈", "\u2208" + "⏧", "\u23E7" + "ℓ", "\u2113" + "⪕", "\u2A95" + "⪗", "\u2A97" + "Ē", "\u0112" + "ē", "\u0113" + "∅", "\u2205" + "∅", "\u2205" + "◻", "\u25FB" + "∅", "\u2205" + "▫", "\u25AB" + " ", "\u2004" + " ", "\u2005" + " ", "\u2003" + "Ŋ", "\u014A" + "ŋ", "\u014B" + " ", "\u2002" + "Ę", "\u0118" + "ę", "\u0119" + "𝔼", "\uD835\uDD3C" + "𝕖", "\uD835\uDD56" + "⋕", "\u22D5" + "⧣", "\u29E3" + "⩱", "\u2A71" + "ε", "\u03B5" + "Ε", "\u0395" + "ε", "\u03B5" + "ϵ", "\u03F5" + "≖", "\u2256" + "≕", "\u2255" + "≂", "\u2242" + "⪖", "\u2A96" + "⪕", "\u2A95" + "⩵", "\u2A75" + "=", "\u003D" + "≂", "\u2242" + "≟", "\u225F" + "⇌", "\u21CC" + "≡", "\u2261" + "⩸", "\u2A78" + "⧥", "\u29E5" + "⥱", "\u2971" + "≓", "\u2253" + "ℯ", "\u212F" + "ℰ", "\u2130" + "≐", "\u2250" + "⩳", "\u2A73" + "≂", "\u2242" + "Η", "\u0397" + "η", "\u03B7" + "Ð", "\u00D0" + "Ð", "\u00D0" + "ð", "\u00F0" + "ð", "\u00F0" + "Ë", "\u00CB" + "Ë", "\u00CB" + "ë", "\u00EB" + "ë", "\u00EB" + "€", "\u20AC" + "!", "\u0021" + "∃", "\u2203" + "∃", "\u2203" + "ℰ", "\u2130" + "ⅇ", "\u2147" + "ⅇ", "\u2147" + "≒", "\u2252" + "Ф", "\u0424" + "ф", "\u0444" + "♀", "\u2640" + "ffi", "\uFB03" + "ff", "\uFB00" + "ffl", "\uFB04" + "𝔉", "\uD835\uDD09" + "𝔣", "\uD835\uDD23" + "fi", "\uFB01" + "◼", "\u25FC" + "▪", "\u25AA" + "fj", "\u0066\u006A" + "♭", "\u266D" + "fl", "\uFB02" + "▱", "\u25B1" + "ƒ", "\u0192" + "𝔽", "\uD835\uDD3D" + "𝕗", "\uD835\uDD57" + "∀", "\u2200" + "∀", "\u2200" + "⋔", "\u22D4" + "⫙", "\u2AD9" + "ℱ", "\u2131" + "⨍", "\u2A0D" + "½", "\u00BD" + "½", "\u00BD" + "⅓", "\u2153" + "¼", "\u00BC" + "¼", "\u00BC" + "⅕", "\u2155" + "⅙", "\u2159" + "⅛", "\u215B" + "⅔", "\u2154" + "⅖", "\u2156" + "¾", "\u00BE" + "¾", "\u00BE" + "⅗", "\u2157" + "⅜", "\u215C" + "⅘", "\u2158" + "⅚", "\u215A" + "⅝", "\u215D" + "⅞", "\u215E" + "⁄", "\u2044" + "⌢", "\u2322" + "𝒻", "\uD835\uDCBB" + "ℱ", "\u2131" + "ǵ", "\u01F5" + "Γ", "\u0393" + "γ", "\u03B3" + "Ϝ", "\u03DC" + "ϝ", "\u03DD" + "⪆", "\u2A86" + "Ğ", "\u011E" + "ğ", "\u011F" + "Ģ", "\u0122" + "Ĝ", "\u011C" + "ĝ", "\u011D" + "Г", "\u0413" + "г", "\u0433" + "Ġ", "\u0120" + "ġ", "\u0121" + "≥", "\u2265" + "≧", "\u2267" + "⪌", "\u2A8C" + "⋛", "\u22DB" + "≥", "\u2265" + "≧", "\u2267" + "⩾", "\u2A7E" + "⪩", "\u2AA9" + "⩾", "\u2A7E" + "⪀", "\u2A80" + "⪂", "\u2A82" + "⪄", "\u2A84" + "⋛︀", "\u22DB\uFE00" + "⪔", "\u2A94" + "𝔊", "\uD835\uDD0A" + "𝔤", "\uD835\uDD24" + "≫", "\u226B" + "⋙", "\u22D9" + "⋙", "\u22D9" + "ℷ", "\u2137" + "Ѓ", "\u0403" + "ѓ", "\u0453" + "⪥", "\u2AA5" + "≷", "\u2277" + "⪒", "\u2A92" + "⪤", "\u2AA4" + "⪊", "\u2A8A" + "⪊", "\u2A8A" + "⪈", "\u2A88" + "≩", "\u2269" + "⪈", "\u2A88" + "≩", "\u2269" + "⋧", "\u22E7" + "𝔾", "\uD835\uDD3E" + "𝕘", "\uD835\uDD58" + "`", "\u0060" + "≥", "\u2265" + "⋛", "\u22DB" + "≧", "\u2267" + "⪢", "\u2AA2" + "≷", "\u2277" + "⩾", "\u2A7E" + "≳", "\u2273" + "𝒢", "\uD835\uDCA2" + "ℊ", "\u210A" + "≳", "\u2273" + "⪎", "\u2A8E" + "⪐", "\u2A90" + "⪧", "\u2AA7" + "⩺", "\u2A7A" + ">", "\u003E" + ">", "\u003E" + ">", "\u003E" + ">", "\u003E" + "≫", "\u226B" + "⋗", "\u22D7" + "⦕", "\u2995" + "⩼", "\u2A7C" + "⪆", "\u2A86" + "⥸", "\u2978" + "⋗", "\u22D7" + "⋛", "\u22DB" + "⪌", "\u2A8C" + "≷", "\u2277" + "≳", "\u2273" + "≩︀", "\u2269\uFE00" + "≩︀", "\u2269\uFE00" + "ˇ", "\u02C7" + " ", "\u200A" + "½", "\u00BD" + "ℋ", "\u210B" + "Ъ", "\u042A" + "ъ", "\u044A" + "⥈", "\u2948" + "↔", "\u2194" + "⇔", "\u21D4" + "↭", "\u21AD" + "^", "\u005E" + "ℏ", "\u210F" + "Ĥ", "\u0124" + "ĥ", "\u0125" + "♥", "\u2665" + "♥", "\u2665" + "…", "\u2026" + "⊹", "\u22B9" + "𝔥", "\uD835\uDD25" + "ℌ", "\u210C" + "ℋ", "\u210B" + "⤥", "\u2925" + "⤦", "\u2926" + "⇿", "\u21FF" + "∻", "\u223B" + "↩", "\u21A9" + "↪", "\u21AA" + "𝕙", "\uD835\uDD59" + "ℍ", "\u210D" + "―", "\u2015" + "─", "\u2500" + "𝒽", "\uD835\uDCBD" + "ℋ", "\u210B" + "ℏ", "\u210F" + "Ħ", "\u0126" + "ħ", "\u0127" + "≎", "\u224E" + "≏", "\u224F" + "⁃", "\u2043" + "‐", "\u2010" + "Í", "\u00CD" + "Í", "\u00CD" + "í", "\u00ED" + "í", "\u00ED" + "⁣", "\u2063" + "Î", "\u00CE" + "Î", "\u00CE" + "î", "\u00EE" + "î", "\u00EE" + "И", "\u0418" + "и", "\u0438" + "İ", "\u0130" + "Е", "\u0415" + "е", "\u0435" + "¡", "\u00A1" + "¡", "\u00A1" + "⇔", "\u21D4" + "𝔦", "\uD835\uDD26" + "ℑ", "\u2111" + "Ì", "\u00CC" + "Ì", "\u00CC" + "ì", "\u00EC" + "ì", "\u00EC" + "ⅈ", "\u2148" + "⨌", "\u2A0C" + "∭", "\u222D" + "⧜", "\u29DC" + "℩", "\u2129" + "IJ", "\u0132" + "ij", "\u0133" + "Ī", "\u012A" + "ī", "\u012B" + "ℑ", "\u2111" + "ⅈ", "\u2148" + "ℐ", "\u2110" + "ℑ", "\u2111" + "ı", "\u0131" + "ℑ", "\u2111" + "⊷", "\u22B7" + "Ƶ", "\u01B5" + "⇒", "\u21D2" + "℅", "\u2105" + "∈", "\u2208" + "∞", "\u221E" + "⧝", "\u29DD" + "ı", "\u0131" + "⊺", "\u22BA" + "∫", "\u222B" + "∬", "\u222C" + "ℤ", "\u2124" + "∫", "\u222B" + "⊺", "\u22BA" + "⋂", "\u22C2" + "⨗", "\u2A17" + "⨼", "\u2A3C" + "⁣", "\u2063" + "⁢", "\u2062" + "Ё", "\u0401" + "ё", "\u0451" + "Į", "\u012E" + "į", "\u012F" + "𝕀", "\uD835\uDD40" + "𝕚", "\uD835\uDD5A" + "Ι", "\u0399" + "ι", "\u03B9" + "⨼", "\u2A3C" + "¿", "\u00BF" + "¿", "\u00BF" + "𝒾", "\uD835\uDCBE" + "ℐ", "\u2110" + "∈", "\u2208" + "⋵", "\u22F5" + "⋹", "\u22F9" + "⋴", "\u22F4" + "⋳", "\u22F3" + "∈", "\u2208" + "⁢", "\u2062" + "Ĩ", "\u0128" + "ĩ", "\u0129" + "І", "\u0406" + "і", "\u0456" + "Ï", "\u00CF" + "Ï", "\u00CF" + "ï", "\u00EF" + "ï", "\u00EF" + "Ĵ", "\u0134" + "ĵ", "\u0135" + "Й", "\u0419" + "й", "\u0439" + "𝔍", "\uD835\uDD0D" + "𝔧", "\uD835\uDD27" + "ȷ", "\u0237" + "𝕁", "\uD835\uDD41" + "𝕛", "\uD835\uDD5B" + "𝒥", "\uD835\uDCA5" + "𝒿", "\uD835\uDCBF" + "Ј", "\u0408" + "ј", "\u0458" + "Є", "\u0404" + "є", "\u0454" + "Κ", "\u039A" + "κ", "\u03BA" + "ϰ", "\u03F0" + "Ķ", "\u0136" + "ķ", "\u0137" + "К", "\u041A" + "к", "\u043A" + "𝔎", "\uD835\uDD0E" + "𝔨", "\uD835\uDD28" + "ĸ", "\u0138" + "Х", "\u0425" + "х", "\u0445" + "Ќ", "\u040C" + "ќ", "\u045C" + "𝕂", "\uD835\uDD42" + "𝕜", "\uD835\uDD5C" + "𝒦", "\uD835\uDCA6" + "𝓀", "\uD835\uDCC0" + "⇚", "\u21DA" + "Ĺ", "\u0139" + "ĺ", "\u013A" + "⦴", "\u29B4" + "ℒ", "\u2112" + "Λ", "\u039B" + "λ", "\u03BB" + "⟨", "\u27E8" + "⟪", "\u27EA" + "⦑", "\u2991" + "⟨", "\u27E8" + "⪅", "\u2A85" + "ℒ", "\u2112" + "«", "\u00AB" + "«", "\u00AB" + "⇤", "\u21E4" + "⤟", "\u291F" + "←", "\u2190" + "↞", "\u219E" + "⇐", "\u21D0" + "⤝", "\u291D" + "↩", "\u21A9" + "↫", "\u21AB" + "⤹", "\u2939" + "⥳", "\u2973" + "↢", "\u21A2" + "⤙", "\u2919" + "⤛", "\u291B" + "⪫", "\u2AAB" + "⪭", "\u2AAD" + "⪭︀", "\u2AAD\uFE00" + "⤌", "\u290C" + "⤎", "\u290E" + "❲", "\u2772" + "{", "\u007B" + "[", "\u005B" + "⦋", "\u298B" + "⦏", "\u298F" + "⦍", "\u298D" + "Ľ", "\u013D" + "ľ", "\u013E" + "Ļ", "\u013B" + "ļ", "\u013C" + "⌈", "\u2308" + "{", "\u007B" + "Л", "\u041B" + "л", "\u043B" + "⤶", "\u2936" + "“", "\u201C" + "„", "\u201E" + "⥧", "\u2967" + "⥋", "\u294B" + "↲", "\u21B2" + "≤", "\u2264" + "≦", "\u2266" + "⟨", "\u27E8" + "⇤", "\u21E4" + "←", "\u2190" + "←", "\u2190" + "⇐", "\u21D0" + "⇆", "\u21C6" + "↢", "\u21A2" + "⌈", "\u2308" + "⟦", "\u27E6" + "⥡", "\u2961" + "⥙", "\u2959" + "⇃", "\u21C3" + "⌊", "\u230A" + "↽", "\u21BD" + "↼", "\u21BC" + "⇇", "\u21C7" + "↔", "\u2194" + "↔", "\u2194" + "⇔", "\u21D4" + "⇆", "\u21C6" + "⇋", "\u21CB" + "↭", "\u21AD" + "⥎", "\u294E" + "↤", "\u21A4" + "⊣", "\u22A3" + "⥚", "\u295A" + "⋋", "\u22CB" + "⧏", "\u29CF" + "⊲", "\u22B2" + "⊴", "\u22B4" + "⥑", "\u2951" + "⥠", "\u2960" + "⥘", "\u2958" + "↿", "\u21BF" + "⥒", "\u2952" + "↼", "\u21BC" + "⪋", "\u2A8B" + "⋚", "\u22DA" + "≤", "\u2264" + "≦", "\u2266" + "⩽", "\u2A7D" + "⪨", "\u2AA8" + "⩽", "\u2A7D" + "⩿", "\u2A7F" + "⪁", "\u2A81" + "⪃", "\u2A83" + "⋚︀", "\u22DA\uFE00" + "⪓", "\u2A93" + "⪅", "\u2A85" + "⋖", "\u22D6" + "⋚", "\u22DA" + "⪋", "\u2A8B" + "⋚", "\u22DA" + "≦", "\u2266" + "≶", "\u2276" + "≶", "\u2276" + "⪡", "\u2AA1" + "≲", "\u2272" + "⩽", "\u2A7D" + "≲", "\u2272" + "⥼", "\u297C" + "⌊", "\u230A" + "𝔏", "\uD835\uDD0F" + "𝔩", "\uD835\uDD29" + "≶", "\u2276" + "⪑", "\u2A91" + "⥢", "\u2962" + "↽", "\u21BD" + "↼", "\u21BC" + "⥪", "\u296A" + "▄", "\u2584" + "Љ", "\u0409" + "љ", "\u0459" + "⇇", "\u21C7" + "≪", "\u226A" + "⋘", "\u22D8" + "⌞", "\u231E" + "⇚", "\u21DA" + "⥫", "\u296B" + "◺", "\u25FA" + "Ŀ", "\u013F" + "ŀ", "\u0140" + "⎰", "\u23B0" + "⎰", "\u23B0" + "⪉", "\u2A89" + "⪉", "\u2A89" + "⪇", "\u2A87" + "≨", "\u2268" + "⪇", "\u2A87" + "≨", "\u2268" + "⋦", "\u22E6" + "⟬", "\u27EC" + "⇽", "\u21FD" + "⟦", "\u27E6" + "⟵", "\u27F5" + "⟵", "\u27F5" + "⟸", "\u27F8" + "⟷", "\u27F7" + "⟷", "\u27F7" + "⟺", "\u27FA" + "⟼", "\u27FC" + "⟶", "\u27F6" + "⟶", "\u27F6" + "⟹", "\u27F9" + "↫", "\u21AB" + "↬", "\u21AC" + "⦅", "\u2985" + "𝕃", "\uD835\uDD43" + "𝕝", "\uD835\uDD5D" + "⨭", "\u2A2D" + "⨴", "\u2A34" + "∗", "\u2217" + "_", "\u005F" + "↙", "\u2199" + "↘", "\u2198" + "◊", "\u25CA" + "◊", "\u25CA" + "⧫", "\u29EB" + "(", "\u0028" + "⦓", "\u2993" + "⇆", "\u21C6" + "⌟", "\u231F" + "⇋", "\u21CB" + "⥭", "\u296D" + "‎", "\u200E" + "⊿", "\u22BF" + "‹", "\u2039" + "𝓁", "\uD835\uDCC1" + "ℒ", "\u2112" + "↰", "\u21B0" + "↰", "\u21B0" + "≲", "\u2272" + "⪍", "\u2A8D" + "⪏", "\u2A8F" + "[", "\u005B" + "‘", "\u2018" + "‚", "\u201A" + "Ł", "\u0141" + "ł", "\u0142" + "⪦", "\u2AA6" + "⩹", "\u2A79" + "<", "\u003C" + "<", "\u003C" + "<", "\u003C" + "<", "\u003C" + "≪", "\u226A" + "⋖", "\u22D6" + "⋋", "\u22CB" + "⋉", "\u22C9" + "⥶", "\u2976" + "⩻", "\u2A7B" + "◃", "\u25C3" + "⊴", "\u22B4" + "◂", "\u25C2" + "⦖", "\u2996" + "⥊", "\u294A" + "⥦", "\u2966" + "≨︀", "\u2268\uFE00" + "≨︀", "\u2268\uFE00" + "¯", "\u00AF" + "¯", "\u00AF" + "♂", "\u2642" + "✠", "\u2720" + "✠", "\u2720" + "⤅", "\u2905" + "↦", "\u21A6" + "↦", "\u21A6" + "↧", "\u21A7" + "↤", "\u21A4" + "↥", "\u21A5" + "▮", "\u25AE" + "⨩", "\u2A29" + "М", "\u041C" + "м", "\u043C" + "—", "\u2014" + "∺", "\u223A" + "∡", "\u2221" + " ", "\u205F" + "ℳ", "\u2133" + "𝔐", "\uD835\uDD10" + "𝔪", "\uD835\uDD2A" + "℧", "\u2127" + "µ", "\u00B5" + "µ", "\u00B5" + "*", "\u002A" + "⫰", "\u2AF0" + "∣", "\u2223" + "·", "\u00B7" + "·", "\u00B7" + "⊟", "\u229F" + "−", "\u2212" + "∸", "\u2238" + "⨪", "\u2A2A" + "∓", "\u2213" + "⫛", "\u2ADB" + "…", "\u2026" + "∓", "\u2213" + "⊧", "\u22A7" + "𝕄", "\uD835\uDD44" + "𝕞", "\uD835\uDD5E" + "∓", "\u2213" + "𝓂", "\uD835\uDCC2" + "ℳ", "\u2133" + "∾", "\u223E" + "Μ", "\u039C" + "μ", "\u03BC" + "⊸", "\u22B8" + "⊸", "\u22B8" + "∇", "\u2207" + "Ń", "\u0143" + "ń", "\u0144" + "∠⃒", "\u2220\u20D2" + "≉", "\u2249" + "⩰̸", "\u2A70\u0338" + "≋̸", "\u224B\u0338" + "ʼn", "\u0149" + "≉", "\u2249" + "♮", "\u266E" + "ℕ", "\u2115" + "♮", "\u266E" + " ", "\u00A0" + " ", "\u00A0" + "≎̸", "\u224E\u0338" + "≏̸", "\u224F\u0338" + "⩃", "\u2A43" + "Ň", "\u0147" + "ň", "\u0148" + "Ņ", "\u0145" + "ņ", "\u0146" + "≇", "\u2247" + "⩭̸", "\u2A6D\u0338" + "⩂", "\u2A42" + "Н", "\u041D" + "н", "\u043D" + "–", "\u2013" + "⤤", "\u2924" + "↗", "\u2197" + "⇗", "\u21D7" + "↗", "\u2197" + "≠", "\u2260" + "≐̸", "\u2250\u0338" + "​", "\u200B" + "​", "\u200B" + "​", "\u200B" + "​", "\u200B" + "≢", "\u2262" + "⤨", "\u2928" + "≂̸", "\u2242\u0338" + "≫", "\u226B" + "≪", "\u226A" + " ", "\u000A" + "∄", "\u2204" + "∄", "\u2204" + "𝔑", "\uD835\uDD11" + "𝔫", "\uD835\uDD2B" + "≧̸", "\u2267\u0338" + "≱", "\u2271" + "≱", "\u2271" + "≧̸", "\u2267\u0338" + "⩾̸", "\u2A7E\u0338" + "⩾̸", "\u2A7E\u0338" + "⋙̸", "\u22D9\u0338" + "≵", "\u2275" + "≫⃒", "\u226B\u20D2" + "≯", "\u226F" + "≯", "\u226F" + "≫̸", "\u226B\u0338" + "↮", "\u21AE" + "⇎", "\u21CE" + "⫲", "\u2AF2" + "∋", "\u220B" + "⋼", "\u22FC" + "⋺", "\u22FA" + "∋", "\u220B" + "Њ", "\u040A" + "њ", "\u045A" + "↚", "\u219A" + "⇍", "\u21CD" + "‥", "\u2025" + "≦̸", "\u2266\u0338" + "≰", "\u2270" + "↚", "\u219A" + "⇍", "\u21CD" + "↮", "\u21AE" + "⇎", "\u21CE" + "≰", "\u2270" + "≦̸", "\u2266\u0338" + "⩽̸", "\u2A7D\u0338" + "⩽̸", "\u2A7D\u0338" + "≮", "\u226E" + "⋘̸", "\u22D8\u0338" + "≴", "\u2274" + "≪⃒", "\u226A\u20D2" + "≮", "\u226E" + "⋪", "\u22EA" + "⋬", "\u22EC" + "≪̸", "\u226A\u0338" + "∤", "\u2224" + "⁠", "\u2060" + " ", "\u00A0" + "𝕟", "\uD835\uDD5F" + "ℕ", "\u2115" + "⫬", "\u2AEC" + "¬", "\u00AC" + "¬", "\u00AC" + "≢", "\u2262" + "≭", "\u226D" + "∦", "\u2226" + "∉", "\u2209" + "≠", "\u2260" + "≂̸", "\u2242\u0338" + "∄", "\u2204" + "≯", "\u226F" + "≱", "\u2271" + "≧̸", "\u2267\u0338" + "≫̸", "\u226B\u0338" + "≹", "\u2279" + "⩾̸", "\u2A7E\u0338" + "≵", "\u2275" + "≎̸", "\u224E\u0338" + "≏̸", "\u224F\u0338" + "∉", "\u2209" + "⋵̸", "\u22F5\u0338" + "⋹̸", "\u22F9\u0338" + "∉", "\u2209" + "⋷", "\u22F7" + "⋶", "\u22F6" + "⧏̸", "\u29CF\u0338" + "⋪", "\u22EA" + "⋬", "\u22EC" + "≮", "\u226E" + "≰", "\u2270" + "≸", "\u2278" + "≪̸", "\u226A\u0338" + "⩽̸", "\u2A7D\u0338" + "≴", "\u2274" + "⪢̸", "\u2AA2\u0338" + "⪡̸", "\u2AA1\u0338" + "∌", "\u220C" + "∌", "\u220C" + "⋾", "\u22FE" + "⋽", "\u22FD" + "⊀", "\u2280" + "⪯̸", "\u2AAF\u0338" + "⋠", "\u22E0" + "∌", "\u220C" + "⧐̸", "\u29D0\u0338" + "⋫", "\u22EB" + "⋭", "\u22ED" + "⊏̸", "\u228F\u0338" + "⋢", "\u22E2" + "⊐̸", "\u2290\u0338" + "⋣", "\u22E3" + "⊂⃒", "\u2282\u20D2" + "⊈", "\u2288" + "⊁", "\u2281" + "⪰̸", "\u2AB0\u0338" + "⋡", "\u22E1" + "≿̸", "\u227F\u0338" + "⊃⃒", "\u2283\u20D2" + "⊉", "\u2289" + "≁", "\u2241" + "≄", "\u2244" + "≇", "\u2247" + "≉", "\u2249" + "∤", "\u2224" + "∦", "\u2226" + "∦", "\u2226" + "⫽⃥", "\u2AFD\u20E5" + "∂̸", "\u2202\u0338" + "⨔", "\u2A14" + "⊀", "\u2280" + "⋠", "\u22E0" + "⊀", "\u2280" + "⪯̸", "\u2AAF\u0338" + "⪯̸", "\u2AAF\u0338" + "⤳̸", "\u2933\u0338" + "↛", "\u219B" + "⇏", "\u21CF" + "↝̸", "\u219D\u0338" + "↛", "\u219B" + "⇏", "\u21CF" + "⋫", "\u22EB" + "⋭", "\u22ED" + "⊁", "\u2281" + "⋡", "\u22E1" + "⪰̸", "\u2AB0\u0338" + "𝒩", "\uD835\uDCA9" + "𝓃", "\uD835\uDCC3" + "∤", "\u2224" + "∦", "\u2226" + "≁", "\u2241" + "≄", "\u2244" + "≄", "\u2244" + "∤", "\u2224" + "∦", "\u2226" + "⋢", "\u22E2" + "⋣", "\u22E3" + "⊄", "\u2284" + "⫅̸", "\u2AC5\u0338" + "⊈", "\u2288" + "⊂⃒", "\u2282\u20D2" + "⊈", "\u2288" + "⫅̸", "\u2AC5\u0338" + "⊁", "\u2281" + "⪰̸", "\u2AB0\u0338" + "⊅", "\u2285" + "⫆̸", "\u2AC6\u0338" + "⊉", "\u2289" + "⊃⃒", "\u2283\u20D2" + "⊉", "\u2289" + "⫆̸", "\u2AC6\u0338" + "≹", "\u2279" + "Ñ", "\u00D1" + "Ñ", "\u00D1" + "ñ", "\u00F1" + "ñ", "\u00F1" + "≸", "\u2278" + "⋪", "\u22EA" + "⋬", "\u22EC" + "⋫", "\u22EB" + "⋭", "\u22ED" + "Ν", "\u039D" + "ν", "\u03BD" + "#", "\u0023" + "№", "\u2116" + " ", "\u2007" + "≍⃒", "\u224D\u20D2" + "⊬", "\u22AC" + "⊭", "\u22AD" + "⊮", "\u22AE" + "⊯", "\u22AF" + "≥⃒", "\u2265\u20D2" + ">⃒", "\u003E\u20D2" + "⤄", "\u2904" + "⧞", "\u29DE" + "⤂", "\u2902" + "≤⃒", "\u2264\u20D2" + "<⃒", "\u003C\u20D2" + "⊴⃒", "\u22B4\u20D2" + "⤃", "\u2903" + "⊵⃒", "\u22B5\u20D2" + "∼⃒", "\u223C\u20D2" + "⤣", "\u2923" + "↖", "\u2196" + "⇖", "\u21D6" + "↖", "\u2196" + "⤧", "\u2927" + "Ó", "\u00D3" + "Ó", "\u00D3" + "ó", "\u00F3" + "ó", "\u00F3" + "⊛", "\u229B" + "Ô", "\u00D4" + "Ô", "\u00D4" + "ô", "\u00F4" + "ô", "\u00F4" + "⊚", "\u229A" + "О", "\u041E" + "о", "\u043E" + "⊝", "\u229D" + "Ő", "\u0150" + "ő", "\u0151" + "⨸", "\u2A38" + "⊙", "\u2299" + "⦼", "\u29BC" + "Œ", "\u0152" + "œ", "\u0153" + "⦿", "\u29BF" + "𝔒", "\uD835\uDD12" + "𝔬", "\uD835\uDD2C" + "˛", "\u02DB" + "Ò", "\u00D2" + "Ò", "\u00D2" + "ò", "\u00F2" + "ò", "\u00F2" + "⧁", "\u29C1" + "⦵", "\u29B5" + "Ω", "\u03A9" + "∮", "\u222E" + "↺", "\u21BA" + "⦾", "\u29BE" + "⦻", "\u29BB" + "‾", "\u203E" + "⧀", "\u29C0" + "Ō", "\u014C" + "ō", "\u014D" + "Ω", "\u03A9" + "ω", "\u03C9" + "Ο", "\u039F" + "ο", "\u03BF" + "⦶", "\u29B6" + "⊖", "\u2296" + "𝕆", "\uD835\uDD46" + "𝕠", "\uD835\uDD60" + "⦷", "\u29B7" + "“", "\u201C" + "‘", "\u2018" + "⦹", "\u29B9" + "⊕", "\u2295" + "↻", "\u21BB" + "⩔", "\u2A54" + "∨", "\u2228" + "⩝", "\u2A5D" + "ℴ", "\u2134" + "ℴ", "\u2134" + "ª", "\u00AA" + "ª", "\u00AA" + "º", "\u00BA" + "º", "\u00BA" + "⊶", "\u22B6" + "⩖", "\u2A56" + "⩗", "\u2A57" + "⩛", "\u2A5B" + "Ⓢ", "\u24C8" + "𝒪", "\uD835\uDCAA" + "ℴ", "\u2134" + "Ø", "\u00D8" + "Ø", "\u00D8" + "ø", "\u00F8" + "ø", "\u00F8" + "⊘", "\u2298" + "Õ", "\u00D5" + "Õ", "\u00D5" + "õ", "\u00F5" + "õ", "\u00F5" + "⨶", "\u2A36" + "⨷", "\u2A37" + "⊗", "\u2297" + "Ö", "\u00D6" + "Ö", "\u00D6" + "ö", "\u00F6" + "ö", "\u00F6" + "⌽", "\u233D" + "‾", "\u203E" + "⏞", "\u23DE" + "⎴", "\u23B4" + "⏜", "\u23DC" + "¶", "\u00B6" + "¶", "\u00B6" + "∥", "\u2225" + "∥", "\u2225" + "⫳", "\u2AF3" + "⫽", "\u2AFD" + "∂", "\u2202" + "∂", "\u2202" + "П", "\u041F" + "п", "\u043F" + "%", "\u0025" + ".", "\u002E" + "‰", "\u2030" + "⊥", "\u22A5" + "‱", "\u2031" + "𝔓", "\uD835\uDD13" + "𝔭", "\uD835\uDD2D" + "Φ", "\u03A6" + "φ", "\u03C6" + "ϕ", "\u03D5" + "ℳ", "\u2133" + "☎", "\u260E" + "Π", "\u03A0" + "π", "\u03C0" + "⋔", "\u22D4" + "ϖ", "\u03D6" + "ℏ", "\u210F" + "ℎ", "\u210E" + "ℏ", "\u210F" + "⨣", "\u2A23" + "⊞", "\u229E" + "⨢", "\u2A22" + "+", "\u002B" + "∔", "\u2214" + "⨥", "\u2A25" + "⩲", "\u2A72" + "±", "\u00B1" + "±", "\u00B1" + "±", "\u00B1" + "⨦", "\u2A26" + "⨧", "\u2A27" + "±", "\u00B1" + "ℌ", "\u210C" + "⨕", "\u2A15" + "𝕡", "\uD835\uDD61" + "ℙ", "\u2119" + "£", "\u00A3" + "£", "\u00A3" + "⪷", "\u2AB7" + "⪻", "\u2ABB" + "≺", "\u227A" + "≼", "\u227C" + "⪷", "\u2AB7" + "≺", "\u227A" + "≼", "\u227C" + "≺", "\u227A" + "⪯", "\u2AAF" + "≼", "\u227C" + "≾", "\u227E" + "⪯", "\u2AAF" + "⪹", "\u2AB9" + "⪵", "\u2AB5" + "⋨", "\u22E8" + "⪯", "\u2AAF" + "⪳", "\u2AB3" + "≾", "\u227E" + "′", "\u2032" + "″", "\u2033" + "ℙ", "\u2119" + "⪹", "\u2AB9" + "⪵", "\u2AB5" + "⋨", "\u22E8" + "∏", "\u220F" + "∏", "\u220F" + "⌮", "\u232E" + "⌒", "\u2312" + "⌓", "\u2313" + "∝", "\u221D" + "∝", "\u221D" + "∷", "\u2237" + "∝", "\u221D" + "≾", "\u227E" + "⊰", "\u22B0" + "𝒫", "\uD835\uDCAB" + "𝓅", "\uD835\uDCC5" + "Ψ", "\u03A8" + "ψ", "\u03C8" + " ", "\u2008" + "𝔔", "\uD835\uDD14" + "𝔮", "\uD835\uDD2E" + "⨌", "\u2A0C" + "𝕢", "\uD835\uDD62" + "ℚ", "\u211A" + "⁗", "\u2057" + "𝒬", "\uD835\uDCAC" + "𝓆", "\uD835\uDCC6" + "ℍ", "\u210D" + "⨖", "\u2A16" + "?", "\u003F" + "≟", "\u225F" + """, "\u0022" + """, "\u0022" + """, "\u0022" + """, "\u0022" + "⇛", "\u21DB" + "∽̱", "\u223D\u0331" + "Ŕ", "\u0154" + "ŕ", "\u0155" + "√", "\u221A" + "⦳", "\u29B3" + "⟩", "\u27E9" + "⟫", "\u27EB" + "⦒", "\u2992" + "⦥", "\u29A5" + "⟩", "\u27E9" + "»", "\u00BB" + "»", "\u00BB" + "⥵", "\u2975" + "⇥", "\u21E5" + "⤠", "\u2920" + "⤳", "\u2933" + "→", "\u2192" + "↠", "\u21A0" + "⇒", "\u21D2" + "⤞", "\u291E" + "↪", "\u21AA" + "↬", "\u21AC" + "⥅", "\u2945" + "⥴", "\u2974" + "⤖", "\u2916" + "↣", "\u21A3" + "↝", "\u219D" + "⤚", "\u291A" + "⤜", "\u291C" + "∶", "\u2236" + "ℚ", "\u211A" + "⤍", "\u290D" + "⤏", "\u290F" + "⤐", "\u2910" + "❳", "\u2773" + "}", "\u007D" + "]", "\u005D" + "⦌", "\u298C" + "⦎", "\u298E" + "⦐", "\u2990" + "Ř", "\u0158" + "ř", "\u0159" + "Ŗ", "\u0156" + "ŗ", "\u0157" + "⌉", "\u2309" + "}", "\u007D" + "Р", "\u0420" + "р", "\u0440" + "⤷", "\u2937" + "⥩", "\u2969" + "”", "\u201D" + "”", "\u201D" + "↳", "\u21B3" + "ℜ", "\u211C" + "ℛ", "\u211B" + "ℜ", "\u211C" + "ℝ", "\u211D" + "ℜ", "\u211C" + "▭", "\u25AD" + "®", "\u00AE" + "®", "\u00AE" + "®", "\u00AE" + "®", "\u00AE" + "∋", "\u220B" + "⇋", "\u21CB" + "⥯", "\u296F" + "⥽", "\u297D" + "⌋", "\u230B" + "𝔯", "\uD835\uDD2F" + "ℜ", "\u211C" + "⥤", "\u2964" + "⇁", "\u21C1" + "⇀", "\u21C0" + "⥬", "\u296C" + "Ρ", "\u03A1" + "ρ", "\u03C1" + "ϱ", "\u03F1" + "⟩", "\u27E9" + "⇥", "\u21E5" + "→", "\u2192" + "→", "\u2192" + "⇒", "\u21D2" + "⇄", "\u21C4" + "↣", "\u21A3" + "⌉", "\u2309" + "⟧", "\u27E7" + "⥝", "\u295D" + "⥕", "\u2955" + "⇂", "\u21C2" + "⌋", "\u230B" + "⇁", "\u21C1" + "⇀", "\u21C0" + "⇄", "\u21C4" + "⇌", "\u21CC" + "⇉", "\u21C9" + "↝", "\u219D" + "↦", "\u21A6" + "⊢", "\u22A2" + "⥛", "\u295B" + "⋌", "\u22CC" + "⧐", "\u29D0" + "⊳", "\u22B3" + "⊵", "\u22B5" + "⥏", "\u294F" + "⥜", "\u295C" + "⥔", "\u2954" + "↾", "\u21BE" + "⥓", "\u2953" + "⇀", "\u21C0" + "˚", "\u02DA" + "≓", "\u2253" + "⇄", "\u21C4" + "⇌", "\u21CC" + "‏", "\u200F" + "⎱", "\u23B1" + "⎱", "\u23B1" + "⫮", "\u2AEE" + "⟭", "\u27ED" + "⇾", "\u21FE" + "⟧", "\u27E7" + "⦆", "\u2986" + "𝕣", "\uD835\uDD63" + "ℝ", "\u211D" + "⨮", "\u2A2E" + "⨵", "\u2A35" + "⥰", "\u2970" + ")", "\u0029" + "⦔", "\u2994" + "⨒", "\u2A12" + "⇉", "\u21C9" + "⇛", "\u21DB" + "›", "\u203A" + "𝓇", "\uD835\uDCC7" + "ℛ", "\u211B" + "↱", "\u21B1" + "↱", "\u21B1" + "]", "\u005D" + "’", "\u2019" + "’", "\u2019" + "⋌", "\u22CC" + "⋊", "\u22CA" + "▹", "\u25B9" + "⊵", "\u22B5" + "▸", "\u25B8" + "⧎", "\u29CE" + "⧴", "\u29F4" + "⥨", "\u2968" + "℞", "\u211E" + "Ś", "\u015A" + "ś", "\u015B" + "‚", "\u201A" + "⪸", "\u2AB8" + "Š", "\u0160" + "š", "\u0161" + "⪼", "\u2ABC" + "≻", "\u227B" + "≽", "\u227D" + "⪰", "\u2AB0" + "⪴", "\u2AB4" + "Ş", "\u015E" + "ş", "\u015F" + "Ŝ", "\u015C" + "ŝ", "\u015D" + "⪺", "\u2ABA" + "⪶", "\u2AB6" + "⋩", "\u22E9" + "⨓", "\u2A13" + "≿", "\u227F" + "С", "\u0421" + "с", "\u0441" + "⊡", "\u22A1" + "⋅", "\u22C5" + "⩦", "\u2A66" + "⤥", "\u2925" + "↘", "\u2198" + "⇘", "\u21D8" + "↘", "\u2198" + "§", "\u00A7" + "§", "\u00A7" + ";", "\u003B" + "⤩", "\u2929" + "∖", "\u2216" + "∖", "\u2216" + "✶", "\u2736" + "𝔖", "\uD835\uDD16" + "𝔰", "\uD835\uDD30" + "⌢", "\u2322" + "♯", "\u266F" + "Щ", "\u0429" + "щ", "\u0449" + "Ш", "\u0428" + "ш", "\u0448" + "↓", "\u2193" + "←", "\u2190" + "∣", "\u2223" + "∥", "\u2225" + "→", "\u2192" + "↑", "\u2191" + "­", "\u00AD" + "­", "\u00AD" + "Σ", "\u03A3" + "σ", "\u03C3" + "ς", "\u03C2" + "ς", "\u03C2" + "∼", "\u223C" + "⩪", "\u2A6A" + "≃", "\u2243" + "≃", "\u2243" + "⪞", "\u2A9E" + "⪠", "\u2AA0" + "⪝", "\u2A9D" + "⪟", "\u2A9F" + "≆", "\u2246" + "⨤", "\u2A24" + "⥲", "\u2972" + "←", "\u2190" + "∘", "\u2218" + "∖", "\u2216" + "⨳", "\u2A33" + "⧤", "\u29E4" + "∣", "\u2223" + "⌣", "\u2323" + "⪪", "\u2AAA" + "⪬", "\u2AAC" + "⪬︀", "\u2AAC\uFE00" + "Ь", "\u042C" + "ь", "\u044C" + "⌿", "\u233F" + "⧄", "\u29C4" + "/", "\u002F" + "𝕊", "\uD835\uDD4A" + "𝕤", "\uD835\uDD64" + "♠", "\u2660" + "♠", "\u2660" + "∥", "\u2225" + "⊓", "\u2293" + "⊓︀", "\u2293\uFE00" + "⊔", "\u2294" + "⊔︀", "\u2294\uFE00" + "√", "\u221A" + "⊏", "\u228F" + "⊑", "\u2291" + "⊏", "\u228F" + "⊑", "\u2291" + "⊐", "\u2290" + "⊒", "\u2292" + "⊐", "\u2290" + "⊒", "\u2292" + "□", "\u25A1" + "□", "\u25A1" + "⊓", "\u2293" + "⊏", "\u228F" + "⊑", "\u2291" + "⊐", "\u2290" + "⊒", "\u2292" + "⊔", "\u2294" + "▪", "\u25AA" + "□", "\u25A1" + "▪", "\u25AA" + "→", "\u2192" + "𝒮", "\uD835\uDCAE" + "𝓈", "\uD835\uDCC8" + "∖", "\u2216" + "⌣", "\u2323" + "⋆", "\u22C6" + "⋆", "\u22C6" + "☆", "\u2606" + "★", "\u2605" + "ϵ", "\u03F5" + "ϕ", "\u03D5" + "¯", "\u00AF" + "⊂", "\u2282" + "⋐", "\u22D0" + "⪽", "\u2ABD" + "⫅", "\u2AC5" + "⊆", "\u2286" + "⫃", "\u2AC3" + "⫁", "\u2AC1" + "⫋", "\u2ACB" + "⊊", "\u228A" + "⪿", "\u2ABF" + "⥹", "\u2979" + "⊂", "\u2282" + "⋐", "\u22D0" + "⊆", "\u2286" + "⫅", "\u2AC5" + "⊆", "\u2286" + "⊊", "\u228A" + "⫋", "\u2ACB" + "⫇", "\u2AC7" + "⫕", "\u2AD5" + "⫓", "\u2AD3" + "⪸", "\u2AB8" + "≻", "\u227B" + "≽", "\u227D" + "≻", "\u227B" + "⪰", "\u2AB0" + "≽", "\u227D" + "≿", "\u227F" + "⪰", "\u2AB0" + "⪺", "\u2ABA" + "⪶", "\u2AB6" + "⋩", "\u22E9" + "≿", "\u227F" + "∋", "\u220B" + "∑", "\u2211" + "∑", "\u2211" + "♪", "\u266A" + "¹", "\u00B9" + "¹", "\u00B9" + "²", "\u00B2" + "²", "\u00B2" + "³", "\u00B3" + "³", "\u00B3" + "⊃", "\u2283" + "⋑", "\u22D1" + "⪾", "\u2ABE" + "⫘", "\u2AD8" + "⫆", "\u2AC6" + "⊇", "\u2287" + "⫄", "\u2AC4" + "⊃", "\u2283" + "⊇", "\u2287" + "⟉", "\u27C9" + "⫗", "\u2AD7" + "⥻", "\u297B" + "⫂", "\u2AC2" + "⫌", "\u2ACC" + "⊋", "\u228B" + "⫀", "\u2AC0" + "⊃", "\u2283" + "⋑", "\u22D1" + "⊇", "\u2287" + "⫆", "\u2AC6" + "⊋", "\u228B" + "⫌", "\u2ACC" + "⫈", "\u2AC8" + "⫔", "\u2AD4" + "⫖", "\u2AD6" + "⤦", "\u2926" + "↙", "\u2199" + "⇙", "\u21D9" + "↙", "\u2199" + "⤪", "\u292A" + "ß", "\u00DF" + "ß", "\u00DF" + " ", "\u0009" + "⌖", "\u2316" + "Τ", "\u03A4" + "τ", "\u03C4" + "⎴", "\u23B4" + "Ť", "\u0164" + "ť", "\u0165" + "Ţ", "\u0162" + "ţ", "\u0163" + "Т", "\u0422" + "т", "\u0442" + "⃛", "\u20DB" + "⌕", "\u2315" + "𝔗", "\uD835\uDD17" + "𝔱", "\uD835\uDD31" + "∴", "\u2234" + "∴", "\u2234" + "∴", "\u2234" + "Θ", "\u0398" + "θ", "\u03B8" + "ϑ", "\u03D1" + "ϑ", "\u03D1" + "≈", "\u2248" + "∼", "\u223C" + "  ", "\u205F\u200A" + " ", "\u2009" + " ", "\u2009" + "≈", "\u2248" + "∼", "\u223C" + "Þ", "\u00DE" + "Þ", "\u00DE" + "þ", "\u00FE" + "þ", "\u00FE" + "˜", "\u02DC" + "∼", "\u223C" + "≃", "\u2243" + "≅", "\u2245" + "≈", "\u2248" + "⨱", "\u2A31" + "⊠", "\u22A0" + "×", "\u00D7" + "×", "\u00D7" + "⨰", "\u2A30" + "∭", "\u222D" + "⤨", "\u2928" + "⌶", "\u2336" + "⫱", "\u2AF1" + "⊤", "\u22A4" + "𝕋", "\uD835\uDD4B" + "𝕥", "\uD835\uDD65" + "⫚", "\u2ADA" + "⤩", "\u2929" + "‴", "\u2034" + "™", "\u2122" + "™", "\u2122" + "▵", "\u25B5" + "▿", "\u25BF" + "◃", "\u25C3" + "⊴", "\u22B4" + "≜", "\u225C" + "▹", "\u25B9" + "⊵", "\u22B5" + "◬", "\u25EC" + "≜", "\u225C" + "⨺", "\u2A3A" + "⃛", "\u20DB" + "⨹", "\u2A39" + "⧍", "\u29CD" + "⨻", "\u2A3B" + "⏢", "\u23E2" + "𝒯", "\uD835\uDCAF" + "𝓉", "\uD835\uDCC9" + "Ц", "\u0426" + "ц", "\u0446" + "Ћ", "\u040B" + "ћ", "\u045B" + "Ŧ", "\u0166" + "ŧ", "\u0167" + "≬", "\u226C" + "↞", "\u219E" + "↠", "\u21A0" + "Ú", "\u00DA" + "Ú", "\u00DA" + "ú", "\u00FA" + "ú", "\u00FA" + "↑", "\u2191" + "↟", "\u219F" + "⇑", "\u21D1" + "⥉", "\u2949" + "Ў", "\u040E" + "ў", "\u045E" + "Ŭ", "\u016C" + "ŭ", "\u016D" + "Û", "\u00DB" + "Û", "\u00DB" + "û", "\u00FB" + "û", "\u00FB" + "У", "\u0423" + "у", "\u0443" + "⇅", "\u21C5" + "Ű", "\u0170" + "ű", "\u0171" + "⥮", "\u296E" + "⥾", "\u297E" + "𝔘", "\uD835\uDD18" + "𝔲", "\uD835\uDD32" + "Ù", "\u00D9" + "Ù", "\u00D9" + "ù", "\u00F9" + "ù", "\u00F9" + "⥣", "\u2963" + "↿", "\u21BF" + "↾", "\u21BE" + "▀", "\u2580" + "⌜", "\u231C" + "⌜", "\u231C" + "⌏", "\u230F" + "◸", "\u25F8" + "Ū", "\u016A" + "ū", "\u016B" + "¨", "\u00A8" + "¨", "\u00A8" + "_", "\u005F" + "⏟", "\u23DF" + "⎵", "\u23B5" + "⏝", "\u23DD" + "⋃", "\u22C3" + "⊎", "\u228E" + "Ų", "\u0172" + "ų", "\u0173" + "𝕌", "\uD835\uDD4C" + "𝕦", "\uD835\uDD66" + "⤒", "\u2912" + "↑", "\u2191" + "↑", "\u2191" + "⇑", "\u21D1" + "⇅", "\u21C5" + "↕", "\u2195" + "↕", "\u2195" + "⇕", "\u21D5" + "⥮", "\u296E" + "↿", "\u21BF" + "↾", "\u21BE" + "⊎", "\u228E" + "↖", "\u2196" + "↗", "\u2197" + "υ", "\u03C5" + "ϒ", "\u03D2" + "ϒ", "\u03D2" + "Υ", "\u03A5" + "υ", "\u03C5" + "↥", "\u21A5" + "⊥", "\u22A5" + "⇈", "\u21C8" + "⌝", "\u231D" + "⌝", "\u231D" + "⌎", "\u230E" + "Ů", "\u016E" + "ů", "\u016F" + "◹", "\u25F9" + "𝒰", "\uD835\uDCB0" + "𝓊", "\uD835\uDCCA" + "⋰", "\u22F0" + "Ũ", "\u0168" + "ũ", "\u0169" + "▵", "\u25B5" + "▴", "\u25B4" + "⇈", "\u21C8" + "Ü", "\u00DC" + "Ü", "\u00DC" + "ü", "\u00FC" + "ü", "\u00FC" + "⦧", "\u29A7" + "⦜", "\u299C" + "ϵ", "\u03F5" + "ϰ", "\u03F0" + "∅", "\u2205" + "ϕ", "\u03D5" + "ϖ", "\u03D6" + "∝", "\u221D" + "↕", "\u2195" + "⇕", "\u21D5" + "ϱ", "\u03F1" + "ς", "\u03C2" + "⊊︀", "\u228A\uFE00" + "⫋︀", "\u2ACB\uFE00" + "⊋︀", "\u228B\uFE00" + "⫌︀", "\u2ACC\uFE00" + "ϑ", "\u03D1" + "⊲", "\u22B2" + "⊳", "\u22B3" + "⫨", "\u2AE8" + "⫫", "\u2AEB" + "⫩", "\u2AE9" + "В", "\u0412" + "в", "\u0432" + "⊢", "\u22A2" + "⊨", "\u22A8" + "⊩", "\u22A9" + "⊫", "\u22AB" + "⫦", "\u2AE6" + "⊻", "\u22BB" + "∨", "\u2228" + "⋁", "\u22C1" + "≚", "\u225A" + "⋮", "\u22EE" + "|", "\u007C" + "‖", "\u2016" + "|", "\u007C" + "‖", "\u2016" + "∣", "\u2223" + "|", "\u007C" + "❘", "\u2758" + "≀", "\u2240" + " ", "\u200A" + "𝔙", "\uD835\uDD19" + "𝔳", "\uD835\uDD33" + "⊲", "\u22B2" + "⊂⃒", "\u2282\u20D2" + "⊃⃒", "\u2283\u20D2" + "𝕍", "\uD835\uDD4D" + "𝕧", "\uD835\uDD67" + "∝", "\u221D" + "⊳", "\u22B3" + "𝒱", "\uD835\uDCB1" + "𝓋", "\uD835\uDCCB" + "⫋︀", "\u2ACB\uFE00" + "⊊︀", "\u228A\uFE00" + "⫌︀", "\u2ACC\uFE00" + "⊋︀", "\u228B\uFE00" + "⊪", "\u22AA" + "⦚", "\u299A" + "Ŵ", "\u0174" + "ŵ", "\u0175" + "⩟", "\u2A5F" + "∧", "\u2227" + "⋀", "\u22C0" + "≙", "\u2259" + "℘", "\u2118" + "𝔚", "\uD835\uDD1A" + "𝔴", "\uD835\uDD34" + "𝕎", "\uD835\uDD4E" + "𝕨", "\uD835\uDD68" + "℘", "\u2118" + "≀", "\u2240" + "≀", "\u2240" + "𝒲", "\uD835\uDCB2" + "𝓌", "\uD835\uDCCC" + "⋂", "\u22C2" + "◯", "\u25EF" + "⋃", "\u22C3" + "▽", "\u25BD" + "𝔛", "\uD835\uDD1B" + "𝔵", "\uD835\uDD35" + "⟷", "\u27F7" + "⟺", "\u27FA" + "Ξ", "\u039E" + "ξ", "\u03BE" + "⟵", "\u27F5" + "⟸", "\u27F8" + "⟼", "\u27FC" + "⋻", "\u22FB" + "⨀", "\u2A00" + "𝕏", "\uD835\uDD4F" + "𝕩", "\uD835\uDD69" + "⨁", "\u2A01" + "⨂", "\u2A02" + "⟶", "\u27F6" + "⟹", "\u27F9" + "𝒳", "\uD835\uDCB3" + "𝓍", "\uD835\uDCCD" + "⨆", "\u2A06" + "⨄", "\u2A04" + "△", "\u25B3" + "⋁", "\u22C1" + "⋀", "\u22C0" + "Ý", "\u00DD" + "Ý", "\u00DD" + "ý", "\u00FD" + "ý", "\u00FD" + "Я", "\u042F" + "я", "\u044F" + "Ŷ", "\u0176" + "ŷ", "\u0177" + "Ы", "\u042B" + "ы", "\u044B" + "¥", "\u00A5" + "¥", "\u00A5" + "𝔜", "\uD835\uDD1C" + "𝔶", "\uD835\uDD36" + "Ї", "\u0407" + "ї", "\u0457" + "𝕐", "\uD835\uDD50" + "𝕪", "\uD835\uDD6A" + "𝒴", "\uD835\uDCB4" + "𝓎", "\uD835\uDCCE" + "Ю", "\u042E" + "ю", "\u044E" + "ÿ", "\u00FF" + "ÿ", "\u00FF" + "Ÿ", "\u0178" + "Ź", "\u0179" + "ź", "\u017A" + "Ž", "\u017D" + "ž", "\u017E" + "З", "\u0417" + "з", "\u0437" + "Ż", "\u017B" + "ż", "\u017C" + "ℨ", "\u2128" + "​", "\u200B" + "Ζ", "\u0396" + "ζ", "\u03B6" + "𝔷", "\uD835\uDD37" + "ℨ", "\u2128" + "Ж", "\u0416" + "ж", "\u0436" + "⇝", "\u21DD" + "𝕫", "\uD835\uDD6B" + "ℤ", "\u2124" + "𝒵", "\uD835\uDCB5" + "𝓏", "\uD835\uDCCF" + "‍", "\u200D" + "‌", "\u200C" |] + |> Map.ofArray + + let (|Number|Lookup|) (orig: string) = + let s = orig.TrimEnd([| ';' |]) + + if s.Length > 2 then + let (delimeters, discriminator) = + s.ToLowerInvariant() + |> (fun ref -> (ref.[0..1], ref.[ref.Length - 1]), ref.[2]) - let (|Number|Lookup|) (orig:string) = - let s = orig.TrimEnd([|';'|]) - if s.Length > 2 - then - let (delimeters, discriminator) = s.ToLowerInvariant() |> (fun ref -> (ref.[0..1], ref.[ref.Length - 1]), ref.[2]) match delimeters with - | ("&#", _) -> - let num = - if discriminator <> 'x' - then s.Substring(2, s.Length - 2) - else s.Substring(3, s.Length - 3) + | ("&#", _) -> + let num = + if discriminator <> 'x' then + s.Substring(2, s.Length - 2) + else + s.Substring(3, s.Length - 3) + match UInt32.TryParse(num, NumberStyles.Integer, CultureInfo.InvariantCulture) with | true, i -> Number(i) | false, _ -> Lookup(orig) - | ("&x", _) -> + | ("&x", _) -> let num = s.Substring(2, s.Length - 2) + match UInt32.TryParse(num, NumberStyles.AllowHexSpecifier, CultureInfo.InvariantCulture) with | true, i -> Number(i) | false, _ -> Lookup(orig) - | _ -> Lookup(orig) - else Lookup(orig) + | _ -> Lookup(orig) + else + Lookup(orig) - let substitute (ref:string) = + let substitute (ref: string) = match ref with - | Number(num) -> + | Number (num) -> if num > 65535u then let lead, tail = UnicodeHelper.getUnicodeSurrogatePair num string lead + string tail else string (char num) - | Lookup(ref) -> defaultArg (refs.TryFind ref) ref + | Lookup (ref) -> defaultArg (refs.TryFind ref) ref diff --git a/src/Html/HtmlCssSelectorExtensions.fs b/src/Html/HtmlCssSelectorExtensions.fs index 2fb122e58..927599e1f 100644 --- a/src/Html/HtmlCssSelectorExtensions.fs +++ b/src/Html/HtmlCssSelectorExtensions.fs @@ -10,15 +10,14 @@ module CssSelectorExtensions = type CssSelectorExtensions = /// Gets descendants matched by Css selector [] - static member CssSelect (doc, selector) = + static member CssSelect(doc, selector) = HtmlNode.Select (doc |> HtmlDocument.elements) selector /// Gets descendants matched by Css selector [] - static member CssSelect (nodes, selector) = + static member CssSelect(nodes, selector) = HtmlNode.Select (nodes |> List.ofSeq) selector /// Gets descendants matched by Css selector [] - static member CssSelect (node, selector) = - HtmlNode.cssSelect node selector + static member CssSelect(node, selector) = HtmlNode.cssSelect node selector diff --git a/src/Html/HtmlCssSelectors.fs b/src/Html/HtmlCssSelectors.fs index 3a34a5756..93ec31aaf 100644 --- a/src/Html/HtmlCssSelectors.fs +++ b/src/Html/HtmlCssSelectors.fs @@ -11,14 +11,14 @@ module internal HtmlCssSelectors = | CssClass of int * string | CssId of int * string | AllChildren of int - | OpenAttribute of int + | OpenAttribute of int | CloseAttribute of int | AttributeName of int * string | AttributeValue of int * string | Assign of int | EndWith of int | StartWith of int - | DirectChildren of int + | DirectChildren of int | AttributeContainsPrefix of int | AttributeContains of int | AttributeContainsWord of int @@ -41,55 +41,67 @@ module internal HtmlCssSelectors = | Odd of int type CssSelectorTokenizer() = - let mutable charCount:int = 0 + let mutable charCount: int = 0 let mutable source = List.Empty let mutable cssSelector = "" - let mutable inQuotes:bool = false + let mutable inQuotes: bool = false - let getOffset (t:List) = - charCount - 1 - t.Length + let getOffset (t: List) = charCount - 1 - t.Length - let isCharacterEscapable (c:char) = + let isCharacterEscapable (c: char) = (* CSS 2.1: Any character (except a hexadecimal digit, linefeed, carriage return, or form feed) can be escaped with a backslash to remove its special meaning *) - let isHexadecimalDigit = Char.IsDigit(c) || (Char.ToLower(c) >= 'a' && Char.ToLower(c) <= 'f') - (isHexadecimalDigit || c = '\n' || c = '\f' || c = '\r') + let isHexadecimalDigit = + Char.IsDigit(c) + || (Char.ToLower(c) >= 'a' && Char.ToLower(c) <= 'f') + + (isHexadecimalDigit + || c = '\n' + || c = '\f' + || c = '\r') |> not - let rec readString acc = function - | c :: t when Char.IsLetterOrDigit(c) || c.Equals('-') || c.Equals('_') - || c.Equals('+') || c.Equals('/') - -> readString (acc + (c.ToString())) t - | '\'' :: t -> + let rec readString acc = + function + | c :: t when + Char.IsLetterOrDigit(c) + || c.Equals('-') + || c.Equals('_') + || c.Equals('+') + || c.Equals('/') + -> + readString (acc + (c.ToString())) t + | '\'' :: t -> if inQuotes then inQuotes <- false acc, t else inQuotes <- true readString acc t - | '\\' :: c :: t when isCharacterEscapable c -> - readString (acc + (c.ToString())) t - | c :: t when inQuotes -> - readString (acc + (c.ToString())) t + | '\\' :: c :: t when isCharacterEscapable c -> readString (acc + (c.ToString())) t + | c :: t when inQuotes -> readString (acc + (c.ToString())) t | c :: t -> acc, c :: t - | [] -> - acc, [] - | c -> - failwithf "Invalid css selector syntax at: %s" (new String(Array.ofList c)) - - let (|StartsWith|_|) (s:string) (items:char list) = + | [] -> acc, [] + | c -> failwithf "Invalid css selector syntax at: %s" (new String(Array.ofList c)) + + let (|StartsWith|_|) (s: string) (items: char list) = let candidates = s.ToCharArray() + if items.Length < candidates.Length then None else - let start = items |> Seq.take(candidates.Length) |> Seq.toList - if (Seq.compareWith (fun a b -> (int a) - (int b)) start candidates) = 0 then - Some (items |> Seq.skip s.Length |> Seq.toList) + let start = + items + |> Seq.take (candidates.Length) + |> Seq.toList + + if (Seq.compareWith (fun a b -> (int a) - (int b)) start candidates) = 0 then + Some(items |> Seq.skip s.Length |> Seq.toList) else None - let (|TokenStr|_|) (s:string) x = + let (|TokenStr|_|) (s: string) x = let chars = s.ToCharArray() |> Array.toList let rec equal x s = @@ -100,101 +112,129 @@ module internal HtmlCssSelectors = equal x chars - let tokenize() = - let rec tokenize' acc sourceChars = + let tokenize () = + let rec tokenize' acc sourceChars = match sourceChars with - | w :: t when Char.IsWhiteSpace(w) -> + | w :: t when Char.IsWhiteSpace(w) -> let seqtoken = acc |> List.tail + match acc.Head with - | AllChildren _ -> tokenize' (AllChildren(getOffset t) :: seqtoken) t - | DirectChildren _ -> tokenize' (DirectChildren(getOffset t) :: seqtoken) t - | _ -> tokenize' (AllChildren(getOffset t) :: acc) t - | '.' :: t -> + | AllChildren _ -> tokenize' (AllChildren(getOffset t) :: seqtoken) t + | DirectChildren _ -> tokenize' (DirectChildren(getOffset t) :: seqtoken) t + | _ -> tokenize' (AllChildren(getOffset t) :: acc) t + | '.' :: t -> let s, t' = readString "" t - tokenize' (CssClass(getOffset t + 1, s) :: ClassPrefix(getOffset t) :: acc) t' - | '#' :: t -> + + tokenize' + (CssClass(getOffset t + 1, s) + :: ClassPrefix(getOffset t) :: acc) + t' + | '#' :: t -> let s, t' = readString "" t - tokenize' (CssId(getOffset t + 1, s) :: IdPrefix(getOffset t) :: acc) t' + + tokenize' + (CssId(getOffset t + 1, s) + :: IdPrefix(getOffset t) :: acc) + t' | '[' :: t -> let s, t' = readString "" t - tokenize' (AttributeName(getOffset t + 1, s) :: OpenAttribute(getOffset t) :: acc) t' - | ']' :: t -> - tokenize' (CloseAttribute(getOffset t) :: acc) t + + tokenize' + (AttributeName(getOffset t + 1, s) + :: OpenAttribute(getOffset t) :: acc) + t' + | ']' :: t -> tokenize' (CloseAttribute(getOffset t) :: acc) t | '=' :: t -> let s, t' = readString "" t - tokenize' (AttributeValue(getOffset t + 1, s) :: Assign(getOffset t) :: acc) t' + + tokenize' + (AttributeValue(getOffset t + 1, s) + :: Assign(getOffset t) :: acc) + t' | '$' :: '=' :: t -> let s, t' = readString "" t - tokenize' (AttributeValue(getOffset t + 1, s) :: EndWith(getOffset t) :: acc) t' + + tokenize' + (AttributeValue(getOffset t + 1, s) + :: EndWith(getOffset t) :: acc) + t' | '^' :: '=' :: t -> let s, t' = readString "" t - tokenize' (AttributeValue(getOffset t + 1, s) :: StartWith(getOffset t) :: acc) t' + + tokenize' + (AttributeValue(getOffset t + 1, s) + :: StartWith(getOffset t) :: acc) + t' | '|' :: '=' :: t -> let s, t' = readString "" t - tokenize' (AttributeValue(getOffset t + 1, s) :: AttributeContainsPrefix(getOffset t) :: acc) t' + + tokenize' + (AttributeValue(getOffset t + 1, s) + :: AttributeContainsPrefix(getOffset t) :: acc) + t' | '*' :: '=' :: t -> let s, t' = readString "" t - tokenize' (AttributeValue(getOffset t + 1, s) :: AttributeContains(getOffset t) :: acc) t' + + tokenize' + (AttributeValue(getOffset t + 1, s) + :: AttributeContains(getOffset t) :: acc) + t' | '~' :: '=' :: t -> let s, t' = readString "" t - tokenize' (AttributeValue(getOffset t + 1, s) :: AttributeContainsWord(getOffset t) :: acc) t' + + tokenize' + (AttributeValue(getOffset t + 1, s) + :: AttributeContainsWord(getOffset t) :: acc) + t' | '!' :: '=' :: t -> let s, t' = readString "" t - tokenize' (AttributeValue(getOffset t + 1, s) :: AttributeNotEqual(getOffset t) :: acc) t' - | StartsWith ":checkbox" t -> - tokenize' (Checkbox(getOffset t + 1) :: acc) t - | StartsWith ":selected" t -> - tokenize' (Selected(getOffset t + 1) :: acc) t - | StartsWith ":checked" t -> - tokenize' (Checked(getOffset t + 1) :: acc) t - | StartsWith ":button" t -> - tokenize' (Button(getOffset t + 1) :: acc) t - | StartsWith ":hidden" t -> - tokenize' (Hidden(getOffset t + 1) :: acc) t - | StartsWith ":radio" t -> - tokenize' (Radio(getOffset t + 1) :: acc) t - | StartsWith ":password" t -> - tokenize' (Password(getOffset t + 1) :: acc) t - | StartsWith ":empty" t -> - tokenize' (EmptyNode(getOffset t + 1) :: acc) t - | StartsWith ":image" t -> - tokenize' (Image(getOffset t + 1) :: acc) t - | StartsWith ":even" t -> - tokenize' (Even(getOffset t + 1) :: acc) t - | StartsWith ":odd" t -> - tokenize' (Odd(getOffset t + 1) :: acc) t + + tokenize' + (AttributeValue(getOffset t + 1, s) + :: AttributeNotEqual(getOffset t) :: acc) + t' + | StartsWith ":checkbox" t -> tokenize' (Checkbox(getOffset t + 1) :: acc) t + | StartsWith ":selected" t -> tokenize' (Selected(getOffset t + 1) :: acc) t + | StartsWith ":checked" t -> tokenize' (Checked(getOffset t + 1) :: acc) t + | StartsWith ":button" t -> tokenize' (Button(getOffset t + 1) :: acc) t + | StartsWith ":hidden" t -> tokenize' (Hidden(getOffset t + 1) :: acc) t + | StartsWith ":radio" t -> tokenize' (Radio(getOffset t + 1) :: acc) t + | StartsWith ":password" t -> tokenize' (Password(getOffset t + 1) :: acc) t + | StartsWith ":empty" t -> tokenize' (EmptyNode(getOffset t + 1) :: acc) t + | StartsWith ":image" t -> tokenize' (Image(getOffset t + 1) :: acc) t + | StartsWith ":even" t -> tokenize' (Even(getOffset t + 1) :: acc) t + | StartsWith ":odd" t -> tokenize' (Odd(getOffset t + 1) :: acc) t | TokenStr ":disabled" t -> let _, t' = readString "" t tokenize' (Disabled(getOffset t + 1) :: acc) t' - | StartsWith ":enabled" t -> - tokenize' (Enabled(getOffset t + 1) :: acc) t - | StartsWith ":file" t -> - tokenize' (File(getOffset t + 1) :: acc) t - | StartsWith ":submit" t -> - tokenize' (Submit(getOffset t + 1) :: acc) t - + | StartsWith ":enabled" t -> tokenize' (Enabled(getOffset t + 1) :: acc) t + | StartsWith ":file" t -> tokenize' (File(getOffset t + 1) :: acc) t + | StartsWith ":submit" t -> tokenize' (Submit(getOffset t + 1) :: acc) t + | '>' :: t -> - let seqtoken = acc |> List.toSeq |> Seq.skip(1) |> Seq.toList + let seqtoken = acc |> List.toSeq |> Seq.skip (1) |> Seq.toList + match acc.Head with - | AllChildren _ -> tokenize' (DirectChildren(getOffset t) :: seqtoken) t - | _ -> tokenize' (DirectChildren(getOffset t) :: acc) t - | c :: t when Char.IsLetterOrDigit(c) -> + | AllChildren _ -> tokenize' (DirectChildren(getOffset t) :: seqtoken) t + | _ -> tokenize' (DirectChildren(getOffset t) :: acc) t + | c :: t when Char.IsLetterOrDigit(c) -> let str = c.ToString() let s, t' = readString str t tokenize' (TagName(getOffset t, s) :: acc) t' - | [] -> List.rev acc - | c::t -> - let offset = getOffset (c::t) + | [] -> List.rev acc + | c :: t -> + let offset = getOffset (c :: t) failwith (sprintf "Invalid css selector syntax (char '%c' at offset %d)" c offset) + tokenize' [] source - member public x.Tokenize(pCssSelector:string) = + member public x.Tokenize(pCssSelector: string) = cssSelector <- pCssSelector source <- cssSelector.ToCharArray() |> Array.toList charCount <- source.Length - tokenize() + tokenize () - type FilterLevel = + type FilterLevel = | Root | Children | Descendants diff --git a/src/Html/HtmlGenerator.fs b/src/Html/HtmlGenerator.fs index d3f0e747a..964ac4661 100644 --- a/src/Html/HtmlGenerator.fs +++ b/src/Html/HtmlGenerator.fs @@ -16,154 +16,244 @@ open FSharp.Data.Runtime.StructuralTypes module internal HtmlGenerator = - type private FieldInfo = - { /// The representation type that is part of the tuple we extract the field from - TypeForTuple : Type - /// The provided property corresponding to the field - ProvidedProperty : ProvidedProperty - Convert: Expr -> Expr } + type private FieldInfo = + { + /// The representation type that is part of the tuple we extract the field from + TypeForTuple: Type + /// The provided property corresponding to the field + ProvidedProperty: ProvidedProperty + Convert: Expr -> Expr + } let private getPropertyName = NameUtils.capitalizeFirstLetter - - let private typeNameGenerator() = + + let private typeNameGenerator () = NameUtils.uniqueGenerator (fun s -> HtmlParser.invalidTypeNameRegex.Value.Replace(s, " ") - |> NameUtils.nicePascalName - ) + |> NameUtils.nicePascalName) - let private createTableType getTableTypeName (inferenceParameters, missingValuesStr, cultureStr) (table:HtmlTable) = + let private createTableType + getTableTypeName + (inferenceParameters, missingValuesStr, cultureStr) + (table: HtmlTable) + = - let columns = + let columns = match table.InferedProperties with | Some inferedProperties -> inferedProperties - | None -> - HtmlInference.inferColumns inferenceParameters - table.HeaderNamesAndUnits.Value - (if table.HasHeaders.Value then table.Rows.[1..] else table.Rows) - - let fields = columns |> List.mapi (fun index field -> - let typ, typWithoutMeasure, conv, _convBack = ConversionsGenerator.convertStringValue missingValuesStr cultureStr field - { TypeForTuple = typWithoutMeasure - ProvidedProperty = - ProvidedProperty(field.Name, typ, getterCode = fun (Singleton row) -> - if columns.Length = 1 then row else Expr.TupleGet(row, index)) - Convert = fun rowVarExpr -> conv <@ TextConversions.AsString((%%rowVarExpr:string[]).[index]) @> } ) - + | None -> + HtmlInference.inferColumns + inferenceParameters + table.HeaderNamesAndUnits.Value + (if table.HasHeaders.Value then + table.Rows.[1..] + else + table.Rows) + + let fields = + columns + |> List.mapi (fun index field -> + let typ, typWithoutMeasure, conv, _convBack = + ConversionsGenerator.convertStringValue missingValuesStr cultureStr field + + { TypeForTuple = typWithoutMeasure + ProvidedProperty = + ProvidedProperty( + field.Name, + typ, + getterCode = + fun (Singleton row) -> + if columns.Length = 1 then + row + else + Expr.TupleGet(row, index) + ) + Convert = fun rowVarExpr -> conv <@ TextConversions.AsString((%%rowVarExpr: string[]).[index]) @> }) + // The erased row type will be a tuple of all the field types (without the units of measure) let rowErasedType = - (match fields with + (match fields with | [ x ] -> x.TypeForTuple | _ -> FSharpType.MakeTupleType [| for field in fields -> field.TypeForTuple |]) - - let rowType = ProvidedTypeDefinition("Row", Some rowErasedType, hideObjectMethods = true, nonNullable = true) - + + let rowType = + ProvidedTypeDefinition("Row", Some rowErasedType, hideObjectMethods = true, nonNullable = true) + // Each property of the generated row type will simply be a tuple get for field in fields do rowType.AddMember field.ProvidedProperty - - let tableErasedWithRowErasedType = typedefof>.MakeGenericType(rowErasedType) - let tableErasedTypeWithGeneratedRow = typedefof>.MakeGenericType(rowType) - + + let tableErasedWithRowErasedType = + typedefof>.MakeGenericType (rowErasedType) + + let tableErasedTypeWithGeneratedRow = + typedefof>.MakeGenericType (rowType) + let rowConverter = let rowVar = Var("row", typeof) let rowVarExpr = Expr.Var rowVar + let body = - if fields.Length = 1 - then fields.Head.Convert rowVarExpr - else Expr.NewTuple [ for field in fields -> field.Convert rowVarExpr ] - - let delegateType = - typedefof>.MakeGenericType(typeof, rowErasedType) - - Expr.NewDelegate(delegateType, [rowVar], body) - - let create (htmlDoc:Expr) = + if fields.Length = 1 then + fields.Head.Convert rowVarExpr + else + Expr.NewTuple [ for field in fields -> field.Convert rowVarExpr ] + + let delegateType = + typedefof>.MakeGenericType (typeof, rowErasedType) + + Expr.NewDelegate(delegateType, [ rowVar ], body) + + let create (htmlDoc: Expr) = let rowConverterVar = Var("rowConverter", rowConverter.Type) - let body = tableErasedWithRowErasedType?Create () (Expr.Var rowConverterVar, htmlDoc, table.Name, table.HasHeaders.Value) + + let body = + tableErasedWithRowErasedType?Create + () + (Expr.Var rowConverterVar, htmlDoc, table.Name, table.HasHeaders.Value) + Expr.Let(rowConverterVar, rowConverter, body) - - let tableType = ProvidedTypeDefinition(getTableTypeName table.Name, Some tableErasedTypeWithGeneratedRow, hideObjectMethods = true, nonNullable = true) + + let tableType = + ProvidedTypeDefinition( + getTableTypeName table.Name, + Some tableErasedTypeWithGeneratedRow, + hideObjectMethods = true, + nonNullable = true + ) + tableType.AddMember rowType - + create, tableType - let private createListType getListTypeName (inferenceParameters, missingValuesStr, cultureStr) (list:HtmlList) = - + let private createListType getListTypeName (inferenceParameters, missingValuesStr, cultureStr) (list: HtmlList) = + let columns = HtmlInference.inferListType inferenceParameters list.Values let listItemType, conv = match columns with - | InferedType.Primitive(typ,_, optional) -> - let typ, _, conv, _convBack = ConversionsGenerator.convertStringValue missingValuesStr cultureStr (StructuralTypes.PrimitiveInferedProperty.Create("", typ, optional, None)) + | InferedType.Primitive (typ, _, optional) -> + let typ, _, conv, _convBack = + ConversionsGenerator.convertStringValue + missingValuesStr + cultureStr + (StructuralTypes.PrimitiveInferedProperty.Create("", typ, optional, None)) + typ, conv - | _ -> - let typ, _, conv, _convBack = ConversionsGenerator.convertStringValue missingValuesStr cultureStr (StructuralTypes.PrimitiveInferedProperty.Create("", typeof, false, None)) + | _ -> + let typ, _, conv, _convBack = + ConversionsGenerator.convertStringValue + missingValuesStr + cultureStr + (StructuralTypes.PrimitiveInferedProperty.Create("", typeof, false, None)) + typ, conv - - let listTypeWithErasedType = typedefof>.MakeGenericType(listItemType) - + + let listTypeWithErasedType = typedefof>.MakeGenericType (listItemType) + let rowConverter = - + let rowVar = Var("row", typeof) let rowVarExpr = Expr.Var rowVar - let body = - conv <@ TextConversions.AsString(%%rowVarExpr:string) @> - - let delegateType = typedefof>.MakeGenericType(typeof, listItemType) - - Expr.NewDelegate(delegateType, [rowVar], body) - - let create (htmlDoc:Expr) = + let body = conv <@ TextConversions.AsString(%%rowVarExpr: string) @> + + let delegateType = + typedefof>.MakeGenericType (typeof, listItemType) + + Expr.NewDelegate(delegateType, [ rowVar ], body) + + let create (htmlDoc: Expr) = let rowConverterVar = Var("rowConverter", rowConverter.Type) - let body = listTypeWithErasedType?Create () (Expr.Var rowConverterVar, htmlDoc, list.Name) + + let body = + listTypeWithErasedType?Create () (Expr.Var rowConverterVar, htmlDoc, list.Name) + Expr.Let(rowConverterVar, rowConverter, body) - let listType = ProvidedTypeDefinition(getListTypeName list.Name, Some listTypeWithErasedType, hideObjectMethods = true, nonNullable = true) + let listType = + ProvidedTypeDefinition( + getListTypeName list.Name, + Some listTypeWithErasedType, + hideObjectMethods = true, + nonNullable = true + ) + create, listType - let private createDefinitionListType getDefinitionListTypeName (inferenceParameters, missingValuesStr, cultureStr) (definitionList:HtmlDefinitionList) = + let private createDefinitionListType + getDefinitionListTypeName + (inferenceParameters, missingValuesStr, cultureStr) + (definitionList: HtmlDefinitionList) + = + + let getListTypeName = typeNameGenerator () - let getListTypeName = typeNameGenerator() + let createListType index (list: HtmlList) = - let createListType index (list:HtmlList) = - let columns = HtmlInference.inferListType inferenceParameters list.Values let listItemType, conv = match columns with - | StructuralTypes.InferedType.Primitive(typ,_, optional) -> - let typ, _, conv, _convBack = ConversionsGenerator.convertStringValue missingValuesStr cultureStr (StructuralTypes.PrimitiveInferedProperty.Create("", typ, optional, None)) + | StructuralTypes.InferedType.Primitive (typ, _, optional) -> + let typ, _, conv, _convBack = + ConversionsGenerator.convertStringValue + missingValuesStr + cultureStr + (StructuralTypes.PrimitiveInferedProperty.Create("", typ, optional, None)) + typ, conv - | _ -> - let typ, _, conv, _convBack = ConversionsGenerator.convertStringValue missingValuesStr cultureStr (StructuralTypes.PrimitiveInferedProperty.Create("", typeof, false, None)) + | _ -> + let typ, _, conv, _convBack = + ConversionsGenerator.convertStringValue + missingValuesStr + cultureStr + (StructuralTypes.PrimitiveInferedProperty.Create("", typeof, false, None)) + typ, conv - - let listTypeWithErasedType = typedefof>.MakeGenericType(listItemType) + + let listTypeWithErasedType = typedefof>.MakeGenericType (listItemType) let rowConverter = - + let rowVar = Var("row", typeof) let rowVarExpr = Expr.Var rowVar - let body = conv <@ TextConversions.AsString(%%rowVarExpr:string) @> - - let delegateType = - typedefof>.MakeGenericType(typeof, listItemType) - - Expr.NewDelegate(delegateType, [rowVar], body) - + let body = conv <@ TextConversions.AsString(%%rowVarExpr: string) @> + + let delegateType = + typedefof>.MakeGenericType (typeof, listItemType) + + Expr.NewDelegate(delegateType, [ rowVar ], body) + let create doc = let rowConverterVar = Var("rowConverter", rowConverter.Type) - let body = listTypeWithErasedType?CreateNested () (Expr.Var rowConverterVar, doc, definitionList.Name, index) - Expr.Let(rowConverterVar, rowConverter, body) - - let listType = ProvidedTypeDefinition(getListTypeName list.Name, Some listTypeWithErasedType, hideObjectMethods = true, nonNullable = true) - let prop = ProvidedProperty(getPropertyName list.Name, listType, getterCode = fun (Singleton doc) -> create doc) + let body = + listTypeWithErasedType?CreateNested () (Expr.Var rowConverterVar, doc, definitionList.Name, index) + + Expr.Let(rowConverterVar, rowConverter, body) + + + let listType = + ProvidedTypeDefinition( + getListTypeName list.Name, + Some listTypeWithErasedType, + hideObjectMethods = true, + nonNullable = true + ) + + let prop = + ProvidedProperty(getPropertyName list.Name, listType, getterCode = fun (Singleton doc) -> create doc) prop, listType - - let definitionListType = ProvidedTypeDefinition(getDefinitionListTypeName definitionList.Name, Some typeof, hideObjectMethods = true, nonNullable = true) - + + let definitionListType = + ProvidedTypeDefinition( + getDefinitionListTypeName definitionList.Name, + Some typeof, + hideObjectMethods = true, + nonNullable = true + ) + for prop, listType in List.mapi createListType definitionList.Definitions do definitionListType.AddMember listType definitionListType.AddMember prop @@ -172,18 +262,35 @@ module internal HtmlGenerator = let generateTypes asm ns typeName parameters htmlObjects = - let htmlType = ProvidedTypeDefinition(asm, ns, typeName, Some typeof, hideObjectMethods = true, nonNullable = true) - + let htmlType = + ProvidedTypeDefinition( + asm, + ns, + typeName, + Some typeof, + hideObjectMethods = true, + nonNullable = true + ) + let containerTypes = Dictionary() - let getTypeName = typeNameGenerator() + let getTypeName = typeNameGenerator () - let getOrCreateContainer name = + let getOrCreateContainer name = match containerTypes.TryGetValue(name) with | true, t -> t | false, _ -> - let containerType = ProvidedTypeDefinition(name + "Container", Some typeof, hideObjectMethods = true, nonNullable = true) - htmlType.AddMember <| ProvidedProperty(name, containerType, getterCode = fun (Singleton doc) -> doc) + let containerType = + ProvidedTypeDefinition( + name + "Container", + Some typeof, + hideObjectMethods = true, + nonNullable = true + ) + + htmlType.AddMember + <| ProvidedProperty(name, containerType, getterCode = fun (Singleton doc) -> doc) + htmlType.AddMember containerType containerTypes.Add(name, containerType) containerType @@ -191,20 +298,38 @@ module internal HtmlGenerator = for htmlObj in htmlObjects do match htmlObj with | Table table -> - let containerType = getOrCreateContainer "Tables" - let create, tableType = createTableType getTypeName parameters table - htmlType.AddMember tableType - containerType.AddMember <| ProvidedProperty(getPropertyName table.Name, tableType, getterCode = fun (Singleton doc) -> create doc) - + let containerType = getOrCreateContainer "Tables" + let create, tableType = createTableType getTypeName parameters table + htmlType.AddMember tableType + + containerType.AddMember + <| ProvidedProperty( + getPropertyName table.Name, + tableType, + getterCode = fun (Singleton doc) -> create doc + ) + | List list -> let containerType = getOrCreateContainer "Lists" let create, tableType = createListType getTypeName parameters list htmlType.AddMember tableType - containerType.AddMember <| ProvidedProperty(getPropertyName list.Name, tableType, getterCode = fun (Singleton doc) -> create doc) + + containerType.AddMember + <| ProvidedProperty( + getPropertyName list.Name, + tableType, + getterCode = fun (Singleton doc) -> create doc + ) | DefinitionList definitionList -> let containerType = getOrCreateContainer "DefinitionLists" let tableType = createDefinitionListType getTypeName parameters definitionList htmlType.AddMember tableType - containerType.AddMember <| ProvidedProperty(getPropertyName definitionList.Name, tableType, getterCode = fun (Singleton doc) -> doc) + + containerType.AddMember + <| ProvidedProperty( + getPropertyName definitionList.Name, + tableType, + getterCode = fun (Singleton doc) -> doc + ) htmlType diff --git a/src/Html/HtmlInference.fs b/src/Html/HtmlInference.fs index cb4e05755..9e7e341eb 100644 --- a/src/Html/HtmlInference.fs +++ b/src/Html/HtmlInference.fs @@ -7,47 +7,67 @@ open FSharp.Data.Runtime open FSharp.Data.Runtime.StructuralInference open FSharp.Data.Runtime.StructuralTypes -type Parameters = { - MissingValues: string[] - CultureInfo: CultureInfo - UnitsOfMeasureProvider: IUnitsOfMeasureProvider - PreferOptionals: bool } +type Parameters = + { MissingValues: string[] + CultureInfo: CultureInfo + UnitsOfMeasureProvider: IUnitsOfMeasureProvider + PreferOptionals: bool } -let inferColumns parameters (headerNamesAndUnits:_[]) rows = +let inferColumns parameters (headerNamesAndUnits: _[]) rows = let inferRows = 0 let schema = Array.init headerNamesAndUnits.Length (fun _ -> None) let assumeMissingValues = false - CsvInference.inferColumnTypes headerNamesAndUnits schema rows inferRows parameters.MissingValues parameters.CultureInfo assumeMissingValues parameters.PreferOptionals + CsvInference.inferColumnTypes + headerNamesAndUnits + schema + rows + inferRows + parameters.MissingValues + parameters.CultureInfo + assumeMissingValues + parameters.PreferOptionals -let inferHeaders parameters (rows:string[][]) = - if rows.Length <= 2 then +let inferHeaders parameters (rows: string[][]) = + if rows.Length <= 2 then false, None, None, None //Not enough info to infer anything, assume first row data else let headers = Some rows.[0] let numberOfColumns = rows.[0].Length - let headerNamesAndUnits, _ = CsvInference.parseHeaders headers numberOfColumns "" parameters.UnitsOfMeasureProvider - let headerRowType = inferColumns parameters headerNamesAndUnits [rows.[0]] - let dataRowsType = inferColumns parameters headerNamesAndUnits rows.[1..] - if headerRowType = dataRowsType then + + let headerNamesAndUnits, _ = + CsvInference.parseHeaders headers numberOfColumns "" parameters.UnitsOfMeasureProvider + + let headerRowType = inferColumns parameters headerNamesAndUnits [ rows.[0] ] + let dataRowsType = inferColumns parameters headerNamesAndUnits rows.[1..] + + if headerRowType = dataRowsType then false, None, None, None - else + else let headerNames, units = Array.unzip headerNamesAndUnits true, Some headerNames, Some units, Some dataRowsType -let inferListType parameters (values:string[]) = +let inferListType parameters (values: string[]) = if values.Length > 0 then - let inferedtype value = + let inferedtype value = // If there's only whitespace, treat it as a missing value and not as a string - if String.IsNullOrWhiteSpace value || value = " " || value = " " then InferedType.Null + if String.IsNullOrWhiteSpace value + || value = " " + || value = " " then + InferedType.Null // Explicit missing values (NaN, NA, etc.) will be treated as float unless the preferOptionals is set to true - elif Array.exists ((=) <| value.Trim()) parameters.MissingValues then - if parameters.PreferOptionals then InferedType.Null else InferedType.Primitive(typeof, None, false) - else getInferedTypeFromString parameters.CultureInfo value None + elif Array.exists ((=) <| value.Trim()) parameters.MissingValues then + if parameters.PreferOptionals then + InferedType.Null + else + InferedType.Primitive(typeof, None, false) + else + getInferedTypeFromString parameters.CultureInfo value None values |> Array.map inferedtype |> Array.reduce (subtypeInfered (not parameters.PreferOptionals)) - else InferedType.Null + else + InferedType.Null diff --git a/src/Html/HtmlOperations.fs b/src/Html/HtmlOperations.fs index 982cf74ff..75b9e5a09 100644 --- a/src/Html/HtmlOperations.fs +++ b/src/Html/HtmlOperations.fs @@ -7,24 +7,24 @@ open System.Runtime.CompilerServices [] module private Utils = - let inline toLower (s:string) = s.ToLowerInvariant() + let inline toLower (s: string) = s.ToLowerInvariant() let inline getNameSet names = names |> Seq.map toLower |> Set.ofSeq // -------------------------------------------------------------------------------------- [] /// Module with operations on HTML attributes -module HtmlAttribute = +module HtmlAttribute = /// Gets the name of the given attribute - let name attr = + let name attr = match attr with - | HtmlAttribute(name = name) -> name + | HtmlAttribute (name = name) -> name /// Gets the value of the given attribute - let value attr = + let value attr = match attr with - | HtmlAttribute(value = value) -> value + | HtmlAttribute (value = value) -> value // -------------------------------------------------------------------------------------- @@ -34,13 +34,11 @@ type HtmlAttributeExtensions = /// Gets the name of the current attribute [] - static member Name(attr:HtmlAttribute) = - HtmlAttribute.name attr + static member Name(attr: HtmlAttribute) = HtmlAttribute.name attr /// Gets the value of the current attribute [] - static member Value(attr:HtmlAttribute) = - HtmlAttribute.value attr + static member Value(attr: HtmlAttribute) = HtmlAttribute.value attr // -------------------------------------------------------------------------------------- @@ -51,13 +49,13 @@ module HtmlNode = /// Gets the given nodes name let name n = match n with - | HtmlElement(name = name) -> name + | HtmlElement (name = name) -> name | _ -> "" - + /// Gets all of the nodes immediately under this node let elements n = match n with - | HtmlElement(elements = elements) -> elements + | HtmlElement (elements = elements) -> elements | _ -> [] /// @@ -65,21 +63,27 @@ module HtmlNode = /// /// The set of names to match /// The given node - let inline elementsNamed names n = + let inline elementsNamed names n = let nameSet = getNameSet names - n |> elements |> List.filter (name >> nameSet.Contains) - - let private descendantsBy includeSelf recurseOnMatch predicate n = - let rec descendantsBy includeSelf n = seq { - let proceed = ref true - if includeSelf && predicate n then - yield n - if not recurseOnMatch then - proceed := false - if !proceed then - for element in elements n do - yield! descendantsBy true element - } + + n + |> elements + |> List.filter (name >> nameSet.Contains) + + let private descendantsBy includeSelf recurseOnMatch predicate n = + let rec descendantsBy includeSelf n = + seq { + let proceed = ref true + + if includeSelf && predicate n then + yield n + if not recurseOnMatch then proceed := false + + if !proceed then + for element in elements n do + yield! descendantsBy true element + } + descendantsBy includeSelf n /// @@ -100,16 +104,18 @@ module HtmlNode = /// The given node let descendantsAndSelf recurseOnMatch predicate n = descendantsBy true recurseOnMatch predicate n - + /// /// Finds all of the descendant nodes of this nodes that match the given set of names /// /// If a match is found continues down the tree matching child elements /// The set of names to match /// The given node - let inline descendantsNamed recurseOnMatch names n = + let inline descendantsNamed recurseOnMatch names n = let nameSet = getNameSet names - n |> descendants recurseOnMatch (name >> nameSet.Contains) + + n + |> descendants recurseOnMatch (name >> nameSet.Contains) /// /// Finds all of the descendant nodes of this nodes that match the given set of names @@ -118,30 +124,35 @@ module HtmlNode = /// If a match is found continues down the tree matching child elements /// The set of names to match /// The given node - let inline descendantsAndSelfNamed recurseOnMatch names n = + let inline descendantsAndSelfNamed recurseOnMatch names n = let nameSet = getNameSet names - n |> descendantsAndSelf recurseOnMatch (name >> nameSet.Contains) - - let private descendantsByWithPath includeSelf recurseOnMatch predicate n = - let rec descendantsByWithPath includeSelf path n = seq { - let proceed = ref true - if includeSelf && predicate n then - yield n, path - if not recurseOnMatch then - proceed := false - if !proceed then - for element in elements n do - yield! descendantsByWithPath true (n::path) element - } + + n + |> descendantsAndSelf recurseOnMatch (name >> nameSet.Contains) + + let private descendantsByWithPath includeSelf recurseOnMatch predicate n = + let rec descendantsByWithPath includeSelf path n = + seq { + let proceed = ref true + + if includeSelf && predicate n then + yield n, path + if not recurseOnMatch then proceed := false + + if !proceed then + for element in elements n do + yield! descendantsByWithPath true (n :: path) element + } + descendantsByWithPath includeSelf [] n - + /// /// Gets all of the descendants of this node that statisfy the given predicate /// /// If a match is found continues down the tree matching child elements /// The predicate by which to match the nodes to return /// The given node - let descendantsWithPath recurseOnMatch predicate n = + let descendantsWithPath recurseOnMatch predicate n = descendantsByWithPath false recurseOnMatch predicate n /// @@ -151,7 +162,7 @@ module HtmlNode = /// If a match is found continues down the tree matching child elements /// The predicate by which to match the nodes to return /// The given node - let descendantsAndSelfWithPath recurseOnMatch predicate n = + let descendantsAndSelfWithPath recurseOnMatch predicate n = descendantsByWithPath true recurseOnMatch predicate n /// @@ -160,9 +171,11 @@ module HtmlNode = /// If a match is found continues down the tree matching child elements /// The set of names to match /// The given node - let inline descendantsNamedWithPath recurseOnMatch names n = + let inline descendantsNamedWithPath recurseOnMatch names n = let nameSet = getNameSet names - n |> descendantsWithPath recurseOnMatch (name >> nameSet.Contains) + + n + |> descendantsWithPath recurseOnMatch (name >> nameSet.Contains) /// /// Finds all of the descendant nodes of this nodes that match the given set of names @@ -171,14 +184,16 @@ module HtmlNode = /// If a match is found continues down the tree matching child elements /// The set of names to match /// The given node - let inline descendantsAndSelfNamedWithPath recurseOnMatch names n = + let inline descendantsAndSelfNamedWithPath recurseOnMatch names n = let nameSet = getNameSet names - n |> descendantsAndSelfWithPath recurseOnMatch (name >> nameSet.Contains) + + n + |> descendantsAndSelfWithPath recurseOnMatch (name >> nameSet.Contains) /// Gets all of the attributes of this node let attributes n = match n with - | HtmlElement(attributes = attributes) -> attributes + | HtmlElement (attributes = attributes) -> attributes | _ -> [] /// @@ -187,15 +202,17 @@ module HtmlNode = /// The name of the attribute to return. /// The given node let inline tryGetAttribute name n = - n |> attributes |> List.tryFind (HtmlAttribute.name >> ((=) (toLower name))) - + n + |> attributes + |> List.tryFind (HtmlAttribute.name >> ((=) (toLower name))) + /// /// Returns the attribute with the given name. If the /// attribute does not exist then this will throw an exception /// /// The name of the attribute to select /// The given node - let inline attribute name n = + let inline attribute name n = match tryGetAttribute name n with | Some v -> v | None -> failwithf "Unable to find attribute (%s)" name @@ -205,8 +222,12 @@ module HtmlNode = /// /// The name of the attribute to get the value from /// The given node - let inline attributeValue name n = - defaultArg (n |> tryGetAttribute name |> Option.map HtmlAttribute.value) "" + let inline attributeValue name n = + defaultArg + (n + |> tryGetAttribute name + |> Option.map HtmlAttribute.value) + "" /// /// Returns true if the current node has an attribute that @@ -215,75 +236,77 @@ module HtmlNode = /// The name of the attribute /// The value of the attribute /// The given html node - let inline hasAttribute name value n = + let inline hasAttribute name value n = match tryGetAttribute name n with | Some attr -> toLower (HtmlAttribute.value attr) = toLower value | None -> false /// Returns true if the current node has the specified name - let inline hasName (expectedName:string) n = + let inline hasName (expectedName: string) n = name n = expectedName.ToLowerInvariant() /// Returns true if the current node has the specified id - let inline hasId id n = - hasAttribute "id" id n + let inline hasId id n = hasAttribute "id" id n /// Returns true if the current node has the specified class - let inline hasClass (cssClass:string) n = - let presentClasses = (attributeValue "class" n).Split [|' '|] - let classesToLookFor = cssClass.Split [|' '|] - classesToLookFor |> Array.forall (fun cssClass -> presentClasses |> Array.exists ((=) cssClass)) + let inline hasClass (cssClass: string) n = + let presentClasses = (attributeValue "class" n).Split [| ' ' |] + let classesToLookFor = cssClass.Split [| ' ' |] + + classesToLookFor + |> Array.forall (fun cssClass -> presentClasses |> Array.exists ((=) cssClass)) let private innerTextExcluding' recurse exclusions n = let rec innerText' n = match n with - | HtmlElement(name, _, content) when List.forall ((<>) name) exclusions -> - seq { for e in content do + | HtmlElement (name, _, content) when List.forall ((<>) name) exclusions -> + seq { + for e in content do match e with - | HtmlText(text) -> yield text - | HtmlComment(_) -> yield "" - | elem -> - if recurse then - yield innerText' elem - else - yield "" } + | HtmlText (text) -> yield text + | HtmlComment (_) -> yield "" + | elem -> if recurse then yield innerText' elem else yield "" + } |> String.Concat - | HtmlText(text) -> text + | HtmlText (text) -> text | _ -> "" + innerText' n - let innerTextExcluding exclusions n = - innerTextExcluding' true exclusions n + let innerTextExcluding exclusions n = innerTextExcluding' true exclusions n /// /// Returns the inner text of the current node /// /// The given node - let inline innerText n = - innerTextExcluding [] n + let inline innerText n = innerTextExcluding [] n /// /// Returns the direct inner text of the current node /// /// The given node - let directInnerText n = - innerTextExcluding' false [] n + let directInnerText n = innerTextExcluding' false [] n open HtmlCssSelectors - let private getTargets level matched = + let private getTargets level matched = match level with - | FilterLevel.Children -> matched |> Seq.collect elements - | FilterLevel.Descendants -> matched |> Seq.collect (descendants true (fun _ -> true)) - | _ -> matched |> Seq.ofList + | FilterLevel.Children -> matched |> Seq.collect elements + | FilterLevel.Descendants -> + matched + |> Seq.collect (descendants true (fun _ -> true)) + | _ -> matched |> Seq.ofList let private searchTag level matched tag = match level with - | Children -> matched |> List.collect (elementsNamed [tag]) - | _ -> matched |> Seq.collect (descendantsAndSelfNamed true [tag]) |> Seq.toList + | Children -> matched |> List.collect (elementsNamed [ tag ]) + | _ -> + matched + |> Seq.collect (descendantsAndSelfNamed true [ tag ]) + |> Seq.toList - let private filterByAttr level matched attr f = - matched + let private filterByAttr level matched attr f = + matched |> getTargets level |> Seq.filter (attributeValue attr >> f) |> Seq.toList @@ -291,175 +314,209 @@ module HtmlNode = let private attrExists level matched attr = matched |> getTargets level - |> Seq.filter (attributes >> Seq.exists (HtmlAttribute.name >> (=) attr)) + |> Seq.filter ( + attributes + >> Seq.exists (HtmlAttribute.name >> (=) attr) + ) |> Seq.toList let private selectCssElements tokens nodes = - let whiteSpaces = [|' '; '\t'; '\r'; '\n'|] + let whiteSpaces = [| ' '; '\t'; '\r'; '\n' |] + let rec selectElements' level acc source = // if we already have an empty list, terminate early - if acc = [] then [] else + if acc = [] then + [] + else - let selectDescendantOfType ty t = - let selectedNodes = filterByAttr level acc "type" (fun v -> v = ty) - selectElements' FilterLevel.Root selectedNodes t + let selectDescendantOfType ty t = + let selectedNodes = filterByAttr level acc "type" (fun v -> v = ty) + selectElements' FilterLevel.Root selectedNodes t - let selectEvenOdd (isEven:bool) = - acc - |> List.mapi(fun i n -> (i,n)) - |> List.filter( - fun (i,_) -> + let selectEvenOdd (isEven: bool) = + acc + |> List.mapi (fun i n -> (i, n)) + |> List.filter (fun (i, _) -> match isEven with - | true -> i%2 = 0 - | false -> i%2 <> 0 - ) - |> List.map (fun (_,n) -> n) - - let containsIgnoreCase (value:string) (word:string) = word.IndexOf(value, StringComparison.OrdinalIgnoreCase) <> -1 - let equalsIgnoreCase (value:string) (word:string) = word.Equals(value, StringComparison.OrdinalIgnoreCase) - - match source with - | TagName(_, name) :: t -> - let selectedNodes = searchTag level acc name - selectElements' FilterLevel.Root selectedNodes t - | ClassPrefix _ :: CssClass(_, className) :: t -> - let selectedNodes = filterByAttr level acc "class" (fun v -> v.Split(whiteSpaces) |> Array.exists ((=) className)) - selectElements' FilterLevel.Root selectedNodes t - - | IdPrefix _ :: CssId(_, id) :: t -> - let selectedNodes = filterByAttr level acc "id" (fun v -> v = id) - selectElements' FilterLevel.Root selectedNodes t - - | OpenAttribute _ :: AttributeName(_, name) :: Assign _ :: AttributeValue(_, value) :: CloseAttribute _ :: t -> - let selectedNodes = filterByAttr level acc name (fun v -> v = value) - selectElements' FilterLevel.Root selectedNodes t - - | OpenAttribute _ :: AttributeName(_, name) :: EndWith _ :: AttributeValue(_, value) :: CloseAttribute _ :: t -> - let selectedNodes = filterByAttr level acc name (fun v -> v.EndsWith value) - selectElements' FilterLevel.Root selectedNodes t - - | OpenAttribute _ :: AttributeName(_, name) :: StartWith _ :: AttributeValue(_, value) :: CloseAttribute _ :: t -> - let selectedNodes = filterByAttr level acc name (fun v -> v.StartsWith value) - selectElements' FilterLevel.Root selectedNodes t - - | OpenAttribute _ :: AttributeName(_, name) :: AttributeContainsPrefix _ :: AttributeValue(_, value) :: CloseAttribute _ :: t -> - let selectedNodes = filterByAttr level acc name (fun v -> - let chars = v.ToCharArray() |> Seq.skipWhile(fun c -> c = '\'') |> Seq.takeWhile Char.IsLetter |> Seq.toArray - let s = new String(chars) - s = value ) - selectElements' FilterLevel.Root selectedNodes t - - | OpenAttribute _ :: AttributeName(_, name) :: AttributeContains _ :: AttributeValue(_, value) :: CloseAttribute _ :: t -> - let selectedNodes = filterByAttr level acc name (containsIgnoreCase value) - selectElements' FilterLevel.Root selectedNodes t - - | OpenAttribute _ :: AttributeName(_, name) :: AttributeContainsWord _ :: AttributeValue(_, value) :: CloseAttribute _ :: t -> - let selectedNodes = filterByAttr level acc name (fun v -> v.Split(whiteSpaces) |> Array.exists (equalsIgnoreCase value)) - selectElements' FilterLevel.Root selectedNodes t - - | OpenAttribute _ :: AttributeName(_, name) :: AttributeNotEqual _ :: AttributeValue(_, value) :: CloseAttribute _ :: t -> - let selectedNodes = filterByAttr level acc name ((<>) value) - selectElements' FilterLevel.Root selectedNodes t - - | OpenAttribute _ :: AttributeName(_, name) :: CloseAttribute _ :: t -> - let selectedNodes = - acc |> List.filter( + | true -> i % 2 = 0 + | false -> i % 2 <> 0) + |> List.map (fun (_, n) -> n) + + let containsIgnoreCase (value: string) (word: string) = + word.IndexOf(value, StringComparison.OrdinalIgnoreCase) + <> -1 + + let equalsIgnoreCase (value: string) (word: string) = + word.Equals(value, StringComparison.OrdinalIgnoreCase) + + match source with + | TagName (_, name) :: t -> + let selectedNodes = searchTag level acc name + selectElements' FilterLevel.Root selectedNodes t + | ClassPrefix _ :: CssClass (_, className) :: t -> + let selectedNodes = + filterByAttr level acc "class" (fun v -> + v.Split(whiteSpaces) + |> Array.exists ((=) className)) + + selectElements' FilterLevel.Root selectedNodes t + + | IdPrefix _ :: CssId (_, id) :: t -> + let selectedNodes = filterByAttr level acc "id" (fun v -> v = id) + selectElements' FilterLevel.Root selectedNodes t + + | OpenAttribute _ :: AttributeName (_, name) :: Assign _ :: AttributeValue (_, value) :: CloseAttribute _ :: t -> + let selectedNodes = filterByAttr level acc name (fun v -> v = value) + selectElements' FilterLevel.Root selectedNodes t + + | OpenAttribute _ :: AttributeName (_, name) :: EndWith _ :: AttributeValue (_, value) :: CloseAttribute _ :: t -> + let selectedNodes = filterByAttr level acc name (fun v -> v.EndsWith value) + selectElements' FilterLevel.Root selectedNodes t + + | OpenAttribute _ :: AttributeName (_, name) :: StartWith _ :: AttributeValue (_, value) :: CloseAttribute _ :: t -> + let selectedNodes = filterByAttr level acc name (fun v -> v.StartsWith value) + selectElements' FilterLevel.Root selectedNodes t + + | OpenAttribute _ :: AttributeName (_, name) :: AttributeContainsPrefix _ :: AttributeValue (_, value) :: CloseAttribute _ :: t -> + let selectedNodes = + filterByAttr level acc name (fun v -> + let chars = + v.ToCharArray() + |> Seq.skipWhile (fun c -> c = '\'') + |> Seq.takeWhile Char.IsLetter + |> Seq.toArray + + let s = new String(chars) + s = value) + + selectElements' FilterLevel.Root selectedNodes t + + | OpenAttribute _ :: AttributeName (_, name) :: AttributeContains _ :: AttributeValue (_, value) :: CloseAttribute _ :: t -> + let selectedNodes = filterByAttr level acc name (containsIgnoreCase value) + selectElements' FilterLevel.Root selectedNodes t + + | OpenAttribute _ :: AttributeName (_, name) :: AttributeContainsWord _ :: AttributeValue (_, value) :: CloseAttribute _ :: t -> + let selectedNodes = + filterByAttr level acc name (fun v -> + v.Split(whiteSpaces) + |> Array.exists (equalsIgnoreCase value)) + + selectElements' FilterLevel.Root selectedNodes t + + | OpenAttribute _ :: AttributeName (_, name) :: AttributeNotEqual _ :: AttributeValue (_, value) :: CloseAttribute _ :: t -> + let selectedNodes = filterByAttr level acc name ((<>) value) + selectElements' FilterLevel.Root selectedNodes t + + | OpenAttribute _ :: AttributeName (_, name) :: CloseAttribute _ :: t -> + let selectedNodes = + acc + |> List.filter ( attributes - >> List.exists (HtmlAttribute.name >> (=) name) ) - selectElements' FilterLevel.Root selectedNodes t - - | Checkbox _ :: t -> selectDescendantOfType "checkbox" t - | File _ :: t -> selectDescendantOfType "file" t - | Hidden _ :: t -> selectDescendantOfType "hidden" t - | Radio _ :: t -> selectDescendantOfType "radio" t - | Password _ :: t -> selectDescendantOfType "password" t - | Image _ :: t -> selectDescendantOfType "image" t - | Textbox _ :: t -> selectDescendantOfType "text" t - | Submit _ :: t -> selectDescendantOfType "submit" t - - | Even _ :: t -> - let selectedNodes = selectEvenOdd true - selectElements' FilterLevel.Root selectedNodes t - - | Odd _ :: t -> - let selectedNodes = selectEvenOdd false - selectElements' FilterLevel.Root selectedNodes t - - | Button _ :: t -> - let selectedNodes = - filterByAttr level acc "type" ((=) "button") - |> Seq.append (acc |> Seq.collect (descendantsAndSelfNamed true ["button"])) - |> Seq.toList - selectElements' FilterLevel.Root selectedNodes t - - | Checked _ :: t -> - let selectedNodes = attrExists level acc "checked" - selectElements' FilterLevel.Root selectedNodes t - - | EmptyNode _ :: t -> - let selectedNodes = - acc - |> Seq.collect( - descendantsAndSelf true (fun _ -> true) - >> Seq.filter(fun d -> - String.IsNullOrWhiteSpace (d |> directInnerText) && (d |> descendants true (fun _ -> true)) |> Seq.isEmpty)) - |> Seq.toList - selectElements' FilterLevel.Root selectedNodes t - - | Selected _ :: t -> - let selectedNodes = attrExists level acc "selected" - selectElements' FilterLevel.Root selectedNodes t - - | Disabled _ :: t -> - let selectedNodes = attrExists level acc "disabled" - selectElements' FilterLevel.Root selectedNodes t - - | Enabled _ :: t -> - let selectedNodes = - acc - |> getTargets level - |> Seq.filter (attributes >> Seq.exists (HtmlAttribute.name >> (=) "disabled") >> not) - |> Seq.toList - selectElements' FilterLevel.Root selectedNodes t + >> List.exists (HtmlAttribute.name >> (=) name) + ) + + selectElements' FilterLevel.Root selectedNodes t + + | Checkbox _ :: t -> selectDescendantOfType "checkbox" t + | File _ :: t -> selectDescendantOfType "file" t + | Hidden _ :: t -> selectDescendantOfType "hidden" t + | Radio _ :: t -> selectDescendantOfType "radio" t + | Password _ :: t -> selectDescendantOfType "password" t + | Image _ :: t -> selectDescendantOfType "image" t + | Textbox _ :: t -> selectDescendantOfType "text" t + | Submit _ :: t -> selectDescendantOfType "submit" t + + | Even _ :: t -> + let selectedNodes = selectEvenOdd true + selectElements' FilterLevel.Root selectedNodes t + + | Odd _ :: t -> + let selectedNodes = selectEvenOdd false + selectElements' FilterLevel.Root selectedNodes t + + | Button _ :: t -> + let selectedNodes = + filterByAttr level acc "type" ((=) "button") + |> Seq.append ( + acc + |> Seq.collect (descendantsAndSelfNamed true [ "button" ]) + ) + |> Seq.toList + + selectElements' FilterLevel.Root selectedNodes t + + | Checked _ :: t -> + let selectedNodes = attrExists level acc "checked" + selectElements' FilterLevel.Root selectedNodes t + + | EmptyNode _ :: t -> + let selectedNodes = + acc + |> Seq.collect ( + descendantsAndSelf true (fun _ -> true) + >> Seq.filter (fun d -> + String.IsNullOrWhiteSpace(d |> directInnerText) + && (d |> descendants true (fun _ -> true)) + |> Seq.isEmpty) + ) + |> Seq.toList + + selectElements' FilterLevel.Root selectedNodes t + + | Selected _ :: t -> + let selectedNodes = attrExists level acc "selected" + selectElements' FilterLevel.Root selectedNodes t + + | Disabled _ :: t -> + let selectedNodes = attrExists level acc "disabled" + selectElements' FilterLevel.Root selectedNodes t + + | Enabled _ :: t -> + let selectedNodes = + acc + |> getTargets level + |> Seq.filter ( + attributes + >> Seq.exists (HtmlAttribute.name >> (=) "disabled") + >> not + ) + |> Seq.toList + + selectElements' FilterLevel.Root selectedNodes t - | AllChildren _ :: t -> - selectElements' FilterLevel.Descendants acc t + | AllChildren _ :: t -> selectElements' FilterLevel.Descendants acc t - | DirectChildren _ :: t -> - selectElements' FilterLevel.Children acc t + | DirectChildren _ :: t -> selectElements' FilterLevel.Children acc t - | [] -> acc - | tok -> failwithf "Invalid token: %A" tok + | [] -> acc + | tok -> failwithf "Invalid token: %A" tok selectElements' FilterLevel.Descendants nodes tokens let internal Select nodes selector = - let tokenizer = CssSelectorTokenizer() - match tokenizer.Tokenize selector with - | [] -> [] - | tokens -> - List.ofSeq nodes |> selectCssElements tokens + let tokenizer = CssSelectorTokenizer() + + match tokenizer.Tokenize selector with + | [] -> [] + | tokens -> List.ofSeq nodes |> selectCssElements tokens /// Gets descendants matched by Css selector - let cssSelect node selector = - Select [node] selector + let cssSelect node selector = Select [ node ] selector // -------------------------------------------------------------------------------------- [] /// Extension methods with operations on HTML nodes type HtmlNodeExtensions = - + /// Gets the given nodes name [] - static member Name(n:HtmlNode) = - HtmlNode.name n - + static member Name(n: HtmlNode) = HtmlNode.name n + /// Gets all of the nodes immediately under this node [] - static member Elements(n:HtmlNode) = - HtmlNode.elements n + static member Elements(n: HtmlNode) = HtmlNode.elements n /// /// Gets all of the elements of the current node, which match the given set of names @@ -467,8 +524,7 @@ type HtmlNodeExtensions = /// The given node /// The set of names by which to map the elements [] - static member Elements(n:HtmlNode, names:seq) = - HtmlNode.elementsNamed names n + static member Elements(n: HtmlNode, names: seq) = HtmlNode.elementsNamed names n /// /// Gets all of the elements of the current node, which match the given name @@ -476,9 +532,8 @@ type HtmlNodeExtensions = /// The given node /// The name by which to map the elements [] - static member Elements(n:HtmlNode, name:string) = - HtmlNode.elementsNamed [name] n - + static member Elements(n: HtmlNode, name: string) = HtmlNode.elementsNamed [ name ] n + /// /// Gets all of the descendants of the current node that satisfy the predicate /// @@ -486,7 +541,7 @@ type HtmlNodeExtensions = /// The predicate for which descendants to return /// If a match is found continues down the tree matching child elements [] - static member Descendants(n:HtmlNode, predicate, recurseOnMatch) = + static member Descendants(n: HtmlNode, predicate, recurseOnMatch) = HtmlNode.descendants recurseOnMatch predicate n /// @@ -497,7 +552,7 @@ type HtmlNodeExtensions = /// The predicate for which descendants to return /// If a match is found continues down the tree matching child elements [] - static member DescendantsAndSelf(n:HtmlNode, predicate, recurseOnMatch) = + static member DescendantsAndSelf(n: HtmlNode, predicate, recurseOnMatch) = HtmlNode.descendantsAndSelf recurseOnMatch predicate n /// @@ -507,7 +562,7 @@ type HtmlNodeExtensions = /// The given node /// The predicate for which descendants to return [] - static member Descendants(n:HtmlNode, predicate) = + static member Descendants(n: HtmlNode, predicate) = let recurseOnMatch = true HtmlNode.descendants recurseOnMatch predicate n @@ -519,14 +574,14 @@ type HtmlNodeExtensions = /// The given node /// The predicate for which descendants to return [] - static member DescendantsAndSelf(n:HtmlNode, predicate) = + static member DescendantsAndSelf(n: HtmlNode, predicate) = let recurseOnMatch = true HtmlNode.descendantsAndSelf recurseOnMatch predicate n - + /// Gets all of the descendants of the current node /// Recurses on match [] - static member Descendants(n:HtmlNode) = + static member Descendants(n: HtmlNode) = let recurseOnMatch = true let predicate = fun _ -> true HtmlNode.descendants recurseOnMatch predicate n @@ -535,7 +590,7 @@ type HtmlNodeExtensions = /// The current node is also considered in the comparison /// Recurses on match [] - static member DescendantsAndSelf(n:HtmlNode) = + static member DescendantsAndSelf(n: HtmlNode) = let recurseOnMatch = true let predicate = fun _ -> true HtmlNode.descendantsAndSelf recurseOnMatch predicate n @@ -547,7 +602,7 @@ type HtmlNodeExtensions = /// The set of names by which to map the descendants /// If a match is found continues down the tree matching child elements [] - static member Descendants(n:HtmlNode, names:seq, recurseOnMatch) = + static member Descendants(n: HtmlNode, names: seq, recurseOnMatch) = HtmlNode.descendantsNamed recurseOnMatch names n /// @@ -558,7 +613,7 @@ type HtmlNodeExtensions = /// The set of names by which to map the descendants /// If a match is found continues down the tree matching child elements [] - static member DescendantsAndSelf(n:HtmlNode, names:seq, recurseOnMatch) = + static member DescendantsAndSelf(n: HtmlNode, names: seq, recurseOnMatch) = HtmlNode.descendantsAndSelfNamed recurseOnMatch names n /// @@ -568,7 +623,7 @@ type HtmlNodeExtensions = /// The given node /// The set of names by which to map the descendants [] - static member Descendants(n:HtmlNode, names:seq) = + static member Descendants(n: HtmlNode, names: seq) = let recurseOnMatch = true HtmlNode.descendantsNamed recurseOnMatch names n @@ -580,7 +635,7 @@ type HtmlNodeExtensions = /// The given node /// The set of names by which to map the descendants [] - static member DescendantsAndSelf(n:HtmlNode, names:seq) = + static member DescendantsAndSelf(n: HtmlNode, names: seq) = let recurseOnMatch = true HtmlNode.descendantsAndSelfNamed recurseOnMatch names n @@ -591,8 +646,8 @@ type HtmlNodeExtensions = /// The name by which to map the descendants /// If a match is found continues down the tree matching child elements [] - static member Descendants(n:HtmlNode, name:string, recurseOnMatch) = - HtmlNode.descendantsNamed recurseOnMatch [name] n + static member Descendants(n: HtmlNode, name: string, recurseOnMatch) = + HtmlNode.descendantsNamed recurseOnMatch [ name ] n /// /// Gets all of the descendants of the current node, which match the given name @@ -602,8 +657,8 @@ type HtmlNodeExtensions = /// The name by which to map the descendants /// If a match is found continues down the tree matching child elements [] - static member DescendantsAndSelf(n:HtmlNode, name:string, recurseOnMatch) = - HtmlNode.descendantsAndSelfNamed recurseOnMatch [name] n + static member DescendantsAndSelf(n: HtmlNode, name: string, recurseOnMatch) = + HtmlNode.descendantsAndSelfNamed recurseOnMatch [ name ] n /// /// Gets all of the descendants of the current node, which match the given name @@ -612,9 +667,9 @@ type HtmlNodeExtensions = /// The given node /// The name by which to map the descendants [] - static member Descendants(n:HtmlNode, name:string) = + static member Descendants(n: HtmlNode, name: string) = let recurseOnMatch = true - HtmlNode.descendantsNamed recurseOnMatch [name] n + HtmlNode.descendantsNamed recurseOnMatch [ name ] n /// /// Gets all of the descendants of the current node, which match the given name @@ -624,9 +679,9 @@ type HtmlNodeExtensions = /// The given node /// The name by which to map the descendants [] - static member DescendantsAndSelf(n:HtmlNode, name:string) = + static member DescendantsAndSelf(n: HtmlNode, name: string) = let recurseOnMatch = true - HtmlNode.descendantsAndSelfNamed recurseOnMatch [name] n + HtmlNode.descendantsAndSelfNamed recurseOnMatch [ name ] n /// /// Gets all of the descendants of the current node that satisfy the predicate @@ -635,7 +690,7 @@ type HtmlNodeExtensions = /// The predicate for which descendants to return /// If a match is found continues down the tree matching child elements [] - static member DescendantsWithPath(n:HtmlNode, predicate, recurseOnMatch) = + static member DescendantsWithPath(n: HtmlNode, predicate, recurseOnMatch) = HtmlNode.descendantsWithPath recurseOnMatch predicate n /// @@ -646,7 +701,7 @@ type HtmlNodeExtensions = /// The predicate for which descendants to return /// If a match is found continues down the tree matching child elements [] - static member DescendantsAndSelfWithPath(n:HtmlNode, predicate, recurseOnMatch) = + static member DescendantsAndSelfWithPath(n: HtmlNode, predicate, recurseOnMatch) = HtmlNode.descendantsAndSelfWithPath recurseOnMatch predicate n /// @@ -656,7 +711,7 @@ type HtmlNodeExtensions = /// The given node /// The predicate for which descendants to return [] - static member DescendantsWithPath(n:HtmlNode, predicate) = + static member DescendantsWithPath(n: HtmlNode, predicate) = let recurseOnMatch = true HtmlNode.descendantsWithPath recurseOnMatch predicate n @@ -668,14 +723,14 @@ type HtmlNodeExtensions = /// The given node /// The predicate for which descendants to return [] - static member DescendantsAndSelfWithPath(n:HtmlNode, predicate) = + static member DescendantsAndSelfWithPath(n: HtmlNode, predicate) = let recurseOnMatch = true HtmlNode.descendantsAndSelfWithPath recurseOnMatch predicate n /// Gets all of the descendants of the current node /// Recurses on match [] - static member DescendantsWithPath(n:HtmlNode) = + static member DescendantsWithPath(n: HtmlNode) = let recurseOnMatch = true let predicate = fun _ -> true HtmlNode.descendantsWithPath recurseOnMatch predicate n @@ -684,7 +739,7 @@ type HtmlNodeExtensions = /// The current node is also considered in the comparison /// Recurses on match [] - static member DescendantsAndSelfWithPath(n:HtmlNode) = + static member DescendantsAndSelfWithPath(n: HtmlNode) = let recurseOnMatch = true let predicate = fun _ -> true HtmlNode.descendantsAndSelfWithPath recurseOnMatch predicate n @@ -696,7 +751,7 @@ type HtmlNodeExtensions = /// The set of names by which to map the descendants /// If a match is found continues down the tree matching child elements [] - static member DescendantsWithPath(n:HtmlNode, names:seq, recurseOnMatch) = + static member DescendantsWithPath(n: HtmlNode, names: seq, recurseOnMatch) = HtmlNode.descendantsNamedWithPath recurseOnMatch names n /// @@ -707,7 +762,7 @@ type HtmlNodeExtensions = /// The set of names by which to map the descendants /// If a match is found continues down the tree matching child elements [] - static member DescendantsAndSelfWithPath(n:HtmlNode, names:seq, recurseOnMatch) = + static member DescendantsAndSelfWithPath(n: HtmlNode, names: seq, recurseOnMatch) = HtmlNode.descendantsAndSelfNamedWithPath recurseOnMatch names n /// @@ -717,7 +772,7 @@ type HtmlNodeExtensions = /// The given node /// The set of names by which to map the descendants [] - static member DescendantsWithPath(n:HtmlNode, names:seq) = + static member DescendantsWithPath(n: HtmlNode, names: seq) = let recurseOnMatch = true HtmlNode.descendantsNamedWithPath recurseOnMatch names n @@ -729,7 +784,7 @@ type HtmlNodeExtensions = /// The given node /// The set of names by which to map the descendants [] - static member DescendantsAndSelfWithPath(n:HtmlNode, names:seq) = + static member DescendantsAndSelfWithPath(n: HtmlNode, names: seq) = let recurseOnMatch = true HtmlNode.descendantsAndSelfNamedWithPath recurseOnMatch names n @@ -740,8 +795,8 @@ type HtmlNodeExtensions = /// The name by which to map the descendants /// If a match is found continues down the tree matching child elements [] - static member DescendantsWithPath(n:HtmlNode, name:string, recurseOnMatch) = - HtmlNode.descendantsNamedWithPath recurseOnMatch [name] n + static member DescendantsWithPath(n: HtmlNode, name: string, recurseOnMatch) = + HtmlNode.descendantsNamedWithPath recurseOnMatch [ name ] n /// /// Gets all of the descendants of the current node, which match the given name @@ -751,8 +806,8 @@ type HtmlNodeExtensions = /// The name by which to map the descendants /// If a match is found continues down the tree matching child elements [] - static member DescendantsAndSelfWithPath(n:HtmlNode, name:string, recurseOnMatch) = - HtmlNode.descendantsAndSelfNamedWithPath recurseOnMatch [name] n + static member DescendantsAndSelfWithPath(n: HtmlNode, name: string, recurseOnMatch) = + HtmlNode.descendantsAndSelfNamedWithPath recurseOnMatch [ name ] n /// /// Gets all of the descendants of the current node, which match the given name @@ -761,9 +816,9 @@ type HtmlNodeExtensions = /// The given node /// The names by which to map the descendants [] - static member DescendantsWithPath(n:HtmlNode, name:string) = + static member DescendantsWithPath(n: HtmlNode, name: string) = let recurseOnMatch = true - HtmlNode.descendantsNamedWithPath recurseOnMatch [name] n + HtmlNode.descendantsNamedWithPath recurseOnMatch [ name ] n /// /// Gets all of the descendants of the current node, which match the given name @@ -773,14 +828,13 @@ type HtmlNodeExtensions = /// The given node /// The names by which to map the descendants [] - static member DescendantsAndSelfWithPath(n:HtmlNode, name:string) = + static member DescendantsAndSelfWithPath(n: HtmlNode, name: string) = let recurseOnMatch = true - HtmlNode.descendantsAndSelfNamedWithPath recurseOnMatch [name] n + HtmlNode.descendantsAndSelfNamedWithPath recurseOnMatch [ name ] n /// Gets all of the attributes of this node [] - static member Attributes(n:HtmlNode) = - HtmlNode.attributes n + static member Attributes(n: HtmlNode) = HtmlNode.attributes n /// /// Tries to select an attribute with the given name from the current node. @@ -788,8 +842,7 @@ type HtmlNodeExtensions = /// The given node /// The name of the attribute to select [] - static member TryGetAttribute(n:HtmlNode, name:string) = - HtmlNode.tryGetAttribute name n + static member TryGetAttribute(n: HtmlNode, name: string) = HtmlNode.tryGetAttribute name n /// /// Returns the attribute with the given name. If the @@ -798,8 +851,7 @@ type HtmlNodeExtensions = /// The given node /// The name of the attribute to select [] - static member Attribute(n:HtmlNode, name) = - HtmlNode.attribute name n + static member Attribute(n: HtmlNode, name) = HtmlNode.attribute name n /// /// Return the value of the named attribute, or an empty string if not found. @@ -807,8 +859,7 @@ type HtmlNodeExtensions = /// The given node /// The name of the attribute to get the value from [] - static member AttributeValue(n:HtmlNode, name) = - HtmlNode.attributeValue name n + static member AttributeValue(n: HtmlNode, name) = HtmlNode.attributeValue name n /// /// Returns true if the current node has an attribute that @@ -818,58 +869,55 @@ type HtmlNodeExtensions = /// The name of the attribute /// The value of the attribute [] - static member HasAttribute(n:HtmlNode, name, value) = - HtmlNode.hasAttribute name value n + static member HasAttribute(n: HtmlNode, name, value) = HtmlNode.hasAttribute name value n /// Returns true if the current node has the specified name [] - static member HasName(n:HtmlNode, name) = - HtmlNode.hasName name n + static member HasName(n: HtmlNode, name) = HtmlNode.hasName name n /// Returns true if the current node has the specified id [] - static member HasId(n:HtmlNode, id) = - HtmlNode.hasId id n + static member HasId(n: HtmlNode, id) = HtmlNode.hasId id n /// Returns true if the current node has the specified class [] - static member HasClass(n:HtmlNode, cssClass) = - HtmlNode.hasClass cssClass n + static member HasClass(n: HtmlNode, cssClass) = HtmlNode.hasClass cssClass n /// Returns the inner text of the current node [] - static member InnerText(n:HtmlNode) = - HtmlNode.innerText n + static member InnerText(n: HtmlNode) = HtmlNode.innerText n /// Returns the direct inner text of the current node [] - static member DirectInnerText(n:HtmlNode) = - HtmlNode.directInnerText n + static member DirectInnerText(n: HtmlNode) = HtmlNode.directInnerText n // -------------------------------------------------------------------------------------- [] /// Module with operations on HTML documents -module HtmlDocument = - +module HtmlDocument = + /// Returns the doctype of the document let docType doc = match doc with - | HtmlDocument(docType = docType) -> docType - + | HtmlDocument (docType = docType) -> docType + //// Gets all of the root elements of the document let elements doc = match doc with - | HtmlDocument(elements = elements) -> elements - + | HtmlDocument (elements = elements) -> elements + /// /// Returns all of the root elements of the document that match the set of names /// /// The set of names to match /// The given document - let inline elementsNamed names doc = + let inline elementsNamed names doc = let nameSet = getNameSet names - doc |> elements |> List.filter (HtmlNode.name >> nameSet.Contains) + + doc + |> elements + |> List.filter (HtmlNode.name >> nameSet.Contains) /// /// Gets all of the descendants of this document that statisfy the given predicate @@ -878,7 +926,9 @@ module HtmlDocument = /// The predicate by which to match the nodes to return /// The given document let inline descendants recurseOnMatch predicate doc = - doc |> elements |> Seq.collect (HtmlNode.descendantsAndSelf recurseOnMatch predicate) + doc + |> elements + |> Seq.collect (HtmlNode.descendantsAndSelf recurseOnMatch predicate) /// /// Finds all of the descendant nodes of this document that match the given set of names @@ -886,9 +936,11 @@ module HtmlDocument = /// If a match is found continues down the tree matching child elements /// The set of names to match /// The given document - let inline descendantsNamed recurseOnMatch names doc = + let inline descendantsNamed recurseOnMatch names doc = let nameSet = getNameSet names - doc |> descendants recurseOnMatch (HtmlNode.name >> nameSet.Contains) + + doc + |> descendants recurseOnMatch (HtmlNode.name >> nameSet.Contains) /// /// Gets all of the descendants of this document that statisfy the given predicate @@ -897,7 +949,9 @@ module HtmlDocument = /// The predicate by which to match the nodes to return /// The given document let inline descendantsWithPath recurseOnMatch predicate doc = - doc |> elements |> Seq.collect (HtmlNode.descendantsAndSelfWithPath recurseOnMatch predicate) + doc + |> elements + |> Seq.collect (HtmlNode.descendantsAndSelfWithPath recurseOnMatch predicate) /// /// Finds all of the descendant nodes of this document that match the given set of names @@ -905,47 +959,49 @@ module HtmlDocument = /// If a match is found continues down the tree matching child elements /// The set of names to match /// The given document - let inline descendantsNamedWithPath recurseOnMatch names doc = + let inline descendantsNamedWithPath recurseOnMatch names doc = let nameSet = getNameSet names - doc |> descendantsWithPath recurseOnMatch (HtmlNode.name >> nameSet.Contains) + + doc + |> descendantsWithPath recurseOnMatch (HtmlNode.name >> nameSet.Contains) /// /// Finds the body element of the given document, /// this throws an exception if no body element exists. /// /// The given document - let inline body (x:HtmlDocument) = - match List.ofSeq <| descendantsNamed false ["body"] x with + let inline body (x: HtmlDocument) = + match List.ofSeq <| descendantsNamed false [ "body" ] x with | [] -> failwith "No element body found!" - | body:: _ -> body + | body :: _ -> body /// /// Tries to find the body element of the given document. /// /// The given document - let inline tryGetBody (x:HtmlDocument) = - match List.ofSeq <| descendantsNamed false ["body"] x with + let inline tryGetBody (x: HtmlDocument) = + match List.ofSeq <| descendantsNamed false [ "body" ] x with | [] -> None - | body:: _ -> Some body + | body :: _ -> Some body /// /// Finds the html element of the given document, /// this throws an exception if no html element exists. /// /// The given document - let inline html (x:HtmlDocument) = - match List.ofSeq <| descendantsNamed false ["html"] x with + let inline html (x: HtmlDocument) = + match List.ofSeq <| descendantsNamed false [ "html" ] x with | [] -> failwith "No element html found!" - | html:: _ -> html + | html :: _ -> html /// /// Tries to find the html element of the given document. /// /// The given document - let inline tryGetHtml (x:HtmlDocument) = - match List.ofSeq <| descendantsNamed false ["html"] x with + let inline tryGetHtml (x: HtmlDocument) = + match List.ofSeq <| descendantsNamed false [ "html" ] x with | [] -> None - | html:: _ -> Some html + | html :: _ -> Some html [] @@ -957,8 +1013,7 @@ type HtmlDocumentExtensions = /// /// The given document [] - static member Elements(doc:HtmlDocument) = - HtmlDocument.elements doc + static member Elements(doc: HtmlDocument) = HtmlDocument.elements doc /// /// Returns all of the root elements in the current document that match the set of names @@ -966,8 +1021,7 @@ type HtmlDocumentExtensions = /// The given document /// The set of names to match [] - static member Elements(doc:HtmlDocument, names:seq) = - HtmlDocument.elementsNamed names doc + static member Elements(doc: HtmlDocument, names: seq) = HtmlDocument.elementsNamed names doc /// /// Returns all of the root elements in the current document that match the name @@ -975,8 +1029,7 @@ type HtmlDocumentExtensions = /// The given document /// The name to match [] - static member Elements(doc:HtmlDocument, name:string) = - HtmlDocument.elementsNamed [name] doc + static member Elements(doc: HtmlDocument, name: string) = HtmlDocument.elementsNamed [ name ] doc /// /// Gets all of the descendants of this document that statisfy the given predicate @@ -985,7 +1038,7 @@ type HtmlDocumentExtensions = /// The predicate by which to match the nodes to return /// If a match is found continues down the tree matching child elements [] - static member Descendants(doc:HtmlDocument, predicate, recurseOnMatch) = + static member Descendants(doc: HtmlDocument, predicate, recurseOnMatch) = HtmlDocument.descendants recurseOnMatch predicate doc /// @@ -995,18 +1048,18 @@ type HtmlDocumentExtensions = /// The given document /// The predicate by which to match the nodes to return [] - static member Descendants(doc:HtmlDocument, predicate) = + static member Descendants(doc: HtmlDocument, predicate) = let recurseOnMatch = true HtmlDocument.descendants recurseOnMatch predicate doc - + /// Gets all of the descendants of this document /// Recurses on match [] - static member Descendants(doc:HtmlDocument) = + static member Descendants(doc: HtmlDocument) = let recurseOnMatch = true let predicate = fun _ -> true HtmlDocument.descendants recurseOnMatch predicate doc - + /// /// Finds all of the descendant nodes of this document that match the given set of names /// @@ -1014,7 +1067,7 @@ type HtmlDocumentExtensions = /// The set of names to match /// If a match is found continues down the tree matching child elements [] - static member Descendants(doc:HtmlDocument, names:seq, recurseOnMatch) = + static member Descendants(doc: HtmlDocument, names: seq, recurseOnMatch) = HtmlDocument.descendantsNamed recurseOnMatch names doc /// @@ -1024,7 +1077,7 @@ type HtmlDocumentExtensions = /// The given document /// The set of names to match [] - static member Descendants(doc:HtmlDocument, names:seq) = + static member Descendants(doc: HtmlDocument, names: seq) = let recurseOnMatch = true HtmlDocument.descendantsNamed recurseOnMatch names doc @@ -1035,8 +1088,8 @@ type HtmlDocumentExtensions = /// The name to match /// If a match is found continues down the tree matching child elements [] - static member Descendants(doc:HtmlDocument, name:string, recurseOnMatch) = - HtmlDocument.descendantsNamed recurseOnMatch [name] doc + static member Descendants(doc: HtmlDocument, name: string, recurseOnMatch) = + HtmlDocument.descendantsNamed recurseOnMatch [ name ] doc /// /// Finds all of the descendant nodes of this document that match the given name @@ -1045,9 +1098,9 @@ type HtmlDocumentExtensions = /// The given document /// The name to match [] - static member Descendants(doc:HtmlDocument, name:string) = + static member Descendants(doc: HtmlDocument, name: string) = let recurseOnMatch = true - HtmlDocument.descendantsNamed recurseOnMatch [name] doc + HtmlDocument.descendantsNamed recurseOnMatch [ name ] doc /// /// Gets all of the descendants of this document that statisfy the given predicate @@ -1056,7 +1109,7 @@ type HtmlDocumentExtensions = /// The predicate by which to match the nodes to return /// If a match is found continues down the tree matching child elements [] - static member DescendantsWithPath(doc:HtmlDocument, predicate, recurseOnMatch) = + static member DescendantsWithPath(doc: HtmlDocument, predicate, recurseOnMatch) = HtmlDocument.descendantsWithPath recurseOnMatch predicate doc /// @@ -1066,14 +1119,14 @@ type HtmlDocumentExtensions = /// The given document /// The predicate by which to match the nodes to return [] - static member DescendantsWithPath(doc:HtmlDocument, predicate) = + static member DescendantsWithPath(doc: HtmlDocument, predicate) = let recurseOnMatch = true HtmlDocument.descendantsWithPath recurseOnMatch predicate doc /// Gets all of the descendants of this document /// Recurses on match [] - static member DescendantsWithPath(doc:HtmlDocument) = + static member DescendantsWithPath(doc: HtmlDocument) = let recurseOnMatch = true let predicate = fun _ -> true HtmlDocument.descendantsWithPath recurseOnMatch predicate doc @@ -1085,7 +1138,7 @@ type HtmlDocumentExtensions = /// The set of names to match /// If a match is found continues down the tree matching child elements [] - static member DescendantsWithPath(doc:HtmlDocument, names:seq, recurseOnMatch) = + static member DescendantsWithPath(doc: HtmlDocument, names: seq, recurseOnMatch) = HtmlDocument.descendantsNamedWithPath recurseOnMatch names doc /// @@ -1095,10 +1148,10 @@ type HtmlDocumentExtensions = /// The given document /// The set of names to match [] - static member DescendantsWithPath(doc:HtmlDocument, names:seq) = + static member DescendantsWithPath(doc: HtmlDocument, names: seq) = let recurseOnMatch = true HtmlDocument.descendantsNamedWithPath recurseOnMatch names doc - + /// /// Finds all of the descendant nodes of this document that match the given name /// @@ -1106,8 +1159,8 @@ type HtmlDocumentExtensions = /// The name to match /// If a match is found continues down the tree matching child elements [] - static member DescendantsWithPath(doc:HtmlDocument, name:string, recurseOnMatch) = - HtmlDocument.descendantsNamedWithPath recurseOnMatch [name] doc + static member DescendantsWithPath(doc: HtmlDocument, name: string, recurseOnMatch) = + HtmlDocument.descendantsNamedWithPath recurseOnMatch [ name ] doc /// /// Finds all of the descendant nodes of this document that match the given name @@ -1116,31 +1169,27 @@ type HtmlDocumentExtensions = /// The given document /// The name to match [] - static member DescendantsWithPath(doc:HtmlDocument, name:string) = + static member DescendantsWithPath(doc: HtmlDocument, name: string) = let recurseOnMatch = true - HtmlDocument.descendantsNamedWithPath recurseOnMatch [name] doc - + HtmlDocument.descendantsNamedWithPath recurseOnMatch [ name ] doc + /// Finds the body element of the given document, /// this throws an exception if no body element exists. [] - static member Body(doc:HtmlDocument) = - HtmlDocument.body doc + static member Body(doc: HtmlDocument) = HtmlDocument.body doc /// Tries to find the body element of the given document. [] - static member TryGetBody(doc:HtmlDocument) = - HtmlDocument.tryGetBody doc + static member TryGetBody(doc: HtmlDocument) = HtmlDocument.tryGetBody doc /// Finds the html element of the given document, /// this throws an exception if no html element exists. [] - static member Html(doc:HtmlDocument) = - HtmlDocument.html doc + static member Html(doc: HtmlDocument) = HtmlDocument.html doc /// Tries to find the html element of the given document. [] - static member TryGetHtml(doc:HtmlDocument) = - HtmlDocument.tryGetHtml doc + static member TryGetHtml(doc: HtmlDocument) = HtmlDocument.tryGetHtml doc // -------------------------------------------------------------------------------------- @@ -1149,5 +1198,4 @@ type HtmlDocumentExtensions = module HtmlExtensions = /// Gets the value of an attribute from an HTML element - let (?) (node : HtmlNode) name = - HtmlNode.attributeValue name node + let (?) (node: HtmlNode) name = HtmlNode.attributeValue name node diff --git a/src/Html/HtmlParser.fs b/src/Html/HtmlParser.fs index eb0925d6d..61990ba30 100644 --- a/src/Html/HtmlParser.fs +++ b/src/Html/HtmlParser.fs @@ -20,30 +20,32 @@ open System.Collections.Generic /// type HtmlAttribute = - internal | HtmlAttribute of name:string * value:string + internal + | HtmlAttribute of name: string * value: string /// /// Creates an html attribute /// /// The name of the attribute /// The value of the attribute - static member New(name:string, value:string) = + static member New(name: string, value: string) = HtmlAttribute(name.ToLowerInvariant(), value) [] /// Represents an HTML node. The names of elements are always normalized to lowercase type HtmlNode = - internal | HtmlElement of name:string * attributes:HtmlAttribute list * elements:HtmlNode list - | HtmlText of content:string - | HtmlComment of content:string - | HtmlCData of content:string + internal + | HtmlElement of name: string * attributes: HtmlAttribute list * elements: HtmlNode list + | HtmlText of content: string + | HtmlComment of content: string + | HtmlCData of content: string /// /// Creates an html element /// /// The name of the element - static member NewElement(name:string) = + static member NewElement(name: string) = HtmlElement(name.ToLowerInvariant(), [], []) /// @@ -51,7 +53,7 @@ type HtmlNode = /// /// The name of the element /// The HtmlAttribute(s) of the element - static member NewElement(name:string, attrs:seq<_>) = + static member NewElement(name: string, attrs: seq<_>) = let attrs = attrs |> Seq.map HtmlAttribute.New |> Seq.toList HtmlElement(name.ToLowerInvariant(), attrs, []) @@ -60,7 +62,7 @@ type HtmlNode = /// /// The name of the element /// The children elements of this element - static member NewElement(name:string, children:seq<_>) = + static member NewElement(name: string, children: seq<_>) = HtmlElement(name.ToLowerInvariant(), [], List.ofSeq children) @@ -70,7 +72,7 @@ type HtmlNode = /// The name of the element /// The HtmlAttribute(s) of the element /// The children elements of this element - static member NewElement(name:string, attrs:seq<_>, children:seq<_>) = + static member NewElement(name: string, attrs: seq<_>, children: seq<_>) = let attrs = attrs |> Seq.map HtmlAttribute.New |> Seq.toList HtmlElement(name.ToLowerInvariant(), attrs, List.ofSeq children) @@ -95,32 +97,57 @@ type HtmlNode = override x.ToString() = let isVoidElement = let set = - [| "area"; "base"; "br"; "col"; "command"; "embed"; "hr"; "img"; "input" - "keygen"; "link"; "meta"; "param"; "source"; "track"; "wbr" |] + [| "area" + "base" + "br" + "col" + "command" + "embed" + "hr" + "img" + "input" + "keygen" + "link" + "meta" + "param" + "source" + "track" + "wbr" |] |> Set.ofArray + fun name -> Set.contains name set - let rec serialize (sb:StringBuilder) indentation canAddNewLine html = - let append (str:string) = sb.Append str |> ignore + + let rec serialize (sb: StringBuilder) indentation canAddNewLine html = + let append (str: string) = sb.Append str |> ignore + let appendEndTag name = append "" + let newLine plus = sb.AppendLine() |> ignore String(' ', indentation + plus) |> append + match html with - | HtmlElement(name, attributes, elements) -> - let onlyText = elements |> List.forall (function HtmlText _ -> true | _ -> false) - if canAddNewLine && not onlyText then - newLine 0 + | HtmlElement (name, attributes, elements) -> + let onlyText = + elements + |> List.forall (function + | HtmlText _ -> true + | _ -> false) + + if canAddNewLine && not onlyText then newLine 0 append "<" append name - for HtmlAttribute(name, value) in attributes do + + for HtmlAttribute (name, value) in attributes do append " " append name append "=\"" append value append "\"" + if isVoidElement name then append " />" elif elements.IsEmpty then @@ -128,24 +155,24 @@ type HtmlNode = appendEndTag name else append ">" - if not onlyText then - newLine 2 + if not onlyText then newLine 2 let mutable canAddNewLine = false + for element in elements do serialize sb (indentation + 2) canAddNewLine element canAddNewLine <- true - if not onlyText then - newLine 0 + + if not onlyText then newLine 0 appendEndTag name | HtmlText str -> append str | HtmlComment str -> - append "" + append "" | HtmlCData str -> - append "" + append "" let sb = StringBuilder() serialize sb 0 false x |> ignore @@ -153,46 +180,62 @@ type HtmlNode = /// [] - [] + [] member x._Print = let str = x.ToString() - if str.Length > 512 then str.Substring(0, 509) + "..." - else str + + if str.Length > 512 then + str.Substring(0, 509) + "..." + else + str [] /// Represents an HTML document type HtmlDocument = - internal | HtmlDocument of docType:string * elements:HtmlNode list + internal + | HtmlDocument of docType: string * elements: HtmlNode list /// /// Creates an html document /// /// The document type specifier string /// The child elements of this document - static member New(docType, children:seq<_>) = + static member New(docType, children: seq<_>) = HtmlDocument(docType, List.ofSeq children) /// /// Creates an html document /// /// The child elements of this document - static member New(children:seq<_>) = - HtmlDocument("", List.ofSeq children) + static member New(children: seq<_>) = HtmlDocument("", List.ofSeq children) override x.ToString() = match x with - | HtmlDocument(docType, elements) -> - (if String.IsNullOrEmpty docType then "" else "" + Environment.NewLine) - + - (elements |> List.map (fun x -> x.ToString()) |> String.Concat) + | HtmlDocument (docType, elements) -> + (if String.IsNullOrEmpty docType then + "" + else + "" + Environment.NewLine) + + (elements + |> List.map (fun x -> x.ToString()) + |> String.Concat) /// [] - [] + [] member x._Print = let str = x.ToString() - if str.Length > 512 then str.Substring(0, 509) + "..." - else str + + if str.Length > 512 then + str.Substring(0, 509) + "..." + else + str // -------------------------------------------------------------------------------------- @@ -201,7 +244,7 @@ module private TextParser = let toPattern f c = if f c then Some c else None - let (|EndOfFile|_|) (c : char) = + let (|EndOfFile|_|) (c: char) = let value = c |> int if (value = -1 || value = 65535) then Some c else None @@ -219,7 +262,7 @@ module internal HtmlParser = type HtmlToken = | DocType of string - | Tag of isSelfClosing:bool * name:string * attrs:HtmlAttribute list + | Tag of isSelfClosing: bool * name: string * attrs: HtmlAttribute list | TagEnd of string | Text of string | Comment of string @@ -228,30 +271,35 @@ module internal HtmlParser = override x.ToString() = match x with | DocType dt -> sprintf "doctype %s" dt - | Tag(selfClose,name,_) -> sprintf "tag %b %s" selfClose name + | Tag (selfClose, name, _) -> sprintf "tag %b %s" selfClose name | TagEnd name -> sprintf "tagEnd %s" name | Text _ -> "text" | Comment _ -> "comment" | EOF -> "eof" | CData _ -> "cdata" + member x.IsEndTag name = match x with - | TagEnd(endName) when name = endName -> true + | TagEnd (endName) when name = endName -> true | _ -> false type TextReader with member x.PeekChar() = x.Peek() |> char member x.ReadChar() = x.Read() |> char + member x.ReadNChar(n) = let buffer = Array.zeroCreate n x.ReadBlock(buffer, 0, n) |> ignore String(buffer) type CharList = - { mutable Contents : char list } + { mutable Contents: char list } static member Empty = { Contents = [] } - override x.ToString() = String(x.Contents |> List.rev |> List.toArray) + + override x.ToString() = + String(x.Contents |> List.rev |> List.toArray) + member x.Cons(c) = x.Contents <- c :: x.Contents member x.Length = x.Contents.Length member x.Clear() = x.Contents <- [] @@ -273,14 +321,14 @@ module internal HtmlParser = | CDATAMode -> "cdata" type HtmlState = - { Attributes : (CharList * CharList) list ref - CurrentTag : CharList ref - Content : CharList ref + { Attributes: (CharList * CharList) list ref + CurrentTag: CharList ref + Content: CharList ref HasFormattedParent: bool ref - InsertionMode : InsertionMode ref - Tokens : HtmlToken list ref - Reader : TextReader } - static member Create (reader:TextReader) = + InsertionMode: InsertionMode ref + Tokens: HtmlToken list ref + Reader: TextReader } + static member Create(reader: TextReader) = { Attributes = ref [] CurrentTag = ref CharList.Empty Content = ref CharList.Empty @@ -291,41 +339,50 @@ module internal HtmlParser = member x.Pop() = x.Reader.Read() |> ignore member x.Peek() = x.Reader.PeekChar() + member x.Pop(count) = - [|0..(count-1)|] |> Array.map (fun _ -> x.Reader.ReadChar()) + [| 0 .. (count - 1) |] + |> Array.map (fun _ -> x.Reader.ReadChar()) member x.Contents = (!x.Content).ToString() member x.ContentLength = (!x.Content).Length - member x.NewAttribute() = x.Attributes := (CharList.Empty, CharList.Empty) :: (!x.Attributes) + member x.NewAttribute() = + x.Attributes + := (CharList.Empty, CharList.Empty) + :: (!x.Attributes) member x.ConsAttrName() = match !x.Attributes with - | [] -> x.NewAttribute(); x.ConsAttrName() - | (h,_) :: _ -> h.Cons(Char.ToLowerInvariant(x.Reader.ReadChar())) + | [] -> + x.NewAttribute() + x.ConsAttrName() + | (h, _) :: _ -> h.Cons(Char.ToLowerInvariant(x.Reader.ReadChar())) - member x.CurrentTagName() = - (!x.CurrentTag).ToString().Trim() + member x.CurrentTagName() = (!x.CurrentTag).ToString().Trim() member x.CurrentAttrName() = match !x.Attributes with | [] -> String.Empty - | (h,_) :: _ -> h.ToString() + | (h, _) :: _ -> h.ToString() member x.ConsAttrValue(c) = match !x.Attributes with - | [] -> x.NewAttribute(); x.ConsAttrValue(c) - | (_,h) :: _ -> h.Cons(c) + | [] -> + x.NewAttribute() + x.ConsAttrValue(c) + | (_, h) :: _ -> h.Cons(c) - member x.ConsAttrValue() = - x.ConsAttrValue(x.Reader.ReadChar()) + member x.ConsAttrValue() = x.ConsAttrValue(x.Reader.ReadChar()) member x.GetAttributes() = !x.Attributes |> List.choose (fun (key, value) -> - if key.Length > 0 - then Some <| HtmlAttribute(key.ToString(), value.ToString()) - else None) + if key.Length > 0 then + Some + <| HtmlAttribute(key.ToString(), value.ToString()) + else + None) |> List.rev member x.EmitSelfClosingTag() = @@ -336,38 +393,43 @@ module internal HtmlParser = x.Attributes := [] x.Tokens := result :: !x.Tokens - member x.IsFormattedTag - with get() = - match x.CurrentTagName().ToLower() with - | "pre" -> true - | _ -> false + member x.IsFormattedTag = + match x.CurrentTagName().ToLower() with + | "pre" -> true + | _ -> false - member x.IsScriptTag - with get() = - match x.CurrentTagName().ToLower() with - | "script" | "style" -> true - | _ -> false + member x.IsScriptTag = + match x.CurrentTagName().ToLower() with + | "script" + | "style" -> true + | _ -> false member x.EmitTag(isEnd) = let name = (!x.CurrentTag).ToString().Trim() + let result = - if isEnd - then - if x.ContentLength > 0 - then x.Emit(); TagEnd(name) - else TagEnd(name) - else Tag(false, name, x.GetAttributes()) + if isEnd then + if x.ContentLength > 0 then + x.Emit() + TagEnd(name) + else + TagEnd(name) + else + Tag(false, name, x.GetAttributes()) // pre is the only default formatted tag, nested pres are not // allowed in the spec. if x.IsFormattedTag then x.HasFormattedParent := not isEnd else - x.HasFormattedParent := !x.HasFormattedParent || x.IsFormattedTag + x.HasFormattedParent + := !x.HasFormattedParent || x.IsFormattedTag - x.InsertionMode := - if x.IsScriptTag && (not isEnd) then ScriptMode - else DefaultMode + x.InsertionMode + := if x.IsScriptTag && (not isEnd) then + ScriptMode + else + DefaultMode x.CurrentTag := CharList.Empty x.Attributes := [] @@ -376,28 +438,37 @@ module internal HtmlParser = member x.EmitToAttributeValue() = assert (!x.InsertionMode = InsertionMode.CharRefMode) let content = (!x.Content).ToString() |> HtmlCharRefs.substitute + for c in content.ToCharArray() do x.ConsAttrValue c + x.Content := CharList.Empty x.InsertionMode := DefaultMode member x.Emit() : unit = let result = let content = (!x.Content).ToString() + match !x.InsertionMode with | DefaultMode -> if !x.HasFormattedParent then Text content else let normalizedContent = wsRegex.Value.Replace(content, " ") - if normalizedContent = " " then Text "" else Text normalizedContent + + if normalizedContent = " " then + Text "" + else + Text normalizedContent | ScriptMode -> content |> Text | CharRefMode -> content.Trim() |> HtmlCharRefs.substitute |> Text | CommentMode -> Comment content | DocTypeMode -> DocType content - | CDATAMode -> CData (content.Replace("", "")) + | CDATAMode -> CData(content.Replace("", "")) + x.Content := CharList.Empty x.InsertionMode := DefaultMode + match result with | Text t when String.IsNullOrEmpty(t) -> () | _ -> x.Tokens := result :: !x.Tokens @@ -405,219 +476,419 @@ module internal HtmlParser = member x.Cons() = (!x.Content).Cons(x.Reader.ReadChar()) member x.Cons(char) = (!x.Content).Cons(char) member x.Cons(char) = Array.iter ((!x.Content).Cons) char - member x.Cons(char : string) = x.Cons(char.ToCharArray()) + member x.Cons(char: string) = x.Cons(char.ToCharArray()) + member x.ConsTag() = match x.Reader.ReadChar() with | TextParser.Whitespace _ -> () | a -> (!x.CurrentTag).Cons(Char.ToLowerInvariant a) - member x.ClearContent() = - (!x.Content).Clear() + + member x.ClearContent() = (!x.Content).Clear() // Tokenises a stream into a sequence of HTML tokens. let private tokenise reader = let state = HtmlState.Create reader - let rec data (state:HtmlState) = + + let rec data (state: HtmlState) = match state.Peek() with | '<' -> - if state.ContentLength > 0 - then state.Emit(); - else state.Pop(); tagOpen state + if state.ContentLength > 0 then + state.Emit() + else + state.Pop() + tagOpen state | TextParser.EndOfFile _ -> state.Tokens := EOF :: !state.Tokens | '&' -> - if state.ContentLength > 0 - then state.Emit(); + if state.ContentLength > 0 then + state.Emit() else state.InsertionMode := CharRefMode charRef state | _ -> match !state.InsertionMode with - | DefaultMode -> state.Cons(); data state - | ScriptMode -> script state; + | DefaultMode -> + state.Cons() + data state + | ScriptMode -> script state | CharRefMode -> charRef state | DocTypeMode -> docType state | CommentMode -> comment state | CDATAMode -> data state + and script state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | ''' -> state.Cons(); scriptSingleQuoteString state - | '"' -> state.Cons(); scriptDoubleQuoteString state - | '/' -> state.Cons(); scriptSlash state - | '<' -> state.Pop(); scriptLessThanSign state - | _ -> state.Cons(); script state + | ''' -> + state.Cons() + scriptSingleQuoteString state + | '"' -> + state.Cons() + scriptDoubleQuoteString state + | '/' -> + state.Cons() + scriptSlash state + | '<' -> + state.Pop() + scriptLessThanSign state + | _ -> + state.Cons() + script state + and scriptSingleQuoteString state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | ''' -> state.Cons(); script state - | '\\' -> state.Cons(); scriptSingleQuoteStringBackslash state - | _ -> state.Cons(); scriptSingleQuoteString state + | ''' -> + state.Cons() + script state + | '\\' -> + state.Cons() + scriptSingleQuoteStringBackslash state + | _ -> + state.Cons() + scriptSingleQuoteString state + and scriptDoubleQuoteString state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | '"' -> state.Cons(); script state - | '\\' -> state.Cons(); scriptDoubleQuoteStringBackslash state - | _ -> state.Cons(); scriptDoubleQuoteString state + | '"' -> + state.Cons() + script state + | '\\' -> + state.Cons() + scriptDoubleQuoteStringBackslash state + | _ -> + state.Cons() + scriptDoubleQuoteString state + and scriptSingleQuoteStringBackslash state = match state.Peek() with - | _ -> state.Cons(); scriptSingleQuoteString state + | _ -> + state.Cons() + scriptSingleQuoteString state + and scriptDoubleQuoteStringBackslash state = match state.Peek() with - | _ -> state.Cons(); scriptDoubleQuoteString state + | _ -> + state.Cons() + scriptDoubleQuoteString state + and scriptSlash state = match state.Peek() with - | '/' -> state.Cons(); scriptSingleLineComment state - | '*' -> state.Cons(); scriptMultiLineComment state + | '/' -> + state.Cons() + scriptSingleLineComment state + | '*' -> + state.Cons() + scriptMultiLineComment state | _ -> script state + and scriptMultiLineComment state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | '*' -> state.Cons(); scriptMultiLineCommentStar state - | _ -> state.Cons(); scriptMultiLineComment state + | '*' -> + state.Cons() + scriptMultiLineCommentStar state + | _ -> + state.Cons() + scriptMultiLineComment state + and scriptMultiLineCommentStar state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | '/' -> state.Cons(); script state + | '/' -> + state.Cons() + script state | _ -> scriptMultiLineComment state + and scriptSingleLineComment state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | '\n' -> state.Cons(); script state - | _ -> state.Cons(); scriptSingleLineComment state + | '\n' -> + state.Cons() + script state + | _ -> + state.Cons() + scriptSingleLineComment state + and scriptLessThanSign state = match state.Peek() with - | '/' -> state.Pop(); scriptEndTagOpen state - | '!' -> state.Cons('<'); state.Cons(); scriptDataEscapeStart state - | _ -> state.Cons('<'); state.Cons(); script state + | '/' -> + state.Pop() + scriptEndTagOpen state + | '!' -> + state.Cons('<') + state.Cons() + scriptDataEscapeStart state + | _ -> + state.Cons('<') + state.Cons() + script state + and scriptDataEscapeStart state = match state.Peek() with - | '-' -> state.Cons(); scriptDataEscapeStartDash state + | '-' -> + state.Cons() + scriptDataEscapeStartDash state | _ -> script state + and scriptDataEscapeStartDash state = match state.Peek() with - | '-' -> state.Cons(); scriptDataEscapedDashDash state + | '-' -> + state.Cons() + scriptDataEscapedDashDash state | _ -> script state + and scriptDataEscapedDashDash state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | '-' -> state.Cons(); scriptDataEscapedDashDash state - | '<' -> state.Pop(); scriptDataEscapedLessThanSign state - | '>' -> state.Cons(); script state - | _ -> state.Cons(); scriptDataEscaped state + | '-' -> + state.Cons() + scriptDataEscapedDashDash state + | '<' -> + state.Pop() + scriptDataEscapedLessThanSign state + | '>' -> + state.Cons() + script state + | _ -> + state.Cons() + scriptDataEscaped state + and scriptDataEscapedLessThanSign state = match state.Peek() with - | '/' -> state.Pop(); scriptDataEscapedEndTagOpen state - | TextParser.Letter _ -> state.Cons('<'); state.Cons(); scriptDataDoubleEscapeStart state - | _ -> state.Cons('<'); state.Cons(); scriptDataEscaped state + | '/' -> + state.Pop() + scriptDataEscapedEndTagOpen state + | TextParser.Letter _ -> + state.Cons('<') + state.Cons() + scriptDataDoubleEscapeStart state + | _ -> + state.Cons('<') + state.Cons() + scriptDataEscaped state + and scriptDataDoubleEscapeStart state = match state.Peek() with - | TextParser.Whitespace _ | '/' | '>' when state.IsScriptTag -> state.Cons(); scriptDataDoubleEscaped state - | TextParser.Letter _ -> state.Cons(); scriptDataDoubleEscapeStart state - | _ -> state.Cons(); scriptDataEscaped state + | TextParser.Whitespace _ + | '/' + | '>' when state.IsScriptTag -> + state.Cons() + scriptDataDoubleEscaped state + | TextParser.Letter _ -> + state.Cons() + scriptDataDoubleEscapeStart state + | _ -> + state.Cons() + scriptDataEscaped state + and scriptDataDoubleEscaped state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | '-' -> state.Cons(); scriptDataDoubleEscapedDash state - | '<' -> state.Cons(); scriptDataDoubleEscapedLessThanSign state - | _ -> state.Cons(); scriptDataDoubleEscaped state + | '-' -> + state.Cons() + scriptDataDoubleEscapedDash state + | '<' -> + state.Cons() + scriptDataDoubleEscapedLessThanSign state + | _ -> + state.Cons() + scriptDataDoubleEscaped state + and scriptDataDoubleEscapedDash state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | '-' -> state.Cons(); scriptDataDoubleEscapedDashDash state - | '<' -> state.Cons(); scriptDataDoubleEscapedLessThanSign state - | _ -> state.Cons(); scriptDataDoubleEscaped state + | '-' -> + state.Cons() + scriptDataDoubleEscapedDashDash state + | '<' -> + state.Cons() + scriptDataDoubleEscapedLessThanSign state + | _ -> + state.Cons() + scriptDataDoubleEscaped state + and scriptDataDoubleEscapedLessThanSign state = match state.Peek() with - | '/' -> state.Cons(); scriptDataDoubleEscapeEnd state - | _ -> state.Cons(); scriptDataDoubleEscaped state + | '/' -> + state.Cons() + scriptDataDoubleEscapeEnd state + | _ -> + state.Cons() + scriptDataDoubleEscaped state + and scriptDataDoubleEscapeEnd state = match state.Peek() with - | TextParser.Whitespace _ | '/' | '>' when state.IsScriptTag -> state.Cons(); scriptDataDoubleEscaped state - | TextParser.Letter _ -> state.Cons(); scriptDataDoubleEscapeEnd state - | _ -> state.Cons(); scriptDataDoubleEscaped state + | TextParser.Whitespace _ + | '/' + | '>' when state.IsScriptTag -> + state.Cons() + scriptDataDoubleEscaped state + | TextParser.Letter _ -> + state.Cons() + scriptDataDoubleEscapeEnd state + | _ -> + state.Cons() + scriptDataDoubleEscaped state + and scriptDataDoubleEscapedDashDash state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | '-' -> state.Cons(); scriptDataDoubleEscapedDashDash state - | '<' -> state.Cons(); scriptDataDoubleEscapedLessThanSign state - | '>' -> state.Cons(); script state - | _ -> state.Cons(); scriptDataDoubleEscaped state + | '-' -> + state.Cons() + scriptDataDoubleEscapedDashDash state + | '<' -> + state.Cons() + scriptDataDoubleEscapedLessThanSign state + | '>' -> + state.Cons() + script state + | _ -> + state.Cons() + scriptDataDoubleEscaped state + and scriptDataEscapedEndTagOpen state = match state.Peek() with | TextParser.Letter _ -> scriptDataEscapedEndTagName state - | _ -> state.Cons([|'<';'/'|]); state.Cons(); scriptDataEscaped state + | _ -> + state.Cons([| '<'; '/' |]) + state.Cons() + scriptDataEscaped state + and scriptDataEscapedEndTagName state = match state.Peek() with - | TextParser.Whitespace _ when state.IsScriptTag -> state.Pop(); beforeAttributeName state - | '/' when state.IsScriptTag -> state.Pop(); selfClosingStartTag state - | '>' when state.IsScriptTag -> state.Pop(); state.EmitTag(true); + | TextParser.Whitespace _ when state.IsScriptTag -> + state.Pop() + beforeAttributeName state + | '/' when state.IsScriptTag -> + state.Pop() + selfClosingStartTag state + | '>' when state.IsScriptTag -> + state.Pop() + state.EmitTag(true) | '>' -> - state.Cons([|'<'; '/'|]); - state.Cons(state.CurrentTagName()); + state.Cons([| '<'; '/' |]) + state.Cons(state.CurrentTagName()) (!state.CurrentTag).Clear() script state - | TextParser.Letter _ -> state.ConsTag(); scriptDataEscapedEndTagName state - | _ -> state.Cons([|'<';'/'|]); state.Cons(); scriptDataEscaped state + | TextParser.Letter _ -> + state.ConsTag() + scriptDataEscapedEndTagName state + | _ -> + state.Cons([| '<'; '/' |]) + state.Cons() + scriptDataEscaped state + and scriptDataEscaped state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | '-' -> state.Cons(); scriptDataEscapedDash state + | '-' -> + state.Cons() + scriptDataEscapedDash state | '<' -> scriptDataEscapedLessThanSign state - | _ -> state.Cons(); scriptDataEscaped state + | _ -> + state.Cons() + scriptDataEscaped state + and scriptDataEscapedDash state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | '-' -> state.Cons(); scriptDataEscapedDashDash state + | '-' -> + state.Cons() + scriptDataEscapedDashDash state | '<' -> scriptDataEscapedLessThanSign state - | _ -> state.Cons(); scriptDataEscaped state + | _ -> + state.Cons() + scriptDataEscaped state + and scriptEndTagOpen state = match state.Peek() with | TextParser.Letter _ -> scriptEndTagName state - | _ -> state.Cons('<'); state.Cons('/'); script state + | _ -> + state.Cons('<') + state.Cons('/') + script state + and scriptEndTagName state = match state.Peek() with - | TextParser.Whitespace _ -> state.Pop(); beforeAttributeName state - | '/' when state.IsScriptTag -> state.Pop(); selfClosingStartTag state - | '>' when state.IsScriptTag -> state.Pop(); state.EmitTag(true); - | TextParser.Letter _ -> state.ConsTag(); scriptEndTagName state + | TextParser.Whitespace _ -> + state.Pop() + beforeAttributeName state + | '/' when state.IsScriptTag -> + state.Pop() + selfClosingStartTag state + | '>' when state.IsScriptTag -> + state.Pop() + state.EmitTag(true) + | TextParser.Letter _ -> + state.ConsTag() + scriptEndTagName state | _ -> - state.Cons([|'<'; '/'|]); - state.Cons(state.CurrentTagName()); + state.Cons([| '<'; '/' |]) + state.Cons(state.CurrentTagName()) (!state.CurrentTag).Clear() script state + and charRef state = match state.Peek() with - | ';' -> state.Cons(); state.Emit() + | ';' -> + state.Cons() + state.Emit() | '<' -> state.Emit() // System.IO.TextReader.Read() returns -1 // at end of stream, and -1 cast to char is \uffff. | '\uffff' -> state.Emit() - | _ -> state.Cons(); charRef state + | _ -> + state.Cons() + charRef state + and tagOpen state = match state.Peek() with - | '!' -> state.Pop(); markupDeclaration state - | '/' -> state.Pop(); endTagOpen state - | '?' -> state.Pop(); bogusComment state - | TextParser.Letter _ -> state.ConsTag(); tagName false state - | _ -> state.Cons('<'); data state + | '!' -> + state.Pop() + markupDeclaration state + | '/' -> + state.Pop() + endTagOpen state + | '?' -> + state.Pop() + bogusComment state + | TextParser.Letter _ -> + state.ConsTag() + tagName false state + | _ -> + state.Cons('<') + data state + and bogusComment state = - let rec bogusComment' (state:HtmlState) = + let rec bogusComment' (state: HtmlState) = let exitBogusComment state = state.InsertionMode := CommentMode state.Emit() + match state.Peek() with - | '>' -> state.Cons(); exitBogusComment state + | '>' -> + state.Cons() + exitBogusComment state | TextParser.EndOfFile _ -> exitBogusComment state - | _ -> state.Cons(); bogusComment' state + | _ -> + state.Cons() + bogusComment' state + bogusComment' state + and markupDeclaration state = match state.Pop(2) with - | [|'-';'-'|] -> comment state + | [| '-'; '-' |] -> comment state | current -> match new String(Array.append current (state.Pop(5))) with | "DOCTYPE" -> docType state - | "[CDATA[" -> state.Cons(" + state.Cons(" bogusComment state - and cData i (state:HtmlState) = + + and cData i (state: HtmlState) = match state.Peek() with | ']' when i = 0 || i = 1 -> state.Cons() @@ -632,110 +903,202 @@ module internal HtmlParser = | _ -> state.Cons() cData 0 state + and docType state = match state.Peek() with | '>' -> - state.Pop(); + state.Pop() state.InsertionMode := DocTypeMode state.Emit() - | _ -> state.Cons(); docType state + | _ -> + state.Cons() + docType state + and comment state = match state.Peek() with - | '-' -> state.Pop(); commentEndDash state; + | '-' -> + state.Pop() + commentEndDash state | TextParser.EndOfFile _ -> state.InsertionMode := CommentMode - state.Emit(); - | _ -> state.Cons(); comment state + state.Emit() + | _ -> + state.Cons() + comment state + and commentEndDash state = match state.Peek() with - | '-' -> state.Pop(); commentEndState state + | '-' -> + state.Pop() + commentEndState state | TextParser.EndOfFile _ -> state.InsertionMode := CommentMode - state.Emit(); + state.Emit() | _ -> - state.Cons(); comment state; + state.Cons() + comment state + and commentEndState state = match state.Peek() with | '>' -> - state.Pop(); + state.Pop() state.InsertionMode := CommentMode - state.Emit(); + state.Emit() | TextParser.EndOfFile _ -> state.InsertionMode := CommentMode - state.Emit(); - | _ -> state.Cons(); comment state + state.Emit() + | _ -> + state.Cons() + comment state + and tagName isEndTag state = match state.Peek() with - | TextParser.Whitespace _ -> state.Pop(); beforeAttributeName state + | TextParser.Whitespace _ -> + state.Pop() + beforeAttributeName state | TextParser.EndOfFile _ -> state.EmitTag(isEndTag) - | '/' -> state.Pop(); selfClosingStartTag state - | '>' -> state.Pop(); state.EmitTag(isEndTag) - | _ -> state.ConsTag(); tagName isEndTag state + | '/' -> + state.Pop() + selfClosingStartTag state + | '>' -> + state.Pop() + state.EmitTag(isEndTag) + | _ -> + state.ConsTag() + tagName isEndTag state + and selfClosingStartTag state = match state.Peek() with - | '>' -> state.Pop(); state.EmitSelfClosingTag() + | '>' -> + state.Pop() + state.EmitSelfClosingTag() | TextParser.EndOfFile _ -> data state | _ -> beforeAttributeName state + and endTagOpen state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | TextParser.Letter _ -> state.ConsTag(); tagName true state - | '>' -> state.Pop(); data state + | TextParser.Letter _ -> + state.ConsTag() + tagName true state + | '>' -> + state.Pop() + data state | _ -> comment state + and beforeAttributeName state = match state.Peek() with - | TextParser.Whitespace _ -> state.Pop(); beforeAttributeName state - | '/' -> state.Pop(); selfClosingStartTag state - | '>' -> state.Pop(); state.EmitTag(false) + | TextParser.Whitespace _ -> + state.Pop() + beforeAttributeName state + | '/' -> + state.Pop() + selfClosingStartTag state + | '>' -> + state.Pop() + state.EmitTag(false) | _ -> attributeName state + and attributeName state = match state.Peek() with - | '=' -> state.Pop(); beforeAttributeValue state - | '/' -> state.Pop(); selfClosingStartTag state - | '>' -> state.Pop(); state.EmitTag(false) - | TextParser.LetterDigit _ -> state.ConsAttrName(); attributeName state + | '=' -> + state.Pop() + beforeAttributeValue state + | '/' -> + state.Pop() + selfClosingStartTag state + | '>' -> + state.Pop() + state.EmitTag(false) + | TextParser.LetterDigit _ -> + state.ConsAttrName() + attributeName state | TextParser.Whitespace _ -> afterAttributeName state | TextParser.EndOfFile _ -> state.EmitTag(false) - | _ -> state.ConsAttrName(); attributeName state + | _ -> + state.ConsAttrName() + attributeName state + and afterAttributeName state = match state.Peek() with - | TextParser.Whitespace _ -> state.Pop(); afterAttributeName state - | '/' -> state.Pop(); selfClosingStartTag state - | '>' -> state.Pop(); state.EmitTag(false) - | '=' -> state.Pop(); beforeAttributeValue state - | _ -> state.NewAttribute(); attributeName state + | TextParser.Whitespace _ -> + state.Pop() + afterAttributeName state + | '/' -> + state.Pop() + selfClosingStartTag state + | '>' -> + state.Pop() + state.EmitTag(false) + | '=' -> + state.Pop() + beforeAttributeValue state + | _ -> + state.NewAttribute() + attributeName state + and beforeAttributeValue state = match state.Peek() with - | TextParser.Whitespace _ -> state.Pop(); beforeAttributeValue state + | TextParser.Whitespace _ -> + state.Pop() + beforeAttributeValue state | TextParser.EndOfFile _ -> state.EmitTag(false) - | '/' -> state.Pop(); selfClosingStartTag state - | '>' -> state.Pop(); state.EmitTag(false) - | '"' -> state.Pop(); attributeValueQuoted '"' state - | '\'' -> state.Pop(); attributeValueQuoted '\'' state + | '/' -> + state.Pop() + selfClosingStartTag state + | '>' -> + state.Pop() + state.EmitTag(false) + | '"' -> + state.Pop() + attributeValueQuoted '"' state + | '\'' -> + state.Pop() + attributeValueQuoted '\'' state | _ -> attributeValueUnquoted state + and attributeValueUnquoted state = match state.Peek() with - | TextParser.Whitespace _ -> state.Pop(); state.NewAttribute(); beforeAttributeName state - | '/' -> state.Pop(); attributeValueUnquotedSlash state - | '>' -> state.Pop(); state.EmitTag(false) + | TextParser.Whitespace _ -> + state.Pop() + state.NewAttribute() + beforeAttributeName state + | '/' -> + state.Pop() + attributeValueUnquotedSlash state + | '>' -> + state.Pop() + state.EmitTag(false) | '&' -> assert (state.ContentLength = 0) state.InsertionMode := InsertionMode.CharRefMode - attributeValueUnquotedCharRef ['/'; '>'] state - | _ -> state.ConsAttrValue(); attributeValueUnquoted state + attributeValueUnquotedCharRef [ '/'; '>' ] state + | _ -> + state.ConsAttrValue() + attributeValueUnquoted state + and attributeValueUnquotedSlash state = match state.Peek() with | '>' -> selfClosingStartTag state - | _ -> state.ConsAttrValue('/'); state.ConsAttrValue(); attributeValueUnquoted state + | _ -> + state.ConsAttrValue('/') + state.ConsAttrValue() + attributeValueUnquoted state + and attributeValueQuoted quote state = match state.Peek() with | TextParser.EndOfFile _ -> data state - | c when c = quote -> state.Pop(); afterAttributeValueQuoted state + | c when c = quote -> + state.Pop() + afterAttributeValueQuoted state | '&' -> assert (state.ContentLength = 0) state.InsertionMode := InsertionMode.CharRefMode attributeValueQuotedCharRef quote state - | _ -> state.ConsAttrValue(); attributeValueQuoted quote state + | _ -> + state.ConsAttrValue() + attributeValueQuoted quote state + and attributeValueQuotedCharRef quote state = match state.Peek() with | ';' -> @@ -751,6 +1114,7 @@ module internal HtmlParser = | _ -> state.Cons() attributeValueQuotedCharRef quote state + and attributeValueUnquotedCharRef stop state = match state.Peek() with | ';' -> @@ -766,57 +1130,98 @@ module internal HtmlParser = | _ -> state.Cons() attributeValueUnquotedCharRef stop state + and afterAttributeValueQuoted state = match state.Peek() with - | TextParser.Whitespace _ -> state.Pop(); state.NewAttribute(); afterAttributeValueQuoted state - | '/' -> state.Pop(); selfClosingStartTag state - | '>' -> state.Pop(); state.EmitTag(false) - | _ -> state.NewAttribute(); attributeName state + | TextParser.Whitespace _ -> + state.Pop() + state.NewAttribute() + afterAttributeValueQuoted state + | '/' -> + state.Pop() + selfClosingStartTag state + | '>' -> + state.Pop() + state.EmitTag(false) + | _ -> + state.NewAttribute() + attributeName state let next = ref (state.Reader.Peek()) + while !next <> -1 do - data state - next := state.Reader.Peek() + data state + next := state.Reader.Peek() !state.Tokens |> List.rev let private parse reader = - let canNotHaveChildren (name:string) = + let canNotHaveChildren (name: string) = match name with - | "area" | "base" | "br" | "col" | "embed"| "hr" | "img" | "input" | "keygen" | "link" | "menuitem" | "meta" | "param" - | "source" | "track" | "wbr" -> true + | "area" + | "base" + | "br" + | "col" + | "embed" + | "hr" + | "img" + | "input" + | "keygen" + | "link" + | "menuitem" + | "meta" + | "param" + | "source" + | "track" + | "wbr" -> true | _ -> false - let isImplicitlyClosedByStartTag expectedTagEnd startTag = + let isImplicitlyClosedByStartTag expectedTagEnd startTag = match expectedTagEnd, startTag with - | ("td"|"th") , ("tr"|"td"|"th") -> true + | ("td" + | "th"), + ("tr" + | "td" + | "th") -> true | "tr", "tr" -> true | "li", "li" -> true | _ -> false let implicitlyCloseByStartTag expectedTagEnd startTag tokens = match expectedTagEnd, startTag with - | ("td"|"th"), "tr" -> + | ("td" + | "th"), + "tr" -> // the new tr is closing the cell and previous row TagEnd expectedTagEnd :: TagEnd "tr" :: tokens - | ("td"|"th") , ("td"|"th") + | ("td" + | "th"), + ("td" + | "th") | "tr", "tr" | "li", "li" -> // tags are on same level, just close TagEnd expectedTagEnd :: tokens | _ -> tokens - let isImplicitlyClosedByEndTag expectedTagEnd startTag = + let isImplicitlyClosedByEndTag expectedTagEnd startTag = match expectedTagEnd, startTag with - | ("td"|"th"|"tr") , ("thead"|"tbody"|"tfoot"|"table") -> true - | "li" , "ul" -> true + | ("td" + | "th" + | "tr"), + ("thead" + | "tbody" + | "tfoot" + | "table") -> true + | "li", "ul" -> true | _ -> false let implicitlyCloseByEndTag expectedTagEnd tokens = match expectedTagEnd with - | "td" | "th" -> + | "td" + | "th" -> // the end tag closes the cell and the row - TagEnd expectedTagEnd :: TagEnd "tr" :: tokens + TagEnd expectedTagEnd :: TagEnd "tr" :: tokens | "tr" | "li" -> // Only on level need to be closed @@ -824,12 +1229,19 @@ module internal HtmlParser = | _ -> tokens - let rec parse' (callstack: Stack) docType elements expectedTagEnd parentTagName (tokens:HtmlToken list) = + let rec parse' + (callstack: Stack) + docType + elements + expectedTagEnd + parentTagName + (tokens: HtmlToken list) + = let parse' = parse' callstack let recursiveReturn (dt, tokens, content) = - if callstack.Count = 0 - then (dt, tokens, content) + if callstack.Count = 0 then + (dt, tokens, content) else let _, elements, expectedTagEnd, parentTagName, name, attributes = callstack.Pop() let e = HtmlElement(name, attributes, content) @@ -837,39 +1249,49 @@ module internal HtmlParser = match tokens with | DocType dt :: rest -> parse' (dt.Trim()) elements expectedTagEnd parentTagName rest - | Tag(_, "br", []) :: rest -> + | Tag (_, "br", []) :: rest -> let t = HtmlText Environment.NewLine parse' docType (t :: elements) expectedTagEnd parentTagName rest - | Tag(true, name, attributes) :: rest -> - let e = HtmlElement(name, attributes, []) - parse' docType (e :: elements) expectedTagEnd parentTagName rest - | Tag(false, name, attributes) :: rest when canNotHaveChildren name -> - let e = HtmlElement(name, attributes, []) - parse' docType (e :: elements) expectedTagEnd parentTagName rest - | Tag(_, name, _) :: _ when isImplicitlyClosedByStartTag expectedTagEnd name -> + | Tag (true, name, attributes) :: rest -> + let e = HtmlElement(name, attributes, []) + parse' docType (e :: elements) expectedTagEnd parentTagName rest + | Tag (false, name, attributes) :: rest when canNotHaveChildren name -> + let e = HtmlElement(name, attributes, []) + parse' docType (e :: elements) expectedTagEnd parentTagName rest + | Tag (_, name, _) :: _ when isImplicitlyClosedByStartTag expectedTagEnd name -> // insert missing or when starting new row/cell/header - parse' docType elements expectedTagEnd parentTagName (implicitlyCloseByStartTag expectedTagEnd name tokens) - | TagEnd(name) :: _ when isImplicitlyClosedByEndTag expectedTagEnd name -> + parse' + docType + elements + expectedTagEnd + parentTagName + (implicitlyCloseByStartTag expectedTagEnd name tokens) + | TagEnd (name) :: _ when isImplicitlyClosedByEndTag expectedTagEnd name -> // insert missing or when starting new row/cell/header parse' docType elements expectedTagEnd parentTagName (implicitlyCloseByEndTag expectedTagEnd tokens) - | Tag(_, name, attributes) :: rest -> - (docType, elements, expectedTagEnd, parentTagName, name, attributes) |> callstack.Push + | Tag (_, name, attributes) :: rest -> + (docType, elements, expectedTagEnd, parentTagName, name, attributes) + |> callstack.Push + parse' docType [] name expectedTagEnd rest | TagEnd name :: _ when name <> expectedTagEnd && name = parentTagName -> // insert missing closing tag parse' docType elements expectedTagEnd parentTagName (TagEnd expectedTagEnd :: tokens) - | TagEnd name :: rest when name <> expectedTagEnd && (name <> (new String(expectedTagEnd.ToCharArray() |> Array.rev))) -> + | TagEnd name :: rest when + name <> expectedTagEnd + && (name + <> (new String(expectedTagEnd.ToCharArray() |> Array.rev))) + -> // ignore this token if not the expected end tag (or it's reverse, eg:
  • ) parse' docType elements expectedTagEnd parentTagName rest - | TagEnd _ :: rest -> - recursiveReturn (docType, rest, List.rev elements) + | TagEnd _ :: rest -> recursiveReturn (docType, rest, List.rev elements) | Text a :: Text b :: rest -> if a = "" && b = "" then // ignore this token parse' docType elements expectedTagEnd parentTagName rest else - let t = HtmlText (a + b) + let t = HtmlText(a + b) parse' docType (t :: elements) expectedTagEnd parentTagName rest | Text cont :: rest -> if cont = "" then @@ -886,25 +1308,23 @@ module internal HtmlParser = parse' docType (c :: elements) expectedTagEnd parentTagName rest | EOF :: _ -> recursiveReturn (docType, [], List.rev elements) | [] -> recursiveReturn (docType, [], List.rev elements) + let tokens = tokenise reader let docType, _, elements = tokens |> parse' (new Stack<_>()) "" [] "" "" - if List.isEmpty elements then - failwith "Invalid HTML" + if List.isEmpty elements then failwith "Invalid HTML" docType, elements /// All attribute names and tag names will be normalized to lowercase /// All html entities will be replaced by the corresponding characters /// All the consecutive whitespace (except for ` `) will be collapsed to a single space /// All br tags will be replaced by newlines - let parseDocument reader = - HtmlDocument(parse reader) + let parseDocument reader = HtmlDocument(parse reader) /// All attribute names and tag names will be normalized to lowercase /// All html entities will be replaced by the corresponding characters /// All the consecutive whitespace (except for ` `) will be collapsed to a single space /// All br tags will be replaced by newlines - let parseFragment reader = - parse reader |> snd + let parseFragment reader = parse reader |> snd // -------------------------------------------------------------------------------------- @@ -916,24 +1336,24 @@ type HtmlDocument with HtmlParser.parseDocument reader /// Loads HTML from the specified stream - static member Load(stream:Stream) = + static member Load(stream: Stream) = use reader = new StreamReader(stream) HtmlParser.parseDocument reader /// Loads HTML from the specified reader - static member Load(reader:TextReader) = - HtmlParser.parseDocument reader + static member Load(reader: TextReader) = HtmlParser.parseDocument reader /// Loads HTML from the specified uri asynchronously - static member AsyncLoad(uri:string, [] ?encoding) = async { - let encoding = defaultArg encoding Encoding.UTF8 - let! reader = IO.asyncReadTextAtRuntime false "" "" "HTML" encoding.WebName uri - return HtmlParser.parseDocument reader - } + static member AsyncLoad(uri: string, [] ?encoding) = + async { + let encoding = defaultArg encoding Encoding.UTF8 + let! reader = IO.asyncReadTextAtRuntime false "" "" "HTML" encoding.WebName uri + return HtmlParser.parseDocument reader + } /// Loads HTML from the specified uri - static member Load(uri:string, [] ?encoding) = - HtmlDocument.AsyncLoad(uri, ?encoding=encoding) + static member Load(uri: string, [] ?encoding) = + HtmlDocument.AsyncLoad(uri, ?encoding = encoding) |> Async.RunSynchronously type HtmlNode with diff --git a/src/Html/HtmlProvider.fs b/src/Html/HtmlProvider.fs index 03762b7d1..a2ea01dfe 100644 --- a/src/Html/HtmlProvider.fs +++ b/src/Html/HtmlProvider.fs @@ -14,16 +14,22 @@ open FSharp.Data.Runtime.BaseTypes #nowarn "10001" [] -type public HtmlProvider(cfg:TypeProviderConfig) as this = - inherit DisposableTypeProviderForNamespaces(cfg, assemblyReplacementMap=[ "FSharp.Data.DesignTime", "FSharp.Data" ]) - +type public HtmlProvider(cfg: TypeProviderConfig) as this = + inherit DisposableTypeProviderForNamespaces + ( + cfg, + assemblyReplacementMap = [ "FSharp.Data.DesignTime", "FSharp.Data" ] + ) + // Generate namespace and type 'FSharp.Data.HtmlProvider' do AssemblyResolver.init () let asm = System.Reflection.Assembly.GetExecutingAssembly() let ns = "FSharp.Data" - let htmlProvTy = ProvidedTypeDefinition(asm, ns, "HtmlProvider", None, hideObjectMethods=true, nonNullable=true) - - let buildTypes (typeName:string) (args:obj[]) = + + let htmlProvTy = + ProvidedTypeDefinition(asm, ns, "HtmlProvider", None, hideObjectMethods = true, nonNullable = true) + + let buildTypes (typeName: string) (args: obj[]) = let sample = args.[0] :?> string let preferOptionals = args.[1] :?> bool @@ -34,19 +40,21 @@ type public HtmlProvider(cfg:TypeProviderConfig) as this = let resolutionFolder = args.[6] :?> string let resource = args.[7] :?> string - let getSpec _ value = + let getSpec _ value = - let doc = + let doc = use _holder = IO.logTime "Parsing" sample HtmlDocument.Parse value let htmlType = use _holder = IO.logTime "Inference" sample - let inferenceParameters : HtmlInference.Parameters = + + let inferenceParameters: HtmlInference.Parameters = { MissingValues = TextRuntime.GetMissingValues missingValuesStr CultureInfo = TextRuntime.GetCulture cultureStr UnitsOfMeasureProvider = ProviderHelpers.unitsOfMeasureProvider - PreferOptionals = preferOptionals } + PreferOptionals = preferOptionals } + doc |> HtmlRuntime.getHtmlObjects (Some inferenceParameters) includeLayoutTables |> HtmlGenerator.generateTypes asm ns typeName (inferenceParameters, missingValuesStr, cultureStr) @@ -55,39 +63,40 @@ type public HtmlProvider(cfg:TypeProviderConfig) as this = { GeneratedType = htmlType RepresentationType = htmlType - CreateFromTextReader = fun reader -> <@@ HtmlDocument.Create(includeLayoutTables, %reader) @@> + CreateFromTextReader = fun reader -> <@@ HtmlDocument.Create(includeLayoutTables, %reader) @@> CreateListFromTextReader = None CreateFromTextReaderForSampleList = fun _ -> failwith "Not Applicable" - CreateFromValue = None - } + CreateFromValue = 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 = - [ ProvidedStaticParameter("Sample", typeof, parameterDefaultValue = "") + // Add static parameter that specifies the API we want to get (compile-time) + let parameters = + [ ProvidedStaticParameter("Sample", typeof, parameterDefaultValue = "") ProvidedStaticParameter("PreferOptionals", typeof, parameterDefaultValue = false) ProvidedStaticParameter("IncludeLayoutTables", typeof, parameterDefaultValue = false) ProvidedStaticParameter("MissingValues", typeof, parameterDefaultValue = "") ProvidedStaticParameter("Culture", typeof, parameterDefaultValue = "") - ProvidedStaticParameter("Encoding", typeof, parameterDefaultValue = "") - ProvidedStaticParameter("ResolutionFolder", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("Encoding", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("ResolutionFolder", typeof, parameterDefaultValue = "") ProvidedStaticParameter("EmbeddedResource", typeof, parameterDefaultValue = "") ] - - let helpText = + + let helpText = """Typed representation of an HTML file. Location of an HTML sample file or a string containing a sample HTML document. When set to true, inference will prefer to use the option type instead of nullable types, double.NaN or "" for missing values. Defaults to false. Includes tables that are potentially layout tables (with cellpadding=0 and cellspacing=0 attributes) - The set of strings recogized as missing values. Defaults to """ + String.Join(",", TextConversions.DefaultMissingValues) + """. + The set of strings recogized as missing values. Defaults to """ + + String.Join(",", TextConversions.DefaultMissingValues) + + """. The culture used for parsing numbers and dates. Defaults to the invariant culture. 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.""" - + do htmlProvTy.AddXmlDoc helpText do htmlProvTy.DefineStaticParameters(parameters, buildTypes) - + // Register the main type with F# compiler do this.AddNamespace(ns, [ htmlProvTy ]) diff --git a/src/Html/HtmlRuntime.fs b/src/Html/HtmlRuntime.fs index aa97a1b00..b065729c4 100644 --- a/src/Html/HtmlRuntime.fs +++ b/src/Html/HtmlRuntime.fs @@ -18,69 +18,80 @@ open FSharp.Data.Runtime.StructuralTypes /// /// Contains the types used by FSharp.Data type providers at runtime. /// -type HtmlTableCell = +type HtmlTableCell = | Cell of bool * string | Empty member x.IsHeader = match x with | Empty -> true - | Cell(h, _) -> h - member x.Data = + | Cell (h, _) -> h + + member x.Data = match x with | Empty -> "" - | Cell(_, d) -> d + | Cell (_, d) -> d /// Representation of an HTML table cell -type HtmlTable = - { Name : string - HeaderNamesAndUnits : (string * Type option)[] option // always set at designtime, never at runtime - InferedProperties : PrimitiveInferedProperty list option // sometimes set at designtime, never at runtime +type HtmlTable = + { Name: string + HeaderNamesAndUnits: (string * Type option)[] option // always set at designtime, never at runtime + InferedProperties: PrimitiveInferedProperty list option // sometimes set at designtime, never at runtime HasHeaders: bool option // always set at designtime, never at runtime - Rows : string [] [] - Html : HtmlNode } + Rows: string[][] + Html: HtmlNode } override x.ToString() = let sb = StringBuilder() sb.AppendLine x.Name |> ignore let data = array2D x.Rows let rows = data.GetLength(0) let columns = data.GetLength(1) - let widths = Array.zeroCreate columns - data |> Array2D.iteri (fun _ c cell -> - widths.[c] <- max (widths.[c]) (cell.Length)) + let widths = Array.zeroCreate columns + + data + |> Array2D.iteri (fun _ c cell -> widths.[c] <- max (widths.[c]) (cell.Length)) + for r in 0 .. rows - 1 do for c in 0 .. columns - 1 do - sb.Append(data.[r,c].PadRight(widths.[c] + 1)) |> ignore + sb.Append(data.[r, c].PadRight(widths.[c] + 1)) + |> ignore + sb.AppendLine() |> ignore + sb.ToString() /// Representation of an HTML list -type HtmlList = - { Name : string - Values : string[] - Html : HtmlNode } - override x.ToString() = +type HtmlList = + { Name: string + Values: string[] + Html: HtmlNode } + override x.ToString() = let sb = StringBuilder() sb.AppendLine x.Name |> ignore - for value in x.Values do + + for value in x.Values do sb.AppendLine value |> ignore + sb.ToString() /// Representation of an HTML definition list -type HtmlDefinitionList = - { Name : string - Definitions : HtmlList list - Html : HtmlNode } - override x.ToString() = +type HtmlDefinitionList = + { Name: string + Definitions: HtmlList list + Html: HtmlNode } + override x.ToString() = let sb = StringBuilder() sb.AppendLine x.Name |> ignore - for list in x.Definitions do + + for list in x.Definitions do sb.AppendLine list.Name |> ignore - for value in list.Values do + + for value in list.Values do sb.AppendLine value |> ignore + sb.ToString() /// Representation of an HTML table, list, or definition list -type HtmlObject = +type HtmlObject = | Table of HtmlTable | List of HtmlList | DefinitionList of HtmlDefinitionList @@ -94,257 +105,363 @@ type HtmlObject = /// Helper functions called from the generated code for working with HTML tables module HtmlRuntime = - - let private normalizeWs (str:String) = - HtmlParser.wsRegex.Value.Replace(str.Replace('–', '-'), " ").Replace("[edit]", null).Trim() - let private getName defaultName (element:HtmlNode) (parents:HtmlNode list) = + let private normalizeWs (str: String) = + HtmlParser + .wsRegex + .Value + .Replace(str.Replace('–', '-'), " ") + .Replace("[edit]", null) + .Trim() + + let private getName defaultName (element: HtmlNode) (parents: HtmlNode list) = let parents = parents |> Seq.truncate 2 |> Seq.toList let tryGetName choices = choices - |> List.tryPick (fun attrName -> - element + |> List.tryPick (fun attrName -> + element |> HtmlNode.tryGetAttribute attrName - |> Option.map HtmlAttribute.value - ) + |> Option.map HtmlAttribute.value) - let rec tryFindPrevious f (x:HtmlNode) (parents:HtmlNode list)= + let rec tryFindPrevious f (x: HtmlNode) (parents: HtmlNode list) = match parents with - | p::rest -> - let nearest = + | p :: rest -> + let nearest = p |> HtmlNode.descendants true (fun _ -> true) - |> Seq.takeWhile ((<>) x) + |> Seq.takeWhile ((<>) x) |> Seq.filter f |> Seq.toList |> List.rev + match nearest with | [] -> tryFindPrevious f p rest - | h :: _ -> Some h + | h :: _ -> Some h | [] -> None - let deriveFromSibling element parents = - let isHeading s = s |> HtmlNode.name |> HtmlParser.headingRegex.Value.IsMatch + let deriveFromSibling element parents = + let isHeading s = + s + |> HtmlNode.name + |> HtmlParser.headingRegex.Value.IsMatch + tryFindPrevious isHeading element parents match deriveFromSibling element parents with - | Some e -> + | Some e -> let innerText = e.InnerText() - if String.IsNullOrWhiteSpace(innerText) - then defaultName - else normalizeWs innerText + + if String.IsNullOrWhiteSpace(innerText) then + defaultName + else + normalizeWs innerText | _ -> - match List.ofSeq <| element.Descendants("caption", false) with - | [] -> - match tryGetName ["id"; "name"; "title"; "summary"] with - | Some name -> normalizeWs name - | _ -> defaultName - | h :: _ -> h.InnerText() - + match + List.ofSeq + <| element.Descendants("caption", false) + with + | [] -> + match tryGetName [ "id"; "name"; "title"; "summary" ] with + | Some name -> normalizeWs name + | _ -> defaultName + | h :: _ -> h.InnerText() + module private Array = - + let countWhile predicate array = let mutable i = 0 + while i < Array.length array && predicate array.[i] do - i <- i + 1 + i <- i + 1 + i let private innerTextExcluding' recurse exclusions n = let exclusions = "style" :: "script" :: exclusions - let isAriaHidden (n:HtmlNode) = + + let isAriaHidden (n: HtmlNode) = match n.TryGetAttribute "aria-hidden" with | Some a -> match bool.TryParse(a.Value()) with | true, v -> v | false, _ -> false | None -> false + let rec innerText' inRoot n = - let exclusions = if inRoot then ["style"; "script"] else exclusions + let exclusions = if inRoot then [ "style"; "script" ] else exclusions + match n with - | HtmlElement(name, _, content) when List.forall ((<>) name) exclusions && not (isAriaHidden n) -> - seq { for e in content do + | HtmlElement (name, _, content) when + List.forall ((<>) name) exclusions + && not (isAriaHidden n) + -> + seq { + for e in content do match e with - | HtmlText(text) -> yield text - | HtmlComment(_) -> yield "" - | elem -> - if recurse then - yield innerText' false elem - else - yield "" } + | HtmlText (text) -> yield text + | HtmlComment (_) -> yield "" + | elem -> if recurse then yield innerText' false elem else yield "" + } |> String.Concat - | HtmlText(text) -> text + | HtmlText (text) -> text | _ -> "" + innerText' true n - let private innerTextExcluding exclusions n = - innerTextExcluding' true exclusions n + let private innerTextExcluding exclusions n = innerTextExcluding' true exclusions n + + let private parseTable + inferenceParameters + includeLayoutTables + makeUnique + index + (table: HtmlNode, parents: HtmlNode list) + = + let rowSpan cell = + max 1 (defaultArg (TextConversions.AsInteger CultureInfo.InvariantCulture cell?rowspan) 0) - let private parseTable inferenceParameters includeLayoutTables makeUnique index (table:HtmlNode, parents:HtmlNode list) = - let rowSpan cell = - max 1 (defaultArg (TextConversions.AsInteger CultureInfo.InvariantCulture cell?rowspan) 0) - let colSpan cell = + let colSpan cell = max 1 (defaultArg (TextConversions.AsInteger CultureInfo.InvariantCulture cell?colspan) 0) + let rows = let header = match table.Descendants("thead", false) |> Seq.toList with | [ head ] -> // if we have a tr in here, do nothing - we get all trs next anyway - match head.Descendants("tr" ,false) |> Seq.toList with + match head.Descendants("tr", false) |> Seq.toList with | [] -> [ head ] | _ -> [] | _ -> [] - header @ (table.Descendants("tr", false) |> List.ofSeq) - |> List.mapi (fun i r -> i,r) - - if rows.Length <= 1 then None else - - let cells = rows |> List.map (fun (_,r) -> r.Elements ["td"; "th"] |> List.mapi (fun i e -> i, e)) - let rowLengths = cells |> List.map (fun row -> row |> List.map (fun (_, col) -> colSpan col ) |> List.fold (+) 0) - let numberOfColumns = List.max rowLengths - - if not includeLayoutTables && (numberOfColumns < 1) then None else - - let name = makeUnique (getName (sprintf "Table%d" (index + 1)) table parents) - - let res = Array.init rows.Length (fun _ -> Array.init numberOfColumns (fun _ -> Empty)) - for rowindex, _ in rows do - for colindex, cell in cells.[rowindex] do - let data = - let getContents contents = - contents |> List.map (innerTextExcluding ["table"; "ul"; "ol"; "dl"; "sup"; "sub"]) |> String.Concat |> normalizeWs - match cell with - | HtmlElement("td", _, contents) -> Cell (false, getContents contents) - | HtmlElement("th", _, contents) -> Cell (true, getContents contents) - | _ -> Empty - let col_i = ref colindex - while !col_i < res.[rowindex].Length && res.[rowindex].[!col_i] <> Empty do incr(col_i) - for j in [!col_i..(!col_i + colSpan cell - 1)] do - for i in [rowindex..(rowindex + rowSpan cell - 1)] do - if i < rows.Length && j < numberOfColumns - then res.[i].[j] <- data - - let numberOfHeaderRows = res |> Array.countWhile (Array.forall (fun cell -> cell.IsHeader)) - - let hasRealHeaders, res = - match numberOfHeaderRows with - | 0 -> false, res - | 1 -> true, res - | _ -> - for i = 1 to numberOfHeaderRows - 1 do - for j = 0 to numberOfColumns - 1 do - let previousCell = res.[i-1].[j] - let thisCell = res.[i].[j] - if previousCell.Data <> "" && thisCell.Data <> "" && thisCell.Data <> previousCell.Data then - res.[i].[j] <- Cell(true, previousCell.Data + " - " + thisCell.Data) - - true, res.[numberOfHeaderRows-1..] - - let hasHeaders, headerNamesAndUnits, inferedProperties = - match inferenceParameters with - | None -> None, None, None - | Some inferenceParameters -> - let hasHeaders, headerNames, units, inferedProperties = - if hasRealHeaders then - true, res.[0] |> Array.map (fun x -> x.Data) |> Some, None, None - else - res - |> Array.map (Array.map (fun x -> x.Data)) - |> HtmlInference.inferHeaders inferenceParameters - - // headers and units may already be parsed in inferHeaders - let headerNamesAndUnits = - match headerNames, units with - | Some headerNames, Some units -> Array.zip headerNames units - | _, _ -> CsvInference.parseHeaders headerNames numberOfColumns "" inferenceParameters.UnitsOfMeasureProvider |> fst - - Some hasHeaders, Some headerNamesAndUnits, inferedProperties - - let rows = res |> Array.map (Array.map (fun x -> x.Data)) - - { Name = name - HeaderNamesAndUnits = headerNamesAndUnits - InferedProperties = inferedProperties - HasHeaders = hasHeaders - Rows = rows - Html = table } |> Some - - let private parseList makeUnique index (list:HtmlNode, parents:HtmlNode list) = - - let rows = + + header + @ (table.Descendants("tr", false) |> List.ofSeq) + |> List.mapi (fun i r -> i, r) + + if rows.Length <= 1 then + None + else + + let cells = + rows + |> List.map (fun (_, r) -> + r.Elements [ "td"; "th" ] + |> List.mapi (fun i e -> i, e)) + + let rowLengths = + cells + |> List.map (fun row -> + row + |> List.map (fun (_, col) -> colSpan col) + |> List.fold (+) 0) + + let numberOfColumns = List.max rowLengths + + if not includeLayoutTables && (numberOfColumns < 1) then + None + else + + let name = makeUnique (getName (sprintf "Table%d" (index + 1)) table parents) + + let res = + Array.init rows.Length (fun _ -> Array.init numberOfColumns (fun _ -> Empty)) + + for rowindex, _ in rows do + for colindex, cell in cells.[rowindex] do + let data = + let getContents contents = + contents + |> List.map ( + innerTextExcluding + [ "table" + "ul" + "ol" + "dl" + "sup" + "sub" ] + ) + |> String.Concat + |> normalizeWs + + match cell with + | HtmlElement ("td", _, contents) -> Cell(false, getContents contents) + | HtmlElement ("th", _, contents) -> Cell(true, getContents contents) + | _ -> Empty + + let col_i = ref colindex + + while !col_i < res.[rowindex].Length + && res.[rowindex].[!col_i] <> Empty do + incr (col_i) + + for j in [ !col_i .. (!col_i + colSpan cell - 1) ] do + for i in [ rowindex .. (rowindex + rowSpan cell - 1) ] do + if i < rows.Length && j < numberOfColumns then + res.[i].[j] <- data + + let numberOfHeaderRows = + res + |> Array.countWhile (Array.forall (fun cell -> cell.IsHeader)) + + let hasRealHeaders, res = + match numberOfHeaderRows with + | 0 -> false, res + | 1 -> true, res + | _ -> + for i = 1 to numberOfHeaderRows - 1 do + for j = 0 to numberOfColumns - 1 do + let previousCell = res.[i - 1].[j] + let thisCell = res.[i].[j] + + if previousCell.Data <> "" + && thisCell.Data <> "" + && thisCell.Data <> previousCell.Data then + res.[i].[j] <- Cell(true, previousCell.Data + " - " + thisCell.Data) + + true, res.[numberOfHeaderRows - 1 ..] + + let hasHeaders, headerNamesAndUnits, inferedProperties = + match inferenceParameters with + | None -> None, None, None + | Some inferenceParameters -> + let hasHeaders, headerNames, units, inferedProperties = + if hasRealHeaders then + true, res.[0] |> Array.map (fun x -> x.Data) |> Some, None, None + else + res + |> Array.map (Array.map (fun x -> x.Data)) + |> HtmlInference.inferHeaders inferenceParameters + + // headers and units may already be parsed in inferHeaders + let headerNamesAndUnits = + match headerNames, units with + | Some headerNames, Some units -> Array.zip headerNames units + | _, _ -> + CsvInference.parseHeaders + headerNames + numberOfColumns + "" + inferenceParameters.UnitsOfMeasureProvider + |> fst + + Some hasHeaders, Some headerNamesAndUnits, inferedProperties + + let rows = res |> Array.map (Array.map (fun x -> x.Data)) + + { Name = name + HeaderNamesAndUnits = headerNamesAndUnits + InferedProperties = inferedProperties + HasHeaders = hasHeaders + Rows = rows + Html = table } + |> Some + + let private parseList makeUnique index (list: HtmlNode, parents: HtmlNode list) = + + let rows = list.Descendants("li", true) - |> Seq.map (innerTextExcluding ["table"; "ul"; "ol"; "dl"; "sup"; "sub"] >> normalizeWs) + |> Seq.map ( + innerTextExcluding + [ "table" + "ul" + "ol" + "dl" + "sup" + "sub" ] + >> normalizeWs + ) |> Seq.toArray - - if rows.Length <= 1 then None else - let name = makeUnique (getName (sprintf "List%d" (index + 1)) list parents) + if rows.Length <= 1 then + None + else + + let name = makeUnique (getName (sprintf "List%d" (index + 1)) list parents) + + { Name = name + Values = rows + Html = list } + |> Some - { Name = name - Values = rows - Html = list } |> Some + let private parseDefinitionList makeUnique index (definitionList: HtmlNode, parents: HtmlNode list) = - let private parseDefinitionList makeUnique index (definitionList:HtmlNode, parents:HtmlNode list) = - - let rec createDefinitionGroups (nodes:HtmlNode list) = - let rec loop state ((groupName, _, elements) as currentGroup) (nodes:HtmlNode list) = + let rec createDefinitionGroups (nodes: HtmlNode list) = + let rec loop state ((groupName, _, elements) as currentGroup) (nodes: HtmlNode list) = match nodes with | [] -> (currentGroup :: state) |> List.rev - | h::t when HtmlNode.name h = "dt" -> + | h :: t when HtmlNode.name h = "dt" -> loop (currentGroup :: state) (NameUtils.nicePascalName (HtmlNode.innerText h), h, []) t - | h::t -> - loop state (groupName, h, ((HtmlNode.innerText h) :: elements)) t + | h :: t -> loop state (groupName, h, ((HtmlNode.innerText h) :: elements)) t + match nodes with | [] -> [] | h :: t when HtmlNode.name h = "dt" -> loop [] (NameUtils.nicePascalName (HtmlNode.innerText h), h, []) t - | h :: t -> loop [] ("Undefined", h, []) t - + | h :: t -> loop [] ("Undefined", h, []) t + let data = definitionList - |> HtmlNode.descendantsNamed false ["dt"; "dd"] + |> HtmlNode.descendantsNamed false [ "dt"; "dd" ] |> List.ofSeq |> createDefinitionGroups - |> List.map (fun (group, node, values) -> { Name = group - Values = values |> List.rev |> List.toArray - Html = node }) + |> List.map (fun (group, node, values) -> + { Name = group + Values = values |> List.rev |> List.toArray + Html = node }) - if data.Length <= 1 then None else + if data.Length <= 1 then + None + else - let name = makeUnique (getName (sprintf "DefinitionList%d" (index + 1)) definitionList parents) - - { Name = name - Definitions = data - Html = definitionList } |> Some + let name = + makeUnique (getName (sprintf "DefinitionList%d" (index + 1)) definitionList parents) - let getTables inferenceParameters includeLayoutTables (doc:HtmlDocument) = + { Name = name + Definitions = data + Html = definitionList } + |> Some + + let getTables inferenceParameters includeLayoutTables (doc: HtmlDocument) = let tableElements = doc.DescendantsWithPath "table" |> List.ofSeq - let tableElements = - if includeLayoutTables - then tableElements - else tableElements |> List.filter (fun (e, _) -> not (e.HasAttribute("cellspacing", "0") && e.HasAttribute("cellpadding", "0"))) + + let tableElements = + if includeLayoutTables then + tableElements + else + tableElements + |> List.filter (fun (e, _) -> + not ( + e.HasAttribute("cellspacing", "0") + && e.HasAttribute("cellpadding", "0") + )) + tableElements |> List.mapi (parseTable inferenceParameters includeLayoutTables (NameUtils.uniqueGenerator id)) |> List.choose id - let getLists (doc:HtmlDocument) = + let getLists (doc: HtmlDocument) = doc - |> HtmlDocument.descendantsNamedWithPath false ["ol"; "ul"] + |> HtmlDocument.descendantsNamedWithPath false [ "ol"; "ul" ] |> List.ofSeq |> List.mapi (parseList (NameUtils.uniqueGenerator id)) |> List.choose id - let getDefinitionLists (doc:HtmlDocument) = + let getDefinitionLists (doc: HtmlDocument) = doc - |> HtmlDocument.descendantsNamedWithPath false ["dl"] + |> HtmlDocument.descendantsNamedWithPath false [ "dl" ] |> List.ofSeq |> List.mapi (parseDefinitionList (NameUtils.uniqueGenerator id)) |> List.choose id - let getHtmlObjects inferenceParameters includeLayoutTables (doc:HtmlDocument) = - Seq.concat [doc |> getTables inferenceParameters includeLayoutTables |> List.map Table - doc |> getLists |> List.map List - doc |> getDefinitionLists |> List.map DefinitionList] + let getHtmlObjects inferenceParameters includeLayoutTables (doc: HtmlDocument) = + Seq.concat + [ doc + |> getTables inferenceParameters includeLayoutTables + |> List.map Table + doc |> getLists |> List.map List + doc + |> getDefinitionLists + |> List.map DefinitionList ] // -------------------------------------------------------------------------------------- @@ -363,48 +480,59 @@ type HtmlDocument internal (doc, tables, lists, definitionLists) = /// [] - [] - static member Create(includeLayoutTables, reader:TextReader) = - let doc = - reader - |> HtmlDocument.Load - let tables = + [] + static member Create(includeLayoutTables, reader: TextReader) = + let doc = reader |> HtmlDocument.Load + + let tables = doc |> HtmlRuntime.getTables None includeLayoutTables - |> List.map (fun e -> e.Name, e) + |> List.map (fun e -> e.Name, e) |> Map.ofList - let lists = + + let lists = doc |> HtmlRuntime.getLists - |> List.map (fun e -> e.Name, e) - |> Map.ofList - let definitionLists = + |> List.map (fun e -> e.Name, e) + |> Map.ofList + + let definitionLists = doc |> HtmlRuntime.getDefinitionLists - |> List.map (fun e -> e.Name, e) - |> Map.ofList + |> List.map (fun e -> e.Name, e) + |> Map.ofList + HtmlDocument(doc, tables, lists, definitionLists) /// [] - [] - member __.GetTable(id:string) = - tables |> Map.find id + [] + member __.GetTable(id: string) = tables |> Map.find id /// [] - [] - member __.GetList(id:string) = - lists |> Map.find id + [] + member __.GetList(id: string) = lists |> Map.find id /// [] - [] - member __.GetDefinitionList(id:string) = - definitionLists |> Map.find id + [] + member __.GetDefinitionList(id: string) = definitionLists |> Map.find id /// Underlying representation of table types generated by HtmlProvider -type HtmlTable<'RowType> internal (name:string, headers:string[] option, values:'RowType[], html:HtmlNode) = +type HtmlTable<'RowType> internal (name: string, headers: string[] option, values: 'RowType[], html: HtmlNode) = member __.Name = name member __.Headers = headers @@ -413,32 +541,43 @@ type HtmlTable<'RowType> internal (name:string, headers:string[] option, values: /// [] - [] - static member Create(rowConverter:Func, doc:HtmlDocument, id:string, hasHeaders:bool) = + [] + static member Create(rowConverter: Func, doc: HtmlDocument, id: string, hasHeaders: bool) = let table = doc.GetTable id - let headers, rows = + + let headers, rows = if hasHeaders then Some table.Rows.[0], table.Rows.[1..] else None, table.Rows + HtmlTable<_>(table.Name, headers, Array.map rowConverter.Invoke rows, table.Html) /// Underlying representation of list types generated by HtmlProvider -type HtmlList<'ItemType> internal (name:string, values:'ItemType[], html) = - +type HtmlList<'ItemType> internal (name: string, values: 'ItemType[], html) = + member __.Name = name member __.Values = values member __.Html = html [] - [] - static member Create(rowConverter:Func, doc:HtmlDocument, id:string) = + [] + static member Create(rowConverter: Func, doc: HtmlDocument, id: string) = let list = doc.GetList id HtmlList<_>(list.Name, Array.map rowConverter.Invoke list.Values, list.Html) [] - [] - static member CreateNested(rowConverter:Func, doc:HtmlDocument, id:string, index:int) = + [] + static member CreateNested(rowConverter: Func, doc: HtmlDocument, id: string, index: int) = let definitionList = doc.GetDefinitionList id let list = definitionList.Definitions.[index] HtmlList<_>(list.Name, Array.map rowConverter.Invoke list.Values, list.Html) diff --git a/src/Json/JsonConversions.fs b/src/Json/JsonConversions.fs index 0644deb7f..94d16e684 100644 --- a/src/Json/JsonConversions.fs +++ b/src/Json/JsonConversions.fs @@ -9,64 +9,94 @@ open FSharp.Data [] module private Helpers = - 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 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 /// Conversions from JsonValue to string/int/int64/decimal/float/boolean/datetime/datetimeoffset/timespan/guid options type JsonConversions = - static member AsString useNoneForNullOrEmpty (cultureInfo:IFormatProvider) = function - | JsonValue.String s -> if useNoneForNullOrEmpty && String.IsNullOrEmpty s then None else Some s - | JsonValue.Boolean b -> Some (if b then "true" else "false") - | JsonValue.Number n -> n.ToString(cultureInfo) |> Some - | JsonValue.Float f -> f.ToString(cultureInfo) |> Some - | JsonValue.Null when not useNoneForNullOrEmpty -> Some "" - | _ -> None + static member AsString useNoneForNullOrEmpty (cultureInfo: IFormatProvider) = + function + | JsonValue.String s -> + if useNoneForNullOrEmpty && String.IsNullOrEmpty s then + None + else + Some s + | JsonValue.Boolean b -> Some(if b then "true" else "false") + | JsonValue.Number n -> n.ToString(cultureInfo) |> Some + | JsonValue.Float f -> f.ToString(cultureInfo) |> Some + | JsonValue.Null when not useNoneForNullOrEmpty -> Some "" + | _ -> None - static member AsInteger cultureInfo = function - | JsonValue.Number n when inRangeDecimal Int32.MinValue Int32.MaxValue n && isIntegerDecimal n -> Some (int n) - | JsonValue.Float f when inRangeFloat Int32.MinValue Int32.MaxValue f && isIntegerFloat f -> Some (int f) - | JsonValue.String s -> TextConversions.AsInteger cultureInfo s - | _ -> None + static member AsInteger cultureInfo = + function + | JsonValue.Number n when + inRangeDecimal Int32.MinValue Int32.MaxValue n + && isIntegerDecimal n + -> + Some(int n) + | JsonValue.Float f when + inRangeFloat Int32.MinValue Int32.MaxValue f + && isIntegerFloat f + -> + Some(int f) + | JsonValue.String s -> TextConversions.AsInteger cultureInfo s + | _ -> None - static member AsInteger64 cultureInfo = function - | JsonValue.Number n when inRangeDecimal Int64.MinValue Int64.MaxValue n && isIntegerDecimal n -> Some (int64 n) - | JsonValue.Float f when inRangeFloat Int64.MinValue Int64.MaxValue f && isIntegerFloat f -> Some (int64 f) - | JsonValue.String s -> TextConversions.AsInteger64 cultureInfo s - | _ -> None + static member AsInteger64 cultureInfo = + function + | JsonValue.Number n when + inRangeDecimal Int64.MinValue Int64.MaxValue n + && isIntegerDecimal n + -> + Some(int64 n) + | JsonValue.Float f when + inRangeFloat Int64.MinValue Int64.MaxValue f + && isIntegerFloat f + -> + Some(int64 f) + | JsonValue.String s -> TextConversions.AsInteger64 cultureInfo s + | _ -> None - static member AsDecimal cultureInfo = function - | JsonValue.Number n -> Some n - | JsonValue.String s -> TextConversions.AsDecimal cultureInfo s - | _ -> None + static member AsDecimal cultureInfo = + function + | JsonValue.Number n -> Some n + | JsonValue.String s -> TextConversions.AsDecimal cultureInfo s + | _ -> None - static member AsFloat missingValues useNoneForMissingValues cultureInfo = function - | JsonValue.Number n -> Some (float n) - | JsonValue.Float n -> Some n - | JsonValue.String s -> TextConversions.AsFloat missingValues useNoneForMissingValues cultureInfo s - | _ -> None + static member AsFloat missingValues useNoneForMissingValues cultureInfo = + function + | JsonValue.Number n -> Some(float n) + | JsonValue.Float n -> Some n + | JsonValue.String s -> TextConversions.AsFloat missingValues useNoneForMissingValues cultureInfo s + | _ -> None - static member AsBoolean = function - | JsonValue.Boolean b -> Some b - | JsonValue.Number 1M -> Some true - | JsonValue.Number 0M -> Some false - | JsonValue.String s -> TextConversions.AsBoolean s - | _ -> None + static member AsBoolean = + function + | JsonValue.Boolean b -> Some b + | JsonValue.Number 1M -> Some true + | JsonValue.Number 0M -> Some false + | JsonValue.String s -> TextConversions.AsBoolean s + | _ -> None - static member AsDateTimeOffset cultureInfo = function - | JsonValue.String s -> TextConversions.AsDateTimeOffset cultureInfo s - | _ -> None - - static member AsDateTime cultureInfo = function - | JsonValue.String s -> TextConversions.AsDateTime cultureInfo s - | _ -> None + static member AsDateTimeOffset cultureInfo = + function + | JsonValue.String s -> TextConversions.AsDateTimeOffset cultureInfo s + | _ -> None - static member AsTimeSpan cultureInfo = function - | JsonValue.String s -> TextConversions.AsTimeSpan cultureInfo s - | _ -> None + static member AsDateTime cultureInfo = + function + | JsonValue.String s -> TextConversions.AsDateTime cultureInfo s + | _ -> None - static member AsGuid = function - | JsonValue.String s -> TextConversions.AsGuid s - | _ -> None + static member AsTimeSpan cultureInfo = + function + | JsonValue.String s -> TextConversions.AsTimeSpan cultureInfo s + | _ -> None + + static member AsGuid = + function + | JsonValue.String s -> TextConversions.AsGuid s + | _ -> None diff --git a/src/Json/JsonConversionsGenerator.fs b/src/Json/JsonConversionsGenerator.fs index f49660a6e..6656ec389 100644 --- a/src/Json/JsonConversionsGenerator.fs +++ b/src/Json/JsonConversionsGenerator.fs @@ -15,74 +15,95 @@ open ProviderImplementation.QuotationBuilder #nowarn "10001" -let getConversionQuotation missingValuesStr cultureStr typ (value:Expr) = - if typ = typeof then <@@ JsonRuntime.ConvertString(cultureStr, %value) @@> - elif typ = typeof || typ = typeof || typ = typeof then <@@ JsonRuntime.ConvertInteger(cultureStr, %value) @@> - elif typ = typeof then <@@ JsonRuntime.ConvertInteger64(cultureStr, %value) @@> - elif typ = typeof then <@@ JsonRuntime.ConvertDecimal(cultureStr, %value) @@> - elif typ = typeof then <@@ JsonRuntime.ConvertFloat(cultureStr, missingValuesStr, %value) @@> - elif typ = typeof || typ = typeof then <@@ JsonRuntime.ConvertBoolean(%value) @@> - elif typ = typeof then <@@ JsonRuntime.ConvertDateTimeOffset(cultureStr, %value) @@> - elif typ = typeof then <@@ JsonRuntime.ConvertDateTime(cultureStr, %value) @@> - elif typ = typeof then <@@ JsonRuntime.ConvertTimeSpan(cultureStr, %value) @@> - elif typ = typeof then <@@ JsonRuntime.ConvertGuid(%value) @@> - else failwith "getConversionQuotation: Unsupported primitive type" +let getConversionQuotation missingValuesStr cultureStr typ (value: Expr) = + if typ = typeof then + <@@ JsonRuntime.ConvertString(cultureStr, %value) @@> + elif typ = typeof + || typ = typeof + || typ = typeof then + <@@ JsonRuntime.ConvertInteger(cultureStr, %value) @@> + elif typ = typeof then + <@@ JsonRuntime.ConvertInteger64(cultureStr, %value) @@> + elif typ = typeof then + <@@ JsonRuntime.ConvertDecimal(cultureStr, %value) @@> + elif typ = typeof then + <@@ JsonRuntime.ConvertFloat(cultureStr, missingValuesStr, %value) @@> + elif typ = typeof || typ = typeof then + <@@ JsonRuntime.ConvertBoolean(%value) @@> + elif typ = typeof then + <@@ JsonRuntime.ConvertDateTimeOffset(cultureStr, %value) @@> + elif typ = typeof then + <@@ JsonRuntime.ConvertDateTime(cultureStr, %value) @@> + elif typ = typeof then + <@@ JsonRuntime.ConvertTimeSpan(cultureStr, %value) @@> + elif typ = typeof then + <@@ JsonRuntime.ConvertGuid(%value) @@> + else + failwith "getConversionQuotation: Unsupported primitive type" -type JsonConversionCallingType = - JsonDocument | JsonValueOption | JsonValueOptionAndPath +type JsonConversionCallingType = + | JsonDocument + | JsonValueOption + | JsonValueOptionAndPath -/// Creates a function that takes Expr and converts it to +/// Creates a function that takes Expr and converts it to /// an expression of other type - the type is specified by `field` -let convertJsonValue missingValuesStr cultureStr canPassAllConversionCallingTypes (field:PrimitiveInferedProperty) = +let convertJsonValue missingValuesStr cultureStr canPassAllConversionCallingTypes (field: PrimitiveInferedProperty) = - assert (field.TypeWithMeasure = field.RuntimeType) - assert (field.Name = "") + assert (field.TypeWithMeasure = field.RuntimeType) + assert (field.Name = "") - let returnType = - match field.TypeWrapper with - | TypeWrapper.None -> field.RuntimeType - | TypeWrapper.Option -> typedefof>.MakeGenericType field.RuntimeType - | TypeWrapper.Nullable -> typedefof>.MakeGenericType field.RuntimeType + let returnType = + match field.TypeWrapper with + | TypeWrapper.None -> field.RuntimeType + | TypeWrapper.Option -> typedefof>.MakeGenericType field.RuntimeType + | TypeWrapper.Nullable -> typedefof>.MakeGenericType field.RuntimeType - let wrapInLetIfNeeded (value:Expr) getBody = - match value with - | Patterns.Var var -> - let varExpr = Expr.Cast<'T> (Expr.Var var) - getBody varExpr - | _ -> - let var = Var("value", typeof<'T>) - let varExpr = Expr.Cast<'T> (Expr.Var var) - Expr.Let(var, value, getBody varExpr) + let wrapInLetIfNeeded (value: Expr) getBody = + match value with + | Patterns.Var var -> + let varExpr = Expr.Cast<'T>(Expr.Var var) + getBody varExpr + | _ -> + let var = Var("value", typeof<'T>) + let varExpr = Expr.Cast<'T>(Expr.Var var) + Expr.Let(var, value, getBody varExpr) - let convert (value:Expr) = - let convert value = - getConversionQuotation missingValuesStr cultureStr field.InferedType value - match field.TypeWrapper, canPassAllConversionCallingTypes with - | TypeWrapper.None, true -> - wrapInLetIfNeeded value (fun (varExpr:Expr) -> - typeof?GetNonOptionalValue (field.RuntimeType) (<@ (%varExpr).Path @>, convert <@ (%varExpr).JsonOpt @>, <@ (%varExpr).JsonOpt @>) - ) - | TypeWrapper.None, false -> - 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 -> - //TODO: not covered in tests - convert <@ Some (%%value:IJsonDocument).JsonValue @> - | TypeWrapper.Nullable, true -> - //TODO: not covered in tests - typeof?OptionToNullable (field.RuntimeType) (convert <@ (%%value:JsonValue option) @>) - | TypeWrapper.Nullable, false -> - //TODO: not covered in tests - typeof?OptionToNullable (field.RuntimeType) (convert <@ Some (%%value:IJsonDocument).JsonValue @>) + let convert (value: Expr) = + let convert value = + getConversionQuotation missingValuesStr cultureStr field.InferedType value - let conversionCallingType = - if canPassAllConversionCallingTypes then - match field.TypeWrapper with - | TypeWrapper.None -> JsonValueOptionAndPath - | TypeWrapper.Option | TypeWrapper.Nullable -> JsonValueOption - else JsonDocument + match field.TypeWrapper, canPassAllConversionCallingTypes with + | TypeWrapper.None, true -> + wrapInLetIfNeeded value (fun (varExpr: Expr) -> + typeof?GetNonOptionalValue + (field.RuntimeType) + (<@ (%varExpr).Path @>, convert <@ (%varExpr).JsonOpt @>, <@ (%varExpr).JsonOpt @>)) + | TypeWrapper.None, false -> + 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 -> + //TODO: not covered in tests + convert <@ Some (%%value: IJsonDocument).JsonValue @> + | TypeWrapper.Nullable, true -> + //TODO: not covered in tests + typeof?OptionToNullable (field.RuntimeType) (convert <@ (%%value: JsonValue option) @>) + | TypeWrapper.Nullable, false -> + //TODO: not covered in tests + typeof?OptionToNullable + (field.RuntimeType) + (convert <@ Some (%%value: IJsonDocument).JsonValue @>) + + let conversionCallingType = + if canPassAllConversionCallingTypes then + match field.TypeWrapper with + | TypeWrapper.None -> JsonValueOptionAndPath + | TypeWrapper.Option + | TypeWrapper.Nullable -> JsonValueOption + else + JsonDocument - returnType, convert, conversionCallingType + returnType, convert, conversionCallingType diff --git a/src/Json/JsonExtensions.fs b/src/Json/JsonExtensions.fs index 53ddfcb6c..027f0265c 100644 --- a/src/Json/JsonExtensions.fs +++ b/src/Json/JsonExtensions.fs @@ -15,372 +15,443 @@ open FSharp.Core [] type JsonExtensions = - /// Get a sequence of key-value pairs representing the properties of an object - [] - static member Properties(x:JsonValue) = - match x with - | JsonValue.Record properties -> properties - | _ -> [| |] - - /// Get property of a JSON object. Fails if the value is not an object - /// or if the property is not present - [] - static member GetProperty(x, propertyName) = - match x with - | JsonValue.Record properties -> - match Array.tryFind (fst >> (=) propertyName) properties with - | Some (_, value) -> value - | None -> failwithf "Didn't find property '%s' in %s" propertyName <| x.ToString(JsonSaveOptions.DisableFormatting) - | _ -> failwithf "Not an object: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Try to get a property of a JSON value. - /// Returns None if the value is not an object or if the property is not present. - [] - static member TryGetProperty(x, propertyName) = - match x with - | JsonValue.Record properties -> - Array.tryFind (fst >> (=) propertyName) properties |> Option.map snd - | _ -> None - - /// Assuming the value is an object, get value with the specified name - [] - static member inline Item(x, propertyName) = JsonExtensions.GetProperty(x, propertyName) - - /// Get all the elements of a JSON value. - /// Returns an empty array if the value is not a JSON array. - [] - static member AsArray(x:JsonValue) = - match x with - | (JsonValue.Array elements) -> elements - | _ -> [| |] - - /// Get all the elements of a JSON value (assuming that the value is an array) - [] - static member inline GetEnumerator(x) = JsonExtensions.AsArray(x).GetEnumerator() - - /// Try to get the value at the specified index, if the value is a JSON array. - [] - static member inline Item(x, index) = JsonExtensions.AsArray(x).[index] - - /// Get the string value of an element (assuming that the value is a scalar) - /// Returns the empty string for JsonValue.Null - [] - static member AsString(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match JsonConversions.AsString false cultureInfo x with - | Some s -> s - | _ -> failwithf "Not a string: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get a number as an integer (assuming that the value fits in integer) - [] - static member AsInteger(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match JsonConversions.AsInteger cultureInfo x with - | Some i -> i - | _ -> failwithf "Not an int: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get a number as a 64-bit integer (assuming that the value fits in 64-bit integer) - [] - static member AsInteger64(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match JsonConversions.AsInteger64 cultureInfo x with - | Some i -> i - | _ -> failwithf "Not an int64: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get a number as a decimal (assuming that the value fits in decimal) - [] - static member AsDecimal(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match JsonConversions.AsDecimal cultureInfo x with - | Some d -> d - | _ -> failwithf "Not a decimal: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get a number as a float (assuming that the value is convertible to a float) - [] - static member AsFloat(x, [] ?cultureInfo, [] ?missingValues) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues - match JsonConversions.AsFloat missingValues false cultureInfo x with - | Some f -> f - | _ -> failwithf "Not a float: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get the boolean value of an element (assuming that the value is a boolean) - [] - static member AsBoolean(x) = - match JsonConversions.AsBoolean x with - | Some b -> b - | _ -> failwithf "Not a boolean: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get the datetime value of an element (assuming that the value is a string - /// containing well-formed ISO date or MSFT JSON date) - [] - static member AsDateTime(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match JsonConversions.AsDateTime cultureInfo x with - | Some d -> d - | _ -> failwithf "Not a datetime: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get the datetime offset value of an element (assuming that the value is a string - /// containing well-formed ISO date time with offset or MSFT JSON datetime with offset) - [] - static member AsDateTimeOffset(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match JsonConversions.AsDateTimeOffset cultureInfo x with - | Some d -> d - | _ -> failwithf "Not a datetime offset: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get the timespan value of an element (assuming that the value is a string - /// containing well-formed time span) - [] - static member AsTimeSpan(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - match JsonConversions.AsTimeSpan cultureInfo x with - | Some t -> t - | _ -> failwithf "Not a time span: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get the guid value of an element (assuming that the value is a guid) - [] - static member AsGuid(x) = - match JsonConversions.AsGuid x with - | Some g -> g - | _ -> failwithf "Not a guid: %s" <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get inner text of an element - [] - static member InnerText(x) = - 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 - let (?) (jsonObject:JsonValue) propertyName = jsonObject.GetProperty(propertyName) - - type JsonValue with - member x.Properties = - match x with - | JsonValue.Record properties -> properties - | _ -> [| |] - -// TODO: needs more consideration -#if ENABLE_JSONEXTENSIONS_OPTIONS - -/// Extension methods that can be used to work with JsonValue in more convenient way. -/// This module also provides the dynamic operator. -module Options = - - open System.Runtime.CompilerServices - - type JsonValue with - /// Get a sequence of key-value pairs representing the properties of an object - member x.Properties = - match x with - | JsonValue.Record properties -> properties - | _ -> [| |] - + [] + static member Properties(x: JsonValue) = + match x with + | JsonValue.Record properties -> properties + | _ -> [||] + + /// Get property of a JSON object. Fails if the value is not an object + /// or if the property is not present + [] + static member GetProperty(x, propertyName) = + match x with + | JsonValue.Record properties -> + match Array.tryFind (fst >> (=) propertyName) properties with + | Some (_, value) -> value + | None -> + failwithf "Didn't find property '%s' in %s" propertyName + <| x.ToString(JsonSaveOptions.DisableFormatting) + | _ -> + failwithf "Not an object: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) + /// Try to get a property of a JSON value. /// Returns None if the value is not an object or if the property is not present. - member x.TryGetProperty(propertyName) = - match x with - | JsonValue.Record properties -> - Array.tryFind (fst >> (=) propertyName) properties |> Option.map snd - | _ -> None - - /// Try to get a property of a JSON value. - /// Returns None if the value is not a JSON object or if the property is not present. - member inline x.Item with get(propertyName) = x.TryGetProperty(propertyName) - + [] + static member TryGetProperty(x, propertyName) = + match x with + | JsonValue.Record properties -> + Array.tryFind (fst >> (=) propertyName) properties + |> Option.map snd + | _ -> None + + /// Assuming the value is an object, get value with the specified name + [] + static member inline Item(x, propertyName) = + JsonExtensions.GetProperty(x, propertyName) + /// Get all the elements of a JSON value. /// Returns an empty array if the value is not a JSON array. - member x.AsArray() = - match x with - | JsonValue.Array elements -> elements - | _ -> [| |] + [] + static member AsArray(x: JsonValue) = + match x with + | (JsonValue.Array elements) -> elements + | _ -> [||] /// Get all the elements of a JSON value (assuming that the value is an array) - member inline x.GetEnumerator() = x.AsArray().GetEnumerator() - + [] + static member inline GetEnumerator(x) = + JsonExtensions.AsArray(x).GetEnumerator() + /// Try to get the value at the specified index, if the value is a JSON array. - member inline x.Item with get(index) = x.AsArray().[index] - + [] + static member inline Item(x, index) = JsonExtensions.AsArray(x).[index] + /// 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 false cultureInfo x - + /// Returns the empty string for JsonValue.Null + [] + static member AsString(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match JsonConversions.AsString false cultureInfo x with + | Some s -> s + | _ -> + failwithf "Not a string: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) + /// Get a number as an integer (assuming that the value fits in integer) - member x.AsInteger(?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - JsonConversions.AsInteger cultureInfo x - + [] + static member AsInteger(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match JsonConversions.AsInteger cultureInfo x with + | Some i -> i + | _ -> + failwithf "Not an int: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) + /// Get a number as a 64-bit integer (assuming that the value fits in 64-bit integer) - member x.AsInteger64(?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - JsonConversions.AsInteger64 cultureInfo x - + [] + static member AsInteger64(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match JsonConversions.AsInteger64 cultureInfo x with + | Some i -> i + | _ -> + failwithf "Not an int64: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) + /// Get a number as a decimal (assuming that the value fits in decimal) - member x.AsDecimal(?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - JsonConversions.AsDecimal cultureInfo x - + [] + static member AsDecimal(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match JsonConversions.AsDecimal cultureInfo x with + | Some d -> d + | _ -> + failwithf "Not a decimal: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) + /// Get a number as a float (assuming that the value is convertible to a float) - member x.AsFloat(?cultureInfo, [] ?missingValues) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues - JsonConversions.AsFloat missingValues true cultureInfo x - + [] + static member AsFloat(x, [] ?cultureInfo, [] ?missingValues) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues + + match JsonConversions.AsFloat missingValues false cultureInfo x with + | Some f -> f + | _ -> + failwithf "Not a float: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) + /// Get the boolean value of an element (assuming that the value is a boolean) - member x.AsBoolean(?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - JsonConversions.AsBoolean cultureInfo x - + [] + static member AsBoolean(x) = + match JsonConversions.AsBoolean x with + | Some b -> b + | _ -> + failwithf "Not a boolean: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) + /// Get the datetime value of an element (assuming that the value is a string /// containing well-formed ISO date or MSFT JSON date) - member x.AsDateTime(?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - JsonConversions.AsDateTime cultureInfo x + [] + static member AsDateTime(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match JsonConversions.AsDateTime cultureInfo x with + | Some d -> d + | _ -> + failwithf "Not a datetime: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) /// Get the datetime offset value of an element (assuming that the value is a string - /// containing well-formed ISO date time with offset) - member x.AsDateTimeOffset(?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - JsonConversions.AsDateTimeOffset cultureInfo x - + /// containing well-formed ISO date time with offset or MSFT JSON datetime with offset) + [] + static member AsDateTimeOffset(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + match JsonConversions.AsDateTimeOffset cultureInfo x with + | Some d -> d + | _ -> + failwithf "Not a datetime offset: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) + /// Get the timespan value of an element (assuming that the value is a string /// containing well-formed time span) - member x.AsTimeSpan(?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - JsonConversions.AsTimeSpan cultureInfo x - - /// Get the guid value of an element (assuming that the value is a guid) - member x.AsGuid() = - JsonConversions.AsGuid x - - /// Get inner text of an element - member x.InnerText = - match x.AsString() with - | Some str -> str - | None -> x.AsArray() |> Array.map (fun e -> e.InnerText) |> String.Concat - - [] - [] - type JsonValueOptionExtensions() = - - /// Get a sequence of key-value pairs representing the properties of an object - [] - static member Properties(x) = - match x with - | Some (json:JsonValue) -> json.Properties - | None -> [| |] - - /// Try to get a property of a JSON value. - /// Returns None if the value is not an object or if the property is not present. - [] - static member TryGetProperty(x, propertyName) = - match x with - | Some (JsonValue.Record properties) -> - Array.tryFind (fst >> (=) propertyName) properties |> Option.map snd - | _ -> None - - /// Try to get a property of a JSON value. - /// Returns None if the value is not a JSON object or if the property is not present. - [] - static member inline Item(x, propertyName) = JsonValueOptionExtensions.TryGetProperty(x, propertyName) - - /// Get all the elements of a JSON value. - /// Returns an empty array if the value is not a JSON array. - [] - static member AsArray(x) = - match x with - | Some (JsonValue.Array elements) -> elements - | _ -> [| |] + [] + static member AsTimeSpan(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - /// Get all the elements of a JSON value (assuming that the value is an array) - [] - static member inline GetEnumerator(x) = JsonValueOptionExtensions.AsArray(x).GetEnumerator() - - /// Try to get the value at the specified index, if the value is a JSON array. - [] - static member inline Item(x, index) = JsonValueOptionExtensions.AsArray(x).[index] - - /// Get the string value of an element (assuming that the value is a scalar) - [] - static member AsString(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - x |> Option.bind (JsonConversions.AsString false cultureInfo) - - /// Get a number as an integer (assuming that the value fits in integer) - [] - static member AsInteger(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - x |> Option.bind (JsonConversions.AsInteger cultureInfo) - - /// Get a number as a 64-bit integer (assuming that the value fits in 64-bit integer) - [] - static member AsInteger64(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - x |> Option.bind (JsonConversions.AsInteger64 cultureInfo) - - /// Get a number as a decimal (assuming that the value fits in decimal) - [] - static member AsDecimal(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - x |> Option.bind (JsonConversions.AsDecimal cultureInfo) - - /// Get a number as a float (assuming that the value is convertible to a float) - [] - static member AsFloat(x, [] ?cultureInfo, [] ?missingValues) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues - x |> Option.bind (JsonConversions.AsFloat missingValues true cultureInfo) - - /// Get the boolean value of an element (assuming that the value is a boolean) - [] - static member AsBoolean(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - x |> Option.bind (JsonConversions.AsBoolean cultureInfo) - - /// Get the datetime value of an element (assuming that the value is a string - /// containing well-formed ISO date or MSFT JSON date) - [] - static member AsDateTime(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - x |> Option.bind (JsonConversions.AsDateTime cultureInfo) + match JsonConversions.AsTimeSpan cultureInfo x with + | Some t -> t + | _ -> + failwithf "Not a time span: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) - /// Get the datetime offset value of an element (assuming that the value is a string - /// containing well-formed ISO date time with offset) - [] - static member AsDateTimeOffset(x, [] ?cultureInfo) = - let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture - x |> Option.bind (JsonConversions.AsDateTimeOffset cultureInfo) - - /// Get the timespan value of an element (assuming that the value is a timespan) - [] - static member AsTimeSpan(x) = - x |> Option.bind JsonConversions.AsTimeSpan - /// Get the guid value of an element (assuming that the value is a guid) - [] + [] static member AsGuid(x) = - x |> Option.bind JsonConversions.AsGuid - + match JsonConversions.AsGuid x with + | Some g -> g + | _ -> + failwithf "Not a guid: %s" + <| x.ToString(JsonSaveOptions.DisableFormatting) + /// Get inner text of an element - [] + [] static member InnerText(x) = - match JsonValueOptionExtensions.AsString(x) with - | Some str -> str - | None -> JsonValueOptionExtensions.AsArray(x) |> Array.map (fun e -> e.InnerText) |> String.Concat - - /// - type JsonValueOverloads = JsonValueOverloads with - static member inline ($) (x:JsonValue , JsonValueOverloads) = fun propertyName -> x.TryGetProperty propertyName - static member inline ($) (x:JsonValue option , JsonValueOverloads) = fun propertyName -> x |> Option.bind (fun x -> x.TryGetProperty propertyName) - - /// Get property of a JSON value (assuming that the value is an object) - let inline (?) x (propertyName:string) = (x $ JsonValueOverloads) propertyName + 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 + let (?) (jsonObject: JsonValue) propertyName = jsonObject.GetProperty(propertyName) + + type JsonValue with + member x.Properties = + match x with + | JsonValue.Record properties -> properties + | _ -> [||] + +// TODO: needs more consideration +#if ENABLE_JSONEXTENSIONS_OPTIONS + +/// Extension methods that can be used to work with JsonValue in more convenient way. +/// This module also provides the dynamic operator. +module Options = + + open System.Runtime.CompilerServices + + type JsonValue with + + /// Get a sequence of key-value pairs representing the properties of an object + member x.Properties = + match x with + | JsonValue.Record properties -> properties + | _ -> [||] + + /// Try to get a property of a JSON value. + /// Returns None if the value is not an object or if the property is not present. + member x.TryGetProperty(propertyName) = + match x with + | JsonValue.Record properties -> + Array.tryFind (fst >> (=) propertyName) properties + |> Option.map snd + | _ -> None + + /// Try to get a property of a JSON value. + /// Returns None if the value is not a JSON object or if the property is not present. + member inline x.Item + with get (propertyName) = x.TryGetProperty(propertyName) + + /// Get all the elements of a JSON value. + /// Returns an empty array if the value is not a JSON array. + member x.AsArray() = + match x with + | JsonValue.Array elements -> elements + | _ -> [||] + + /// Get all the elements of a JSON value (assuming that the value is an array) + member inline x.GetEnumerator() = x.AsArray().GetEnumerator() + + /// Try to get the value at the specified index, if the value is a JSON array. + member inline x.Item + with get (index) = x.AsArray().[index] + + /// 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 false cultureInfo x + + /// Get a number as an integer (assuming that the value fits in integer) + member x.AsInteger(?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + JsonConversions.AsInteger cultureInfo x + + /// Get a number as a 64-bit integer (assuming that the value fits in 64-bit integer) + member x.AsInteger64(?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + JsonConversions.AsInteger64 cultureInfo x + + /// Get a number as a decimal (assuming that the value fits in decimal) + member x.AsDecimal(?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + JsonConversions.AsDecimal cultureInfo x + + /// Get a number as a float (assuming that the value is convertible to a float) + member x.AsFloat(?cultureInfo, [] ?missingValues) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues + JsonConversions.AsFloat missingValues true cultureInfo x + + /// Get the boolean value of an element (assuming that the value is a boolean) + member x.AsBoolean(?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + JsonConversions.AsBoolean cultureInfo x + + /// Get the datetime value of an element (assuming that the value is a string + /// containing well-formed ISO date or MSFT JSON date) + member x.AsDateTime(?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + JsonConversions.AsDateTime cultureInfo x + + /// Get the datetime offset value of an element (assuming that the value is a string + /// containing well-formed ISO date time with offset) + member x.AsDateTimeOffset(?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + JsonConversions.AsDateTimeOffset cultureInfo x + + /// Get the timespan value of an element (assuming that the value is a string + /// containing well-formed time span) + member x.AsTimeSpan(?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + JsonConversions.AsTimeSpan cultureInfo x + + /// Get the guid value of an element (assuming that the value is a guid) + member x.AsGuid() = JsonConversions.AsGuid x + + /// Get inner text of an element + member x.InnerText = + match x.AsString() with + | Some str -> str + | None -> + x.AsArray() + |> Array.map (fun e -> e.InnerText) + |> String.Concat + + [] + [] + type JsonValueOptionExtensions() = + + /// Get a sequence of key-value pairs representing the properties of an object + [] + static member Properties(x) = + match x with + | Some (json: JsonValue) -> json.Properties + | None -> [||] + + /// Try to get a property of a JSON value. + /// Returns None if the value is not an object or if the property is not present. + [] + static member TryGetProperty(x, propertyName) = + match x with + | Some (JsonValue.Record properties) -> + Array.tryFind (fst >> (=) propertyName) properties + |> Option.map snd + | _ -> None + + /// Try to get a property of a JSON value. + /// Returns None if the value is not a JSON object or if the property is not present. + [] + static member inline Item(x, propertyName) = + JsonValueOptionExtensions.TryGetProperty(x, propertyName) + + /// Get all the elements of a JSON value. + /// Returns an empty array if the value is not a JSON array. + [] + static member AsArray(x) = + match x with + | Some (JsonValue.Array elements) -> elements + | _ -> [||] + + /// Get all the elements of a JSON value (assuming that the value is an array) + [] + static member inline GetEnumerator(x) = + JsonValueOptionExtensions.AsArray(x).GetEnumerator() + + /// Try to get the value at the specified index, if the value is a JSON array. + [] + static member inline Item(x, index) = + JsonValueOptionExtensions.AsArray(x).[index] + + /// Get the string value of an element (assuming that the value is a scalar) + [] + static member AsString(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + x + |> Option.bind (JsonConversions.AsString false cultureInfo) + + /// Get a number as an integer (assuming that the value fits in integer) + [] + static member AsInteger(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + x + |> Option.bind (JsonConversions.AsInteger cultureInfo) + + /// Get a number as a 64-bit integer (assuming that the value fits in 64-bit integer) + [] + static member AsInteger64(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + x + |> Option.bind (JsonConversions.AsInteger64 cultureInfo) + + /// Get a number as a decimal (assuming that the value fits in decimal) + [] + static member AsDecimal(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + x + |> Option.bind (JsonConversions.AsDecimal cultureInfo) + + /// Get a number as a float (assuming that the value is convertible to a float) + [] + static member AsFloat(x, [] ?cultureInfo, [] ?missingValues) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + let missingValues = defaultArg missingValues TextConversions.DefaultMissingValues + + x + |> Option.bind (JsonConversions.AsFloat missingValues true cultureInfo) + + /// Get the boolean value of an element (assuming that the value is a boolean) + [] + static member AsBoolean(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + x + |> Option.bind (JsonConversions.AsBoolean cultureInfo) + + /// Get the datetime value of an element (assuming that the value is a string + /// containing well-formed ISO date or MSFT JSON date) + [] + static member AsDateTime(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + x + |> Option.bind (JsonConversions.AsDateTime cultureInfo) + + /// Get the datetime offset value of an element (assuming that the value is a string + /// containing well-formed ISO date time with offset) + [] + static member AsDateTimeOffset(x, [] ?cultureInfo) = + let cultureInfo = defaultArg cultureInfo CultureInfo.InvariantCulture + + x + |> Option.bind (JsonConversions.AsDateTimeOffset cultureInfo) + + /// Get the timespan value of an element (assuming that the value is a timespan) + [] + static member AsTimeSpan(x) = + x |> Option.bind JsonConversions.AsTimeSpan + + /// Get the guid value of an element (assuming that the value is a guid) + [] + static member AsGuid(x) = x |> Option.bind JsonConversions.AsGuid + + /// Get inner text of an element + [] + static member InnerText(x) = + match JsonValueOptionExtensions.AsString(x) with + | Some str -> str + | None -> + JsonValueOptionExtensions.AsArray(x) + |> Array.map (fun e -> e.InnerText) + |> String.Concat + + /// + type JsonValueOverloads = JsonValueOverloads + with + static member inline ($)(x: JsonValue, JsonValueOverloads) = + fun propertyName -> x.TryGetProperty propertyName + + static member inline ($)(x: JsonValue option, JsonValueOverloads) = + fun propertyName -> + x + |> Option.bind (fun x -> x.TryGetProperty propertyName) + + /// Get property of a JSON value (assuming that the value is an object) + let inline (?) x (propertyName: string) = (x $ JsonValueOverloads) propertyName #endif diff --git a/src/Json/JsonGenerator.fs b/src/Json/JsonGenerator.fs index 61488afa6..481e3fe75 100644 --- a/src/Json/JsonGenerator.fs +++ b/src/Json/JsonGenerator.fs @@ -18,487 +18,625 @@ open ProviderImplementation.ProvidedTypes /// Context that is used to generate the JSON types. type internal JsonGenerationContext = - { CultureStr : string - TypeProviderType : ProvidedTypeDefinition - // to nameclash type names - UniqueNiceName : string -> string - IJsonDocumentType : Type - JsonValueType : Type - JsonRuntimeType : Type - TypeCache : Dictionary - PreferDictionaries: bool - GenerateConstructors : bool } - - static member Create(cultureStr, tpType, ?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) = - { CultureStr = cultureStr - TypeProviderType = tpType - UniqueNiceName = uniqueNiceName - IJsonDocumentType = typeof - JsonValueType = typeof - JsonRuntimeType = typeof - TypeCache = typeCache - PreferDictionaries = preferDictionaries - GenerateConstructors = generateConstructors } - member x.MakeOptionType(typ:Type) = - typedefof>.MakeGenericType typ - -type internal JsonGenerationResult = - { ConvertedType : Type - OptionalConverter : (Expr -> Expr) option - ConversionCallingType : JsonConversionCallingType } - - member x.Convert = - defaultArg x.OptionalConverter id + { CultureStr: string + TypeProviderType: ProvidedTypeDefinition + // to nameclash type names + UniqueNiceName: string -> string + IJsonDocumentType: Type + JsonValueType: Type + JsonRuntimeType: Type + TypeCache: Dictionary + PreferDictionaries: bool + GenerateConstructors: bool } + + static member Create(cultureStr, tpType, ?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) = + { CultureStr = cultureStr + TypeProviderType = tpType + UniqueNiceName = uniqueNiceName + IJsonDocumentType = typeof + JsonValueType = typeof + JsonRuntimeType = typeof + TypeCache = typeCache + PreferDictionaries = preferDictionaries + GenerateConstructors = generateConstructors } + + member x.MakeOptionType(typ: Type) = + typedefof>.MakeGenericType typ + +type internal JsonGenerationResult = + { ConvertedType: Type + OptionalConverter: (Expr -> Expr) option + ConversionCallingType: JsonConversionCallingType } + + member x.Convert = defaultArg x.OptionalConverter id member x.ConverterFunc ctx = - ReflectionHelpers.makeDelegate x.Convert ctx.IJsonDocumentType + ReflectionHelpers.makeDelegate x.Convert ctx.IJsonDocumentType member x.ConvertedTypeErased ctx = - if x.ConvertedType.IsArray then - match x.ConvertedType.GetElementType() with - | :? ProvidedTypeDefinition -> ctx.IJsonDocumentType.MakeArrayType() - | _ -> x.ConvertedType - else - match x.ConvertedType with - | :? ProvidedTypeDefinition -> ctx.IJsonDocumentType - | _ -> x.ConvertedType - -module JsonTypeBuilder = - - let (?) = QuotationBuilder.(?) - - // check if a type was already created for the inferedType before creating a new one - let internal getOrCreateType ctx inferedType createType = - - // normalize properties of the inferedType which don't affect code generation - let rec normalize topLevel = function - | InferedType.Heterogeneous map -> - map - |> Map.map (fun _ inferedType -> normalize false inferedType) - |> InferedType.Heterogeneous - | InferedType.Collection (order, types) -> - InferedType.Collection (order, Map.map (fun _ (multiplicity, inferedType) -> multiplicity, normalize false inferedType) types) - | InferedType.Record (_, props, optional) -> - let props = - props - |> List.map (fun { Name = name; Type = inferedType } -> { Name = name; 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) - | x -> x - - let inferedType = normalize true inferedType - let typ = - match ctx.TypeCache.TryGetValue inferedType with - | true, typ -> typ - | _ -> - let typ = createType() - ctx.TypeCache.Add(inferedType, typ) - typ - - { ConvertedType = typ - OptionalConverter = None - ConversionCallingType = JsonDocument } - - let internal replaceJDocWithJValue (ctx:JsonGenerationContext) (typ:Type) = - if typ = ctx.IJsonDocumentType then - ctx.JsonValueType - elif typ.IsArray && typ.GetElementType() = ctx.IJsonDocumentType then - ctx.JsonValueType.MakeArrayType() - elif typ.IsGenericType && typ.GetGenericArguments() = [| ctx.IJsonDocumentType |] then - typ.GetGenericTypeDefinition().MakeGenericType ctx.JsonValueType - else - typ - - /// Common code that is shared by code generators that generate - /// "Choice" type. This is parameterized by the types (choices) to generate, - /// by functions that get the multiplicity and the type tag for each option - /// and also by function that generates the actual code. - let rec internal generateMultipleChoiceType ctx types forCollection nameOverride (codeGenerator : _ -> _ -> _ -> _ -> Expr) = - - let types = - types - |> Seq.map (fun (KeyValue(tag, (multiplicity, inferedType))) -> tag, multiplicity, inferedType) - |> Seq.sortBy (fun (tag, _, _) -> tag) - |> Seq.toArray - - if types.Length <= 1 then failwithf "generateMultipleChoiceType: Invalid choice type: %A" types - - for _, _, inferedType in types do - match inferedType with - | InferedType.Null | InferedType.Top | InferedType.Heterogeneous _ -> - failwithf "generateMultipleChoiceType: Unsupported type: %A" inferedType - | x when x.IsOptional -> - failwithf "generateMultipleChoiceType: Type shouldn't be optional: %A" inferedType - | _ -> () - - let typeName = - if not (String.IsNullOrEmpty nameOverride) - then nameOverride + if x.ConvertedType.IsArray then + match x.ConvertedType.GetElementType() with + | :? ProvidedTypeDefinition -> ctx.IJsonDocumentType.MakeArrayType() + | _ -> x.ConvertedType else - let getTypeName (tag:InferedTypeTag, multiplicity, inferedType) = - match multiplicity with - | InferedMultiplicity.Multiple -> NameUtils.pluralize tag.NiceName - | InferedMultiplicity.OptionalSingle | InferedMultiplicity.Single -> - match inferedType with - | InferedType.Primitive(typ, _, _) -> - if typ = typeof || typ = typeof || typ = typeof then "Int" - elif typ = typeof then "Int64" - elif typ = typeof then "Decimal" - elif typ = typeof then "Float" - else tag.NiceName - | _ -> tag.NiceName - types - |> Array.map getTypeName - |> String.concat "Or" - |> ctx.UniqueNiceName - - // Generate new type for the heterogeneous type - let objectTy = ProvidedTypeDefinition(typeName, Some ctx.IJsonDocumentType, hideObjectMethods = true, nonNullable = true) - ctx.TypeProviderType.AddMember objectTy - - // to nameclash property names - let makeUnique = NameUtils.uniqueGenerator NameUtils.nicePascalName - makeUnique "JsonValue" |> ignore - - let members = - [ for tag, multiplicity, inferedType in types -> - - let result = generateJsonType ctx false false "" inferedType - - let propName = - match tag with - | InferedTypeTag.Record _ -> "Record" - | _ -> tag.NiceName - - let name, typ, constructorType = - match multiplicity with - | InferedMultiplicity.OptionalSingle -> - makeUnique propName, - ctx.MakeOptionType result.ConvertedType, - if forCollection - then ctx.MakeOptionType (replaceJDocWithJValue ctx result.ConvertedType) - else replaceJDocWithJValue ctx result.ConvertedType - | InferedMultiplicity.Single -> - makeUnique propName, - result.ConvertedType, - replaceJDocWithJValue ctx result.ConvertedType - | InferedMultiplicity.Multiple -> - makeUnique (NameUtils.pluralize tag.NiceName), - result.ConvertedType.MakeArrayType(), - (replaceJDocWithJValue ctx result.ConvertedType).MakeArrayType() - - ProvidedProperty(name, typ, getterCode = codeGenerator multiplicity result tag.Code), - ProvidedParameter(NameUtils.niceCamelName name, constructorType) ] - - let properties, parameters = List.unzip members - objectTy.AddMembers properties - - if ctx.GenerateConstructors then - - let cultureStr = ctx.CultureStr - - if forCollection then - 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) @@> - let ctor = ProvidedConstructor(parameters, invokeCode = ctorCode) - objectTy.AddMember ctor + match x.ConvertedType with + | :? ProvidedTypeDefinition -> ctx.IJsonDocumentType + | _ -> x.ConvertedType + +module JsonTypeBuilder = + + let (?) = QuotationBuilder.(?) + + // check if a type was already created for the inferedType before creating a new one + let internal getOrCreateType ctx inferedType createType = + + // normalize properties of the inferedType which don't affect code generation + let rec normalize topLevel = + function + | InferedType.Heterogeneous map -> + map + |> Map.map (fun _ inferedType -> normalize false inferedType) + |> InferedType.Heterogeneous + | InferedType.Collection (order, types) -> + InferedType.Collection( + order, + Map.map (fun _ (multiplicity, inferedType) -> multiplicity, normalize false inferedType) types + ) + | InferedType.Record (_, props, optional) -> + let props = + props + |> List.map (fun { Name = name; Type = inferedType } -> + { Name = name + 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) + | x -> x + + let inferedType = normalize true inferedType + + let typ = + match ctx.TypeCache.TryGetValue inferedType with + | true, typ -> typ + | _ -> + let typ = createType () + ctx.TypeCache.Add(inferedType, typ) + typ + + { ConvertedType = typ + OptionalConverter = None + ConversionCallingType = JsonDocument } + + let internal replaceJDocWithJValue (ctx: JsonGenerationContext) (typ: Type) = + if typ = ctx.IJsonDocumentType then + ctx.JsonValueType + elif typ.IsArray + && typ.GetElementType() = ctx.IJsonDocumentType then + ctx.JsonValueType.MakeArrayType() + elif typ.IsGenericType + && typ.GetGenericArguments() = [| ctx.IJsonDocumentType |] then + typ.GetGenericTypeDefinition().MakeGenericType ctx.JsonValueType 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 = ctorCode) + typ + + /// Common code that is shared by code generators that generate + /// "Choice" type. This is parameterized by the types (choices) to generate, + /// by functions that get the multiplicity and the type tag for each option + /// and also by function that generates the actual code. + let rec internal generateMultipleChoiceType + ctx + types + forCollection + nameOverride + (codeGenerator: _ -> _ -> _ -> _ -> Expr) + = + + let types = + types + |> Seq.map (fun (KeyValue (tag, (multiplicity, inferedType))) -> tag, multiplicity, inferedType) + |> Seq.sortBy (fun (tag, _, _) -> tag) + |> Seq.toArray + + if types.Length <= 1 then + failwithf "generateMultipleChoiceType: Invalid choice type: %A" types + + for _, _, inferedType in types do + match inferedType with + | InferedType.Null + | InferedType.Top + | InferedType.Heterogeneous _ -> failwithf "generateMultipleChoiceType: Unsupported type: %A" inferedType + | x when x.IsOptional -> failwithf "generateMultipleChoiceType: Type shouldn't be optional: %A" inferedType + | _ -> () + + let typeName = + if not (String.IsNullOrEmpty nameOverride) then + nameOverride + else + let getTypeName (tag: InferedTypeTag, multiplicity, inferedType) = + match multiplicity with + | InferedMultiplicity.Multiple -> NameUtils.pluralize tag.NiceName + | InferedMultiplicity.OptionalSingle + | InferedMultiplicity.Single -> + match inferedType with + | InferedType.Primitive (typ, _, _) -> + if typ = typeof + || typ = typeof + || typ = typeof then + "Int" + elif typ = typeof then + "Int64" + elif typ = typeof then + "Decimal" + elif typ = typeof then + "Float" + else + tag.NiceName + | _ -> tag.NiceName + + types + |> Array.map getTypeName + |> String.concat "Or" + |> ctx.UniqueNiceName + + // Generate new type for the heterogeneous type + let objectTy = + ProvidedTypeDefinition(typeName, Some ctx.IJsonDocumentType, hideObjectMethods = true, nonNullable = true) + + ctx.TypeProviderType.AddMember objectTy + + // to nameclash property names + let makeUnique = NameUtils.uniqueGenerator NameUtils.nicePascalName + makeUnique "JsonValue" |> ignore + + let members = + [ for tag, multiplicity, inferedType in types -> + + let result = generateJsonType ctx false false "" inferedType + + let propName = + match tag with + | InferedTypeTag.Record _ -> "Record" + | _ -> tag.NiceName + + let name, typ, constructorType = + match multiplicity with + | InferedMultiplicity.OptionalSingle -> + makeUnique propName, + ctx.MakeOptionType result.ConvertedType, + if forCollection then + ctx.MakeOptionType(replaceJDocWithJValue ctx result.ConvertedType) + else + replaceJDocWithJValue ctx result.ConvertedType + | InferedMultiplicity.Single -> + makeUnique propName, result.ConvertedType, replaceJDocWithJValue ctx result.ConvertedType + | InferedMultiplicity.Multiple -> + makeUnique (NameUtils.pluralize tag.NiceName), + result.ConvertedType.MakeArrayType(), + (replaceJDocWithJValue ctx result.ConvertedType).MakeArrayType() + + ProvidedProperty(name, typ, getterCode = codeGenerator multiplicity result tag.Code), + ProvidedParameter(NameUtils.niceCamelName name, constructorType) ] + + let properties, parameters = List.unzip members + objectTy.AddMembers properties + + if ctx.GenerateConstructors then + + let cultureStr = ctx.CultureStr + + if forCollection then + 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) @@> + + 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 defaultCtor = - let ctorCode _ = - <@@ JsonRuntime.CreateValue(null :> obj, cultureStr) @@> - ProvidedConstructor([], invokeCode = ctorCode) - objectTy.AddMember defaultCtor + let ctor = ProvidedConstructor([ param ], invokeCode = ctorCode) + objectTy.AddMember ctor - let ctorCode (Singleton arg) = - <@@ JsonDocument.Create((%%arg:JsonValue), "") @@> - let ctor = - ProvidedConstructor( - [ProvidedParameter("jsonValue", ctx.JsonValueType)], - invokeCode = ctorCode) + let defaultCtor = + let ctorCode _ = + <@@ JsonRuntime.CreateValue(null :> obj, cultureStr) @@> - objectTy.AddMember ctor + ProvidedConstructor([], invokeCode = ctorCode) - objectTy + objectTy.AddMember defaultCtor - /// Recursively walks over inferred type information and - /// generates types for read-only access to the document - and internal generateJsonType ctx canPassAllConversionCallingTypes optionalityHandledByParent nameOverride inferedType = + let ctorCode (Singleton arg) = + <@@ JsonDocument.Create((%%arg: JsonValue), "") @@> - let inferedType = - match inferedType with - | InferedType.Collection (order, types) -> - InferedType.Collection (List.filter ((<>) InferedTypeTag.Null) order, Map.remove InferedTypeTag.Null types) - | x -> x + let ctor = + ProvidedConstructor([ ProvidedParameter("jsonValue", ctx.JsonValueType) ], invokeCode = ctorCode) - match inferedType with + objectTy.AddMember ctor - | InferedType.Primitive(inferedType, unit, optional) -> + objectTy - let typ, conv, conversionCallingType = - PrimitiveInferedProperty.Create("", inferedType, optional, unit) - |> convertJsonValue "" ctx.CultureStr canPassAllConversionCallingTypes + /// Recursively walks over inferred type information and + /// generates types for read-only access to the document + and internal generateJsonType + ctx + canPassAllConversionCallingTypes + optionalityHandledByParent + nameOverride + inferedType + = + + let inferedType = + match inferedType with + | InferedType.Collection (order, types) -> + InferedType.Collection( + List.filter ((<>) InferedTypeTag.Null) order, + Map.remove InferedTypeTag.Null types + ) + | x -> x - { ConvertedType = typ - OptionalConverter = Some conv - ConversionCallingType = conversionCallingType } + match inferedType with - | InferedType.Top - | InferedType.Null -> + | InferedType.Primitive (inferedType, unit, optional) -> - // Return the underlying JsonDocument without change - { ConvertedType = ctx.IJsonDocumentType - OptionalConverter = None - ConversionCallingType = JsonDocument } + let typ, conv, conversionCallingType = + PrimitiveInferedProperty.Create("", inferedType, optional, unit) + |> convertJsonValue "" ctx.CultureStr canPassAllConversionCallingTypes - | InferedType.Collection (_, SingletonMap(_, (_, typ))) - | InferedType.Collection (_, EmptyMap InferedType.Top typ) -> + { ConvertedType = typ + OptionalConverter = Some conv + ConversionCallingType = conversionCallingType } - let elementResult = generateJsonType ctx false false nameOverride typ + | InferedType.Top + | InferedType.Null -> - let conv = fun (jDoc:Expr) -> - ctx.JsonRuntimeType?ConvertArray (elementResult.ConvertedTypeErased ctx) (jDoc, elementResult.ConverterFunc ctx) - - { ConvertedType = elementResult.ConvertedType.MakeArrayType() - OptionalConverter = Some conv - ConversionCallingType = JsonDocument } + // Return the underlying JsonDocument without change + { ConvertedType = ctx.IJsonDocumentType + OptionalConverter = None + ConversionCallingType = JsonDocument } - | InferedType.Record(name, props, optional) -> - getOrCreateType ctx inferedType (fun () -> - - if optional && not optionalityHandledByParent then - failwithf "generateJsonType: optionality not handled for %A" inferedType + | InferedType.Collection (_, SingletonMap (_, (_, typ))) + | InferedType.Collection (_, EmptyMap InferedType.Top typ) -> - let name = - if String.IsNullOrEmpty nameOverride - then match name with Some name -> name | _ -> "Record" - else nameOverride - |> ctx.UniqueNiceName + let elementResult = generateJsonType ctx false false nameOverride typ - // Generate new type for the record - let objectTy = ProvidedTypeDefinition(name, Some ctx.IJsonDocumentType, hideObjectMethods = true, nonNullable = true) + let conv = + fun (jDoc: Expr) -> + ctx.JsonRuntimeType?ConvertArray + (elementResult.ConvertedTypeErased ctx) + (jDoc, elementResult.ConverterFunc ctx) - ctx.TypeProviderType.AddMember(objectTy) + { ConvertedType = elementResult.ConvertedType.MakeArrayType() + OptionalConverter = Some conv + ConversionCallingType = JsonDocument } - // to nameclash property names - let makeUnique = NameUtils.uniqueGenerator NameUtils.nicePascalName - makeUnique "JsonValue" |> ignore + | InferedType.Record (name, props, optional) -> + getOrCreateType ctx inferedType (fun () -> - let inferedKeyValueType = - let aggr = List.fold (StructuralInference.subtypeInfered false) InferedType.Top - let dropRecordName infType = - match infType with - | InferedType.Record (_, fields, opt) -> InferedType.Record (None, fields, opt) - | _ -> infType - - if not ctx.PreferDictionaries - then None - else - let infType = - [for prop in props -> StructuralInference.getInferedTypeFromString (TextRuntime.GetCulture ctx.CultureStr) prop.Name None] - |> aggr - match infType with - | InferedType.Primitive (typ = typ) when typ <> typeof -> - let inferValueType = ([for prop in props -> prop.Type |> dropRecordName] |> aggr).DropOptionality () - (infType, inferValueType) |> Some - | _ -> None - - match inferedKeyValueType with - | Some (inferedKeyType, inferedValueType) -> - // Add all record fields as dictionary items - let valueName = name + "Value" - - 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|]) - let itemsSeqType = typedefof<_ seq>.MakeGenericType([|tupleType|]) - - let itemsGetter (Singleton jDoc) = - ctx.JsonRuntimeType?ConvertRecordToDictionary (keyResult.ConvertedType, valueConvertedTypeErased) (jDoc, keyResult.ConverterFunc ctx, valueResult.ConverterFunc ctx) - - let keysGetter (Singleton jDoc) = - ctx.JsonRuntimeType?GetKeysFromInferedDictionary (keyResult.ConvertedType) (jDoc, keyResult.ConverterFunc ctx) - - let valuesGetter (Singleton jDoc) = - ctx.JsonRuntimeType?GetValuesFromInferedDictionary (valueConvertedTypeErased) (jDoc, valueResult.ConverterFunc ctx) - - let (|Doubleton|) = function [f; s] -> f, s | _ -> failwith "Parameter mismatch" - - let itemGetter (Doubleton (jDoc, key)) = - ctx.JsonRuntimeType?GetValueByKeyFromInferedDictionary (keyResult.ConvertedType, valueConvertedTypeErased) (jDoc, keyResult.ConverterFunc ctx, valueResult.ConverterFunc ctx, key) - - let tryFindCode (Doubleton (jDoc, key)) = - ctx.JsonRuntimeType?TryGetValueByKeyFromInferedDictionary (keyResult.ConvertedType, valueConvertedTypeErased) (jDoc, keyResult.ConverterFunc ctx, valueResult.ConverterFunc ctx, key) - - let containsKeyCode (Doubleton (jDoc, key)) = - ctx.JsonRuntimeType?InferedDictionaryContainsKey (keyResult.ConvertedType) (jDoc, keyResult.ConverterFunc ctx, key) - - let countGetter (Singleton jDoc) = - <@@ JsonRuntime.GetRecordProperties(%%jDoc).Length @@> - - let isEmptyGetter (Singleton jDoc) = - <@@ JsonRuntime.GetRecordProperties(%%jDoc).Length = 0 @@> - - [ - ProvidedProperty("Items", itemsSeqType, getterCode = itemsGetter) - ProvidedProperty("Keys", keyResult.ConvertedType.MakeArrayType(), getterCode = keysGetter) - ProvidedProperty("Values", valueResult.ConvertedType.MakeArrayType(), getterCode = valuesGetter) - ProvidedProperty("Item", valueResult.ConvertedType, getterCode = itemGetter, indexParameters = [ProvidedParameter("key", keyResult.ConvertedType)]) - 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 - 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) - 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 true true "" prop.Type - let propName = prop.Name - let optionalityHandledByProperty = propResult.ConversionCallingType <> JsonDocument - - let getter (Singleton jDoc) = - - if optionalityHandledByProperty then - - propResult.Convert <| - if propResult.ConversionCallingType = JsonValueOptionAndPath then - <@@ JsonRuntime.TryGetPropertyUnpackedWithPath(%%jDoc, propName) @@> - else - <@@ JsonRuntime.TryGetPropertyUnpacked(%%jDoc, propName) @@> - - elif prop.Type.IsOptional then - - match propResult.OptionalConverter with - | Some _ -> - //TODO: not covered in tests - ctx.JsonRuntimeType?ConvertOptionalProperty (propResult.ConvertedTypeErased ctx) (jDoc, propName, propResult.ConverterFunc ctx) - - | None -> - <@@ JsonRuntime.TryGetPropertyPacked(%%jDoc, propName) @@> - - else - - propResult.Convert <| - match prop.Type with - | InferedType.Collection _ - | InferedType.Heterogeneous _ - | InferedType.Top - | InferedType.Null -> <@@ JsonRuntime.GetPropertyPackedOrNull(%%jDoc, propName) @@> - | _ -> <@@ JsonRuntime.GetPropertyPacked(%%jDoc, propName) @@> - - let convertedType = - if prop.Type.IsOptional && not optionalityHandledByProperty - then ctx.MakeOptionType propResult.ConvertedType - else propResult.ConvertedType - - let name = makeUnique prop.Name - prop.Name, - [ProvidedProperty(name, convertedType, getterCode = getter)], - ProvidedParameter(NameUtils.niceCamelName name, replaceJDocWithJValue ctx convertedType) ] - - let names, properties, parameters = List.unzip3 members - let properties = properties |> List.concat - objectTy.AddMembers properties - - if ctx.GenerateConstructors then - 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) @@> - let ctor = - ProvidedConstructor(parameters, invokeCode = ctorCode) - objectTy.AddMember ctor - () + if optional && not optionalityHandledByParent then + failwithf "generateJsonType: optionality not handled for %A" inferedType - if ctx.GenerateConstructors then - 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 () -> - - // Generate a choice type that calls either `GetArrayChildrenByTypeTag` - // or `GetArrayChildByTypeTag`, depending on the multiplicity of the item - generateMultipleChoiceType ctx types true nameOverride (fun multiplicity result tagCode -> - match multiplicity with - | InferedMultiplicity.Single -> fun (Singleton jDoc) -> - // Generate method that calls `GetArrayChildByTypeTag` - let cultureStr = ctx.CultureStr - result.Convert <@@ JsonRuntime.GetArrayChildByTypeTag(%%jDoc, cultureStr, tagCode) @@> - - | InferedMultiplicity.Multiple -> fun (Singleton jDoc) -> - // Generate method that calls `GetArrayChildrenByTypeTag` - // (unlike the previous easy case, this needs to call conversion function - // from the runtime similarly to options and arrays) - let cultureStr = ctx.CultureStr - ctx.JsonRuntimeType?GetArrayChildrenByTypeTag (result.ConvertedTypeErased ctx) (jDoc, cultureStr, tagCode, result.ConverterFunc ctx) - - | InferedMultiplicity.OptionalSingle -> fun (Singleton jDoc) -> - // 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 () -> - - // Generate a choice type that always calls `TryGetValueByTypeTag` - let types = types |> Map.map (fun _ v -> InferedMultiplicity.OptionalSingle, v) - 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) - ) - ) - - | InferedType.Json _ -> failwith "Json type not supported" + let name = + if String.IsNullOrEmpty nameOverride then + match name with + | Some name -> name + | _ -> "Record" + else + nameOverride + |> ctx.UniqueNiceName + + // Generate new type for the record + let objectTy = + ProvidedTypeDefinition( + name, + Some ctx.IJsonDocumentType, + hideObjectMethods = true, + nonNullable = true + ) + + ctx.TypeProviderType.AddMember(objectTy) + + // to nameclash property names + let makeUnique = NameUtils.uniqueGenerator NameUtils.nicePascalName + makeUnique "JsonValue" |> ignore + + let inferedKeyValueType = + let aggr = List.fold (StructuralInference.subtypeInfered false) InferedType.Top + + let dropRecordName infType = + match infType with + | InferedType.Record (_, fields, opt) -> InferedType.Record(None, fields, opt) + | _ -> infType + + if not ctx.PreferDictionaries then + None + else + let infType = + [ for prop in props -> + StructuralInference.getInferedTypeFromString + (TextRuntime.GetCulture ctx.CultureStr) + prop.Name + None ] + |> aggr + + match infType with + | InferedType.Primitive (typ = typ) when typ <> typeof -> + let inferValueType = + ([ for prop in props -> prop.Type |> dropRecordName ] + |> aggr) + .DropOptionality() + + (infType, inferValueType) |> Some + | _ -> None + + match inferedKeyValueType with + | Some (inferedKeyType, inferedValueType) -> + // Add all record fields as dictionary items + let valueName = name + "Value" + + 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 |] + ) + + let itemsSeqType = typedefof<_ seq>.MakeGenericType ([| tupleType |]) + + let itemsGetter (Singleton jDoc) = + ctx.JsonRuntimeType?ConvertRecordToDictionary + (keyResult.ConvertedType, valueConvertedTypeErased) + (jDoc, keyResult.ConverterFunc ctx, valueResult.ConverterFunc ctx) + + let keysGetter (Singleton jDoc) = + ctx.JsonRuntimeType?GetKeysFromInferedDictionary + (keyResult.ConvertedType) + (jDoc, keyResult.ConverterFunc ctx) + + let valuesGetter (Singleton jDoc) = + ctx.JsonRuntimeType?GetValuesFromInferedDictionary + (valueConvertedTypeErased) + (jDoc, valueResult.ConverterFunc ctx) + + let (|Doubleton|) = + function + | [ f; s ] -> f, s + | _ -> failwith "Parameter mismatch" + + let itemGetter (Doubleton (jDoc, key)) = + ctx.JsonRuntimeType?GetValueByKeyFromInferedDictionary + (keyResult.ConvertedType, valueConvertedTypeErased) + (jDoc, keyResult.ConverterFunc ctx, valueResult.ConverterFunc ctx, key) + + let tryFindCode (Doubleton (jDoc, key)) = + ctx.JsonRuntimeType?TryGetValueByKeyFromInferedDictionary + (keyResult.ConvertedType, valueConvertedTypeErased) + (jDoc, keyResult.ConverterFunc ctx, valueResult.ConverterFunc ctx, key) + + let containsKeyCode (Doubleton (jDoc, key)) = + ctx.JsonRuntimeType?InferedDictionaryContainsKey + (keyResult.ConvertedType) + (jDoc, keyResult.ConverterFunc ctx, key) + + let countGetter (Singleton jDoc) = + <@@ JsonRuntime.GetRecordProperties(%%jDoc).Length @@> + + let isEmptyGetter (Singleton jDoc) = + <@@ JsonRuntime.GetRecordProperties(%%jDoc).Length = 0 @@> + + [ ProvidedProperty("Items", itemsSeqType, getterCode = itemsGetter) + ProvidedProperty("Keys", keyResult.ConvertedType.MakeArrayType(), getterCode = keysGetter) + ProvidedProperty("Values", valueResult.ConvertedType.MakeArrayType(), getterCode = valuesGetter) + ProvidedProperty( + "Item", + valueResult.ConvertedType, + getterCode = itemGetter, + indexParameters = [ ProvidedParameter("key", keyResult.ConvertedType) ] + ) + 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 + 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) + + 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 true true "" prop.Type + let propName = prop.Name + let optionalityHandledByProperty = propResult.ConversionCallingType <> JsonDocument + + let getter (Singleton jDoc) = + + if optionalityHandledByProperty then + + propResult.Convert + <| if propResult.ConversionCallingType = JsonValueOptionAndPath then + <@@ JsonRuntime.TryGetPropertyUnpackedWithPath(%%jDoc, propName) @@> + else + <@@ JsonRuntime.TryGetPropertyUnpacked(%%jDoc, propName) @@> + + elif prop.Type.IsOptional then + + match propResult.OptionalConverter with + | Some _ -> + //TODO: not covered in tests + ctx.JsonRuntimeType?ConvertOptionalProperty + (propResult.ConvertedTypeErased ctx) + (jDoc, propName, propResult.ConverterFunc ctx) + + | None -> <@@ JsonRuntime.TryGetPropertyPacked(%%jDoc, propName) @@> + + else + + propResult.Convert + <| match prop.Type with + | InferedType.Collection _ + | InferedType.Heterogeneous _ + | InferedType.Top + | InferedType.Null -> + <@@ JsonRuntime.GetPropertyPackedOrNull(%%jDoc, propName) @@> + | _ -> <@@ JsonRuntime.GetPropertyPacked(%%jDoc, propName) @@> + + let convertedType = + if prop.Type.IsOptional + && not optionalityHandledByProperty then + ctx.MakeOptionType propResult.ConvertedType + else + propResult.ConvertedType + + let name = makeUnique prop.Name + + prop.Name, + [ ProvidedProperty(name, convertedType, getterCode = getter) ], + ProvidedParameter(NameUtils.niceCamelName name, replaceJDocWithJValue ctx convertedType) ] + + let names, properties, parameters = List.unzip3 members + let properties = properties |> List.concat + objectTy.AddMembers properties + + if ctx.GenerateConstructors then + 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) @@> + + let ctor = ProvidedConstructor(parameters, invokeCode = ctorCode) + objectTy.AddMember ctor + + () + + if ctx.GenerateConstructors then + 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 () -> + + // Generate a choice type that calls either `GetArrayChildrenByTypeTag` + // or `GetArrayChildByTypeTag`, depending on the multiplicity of the item + generateMultipleChoiceType ctx types true nameOverride (fun multiplicity result tagCode -> + match multiplicity with + | InferedMultiplicity.Single -> + fun (Singleton jDoc) -> + // Generate method that calls `GetArrayChildByTypeTag` + let cultureStr = ctx.CultureStr + result.Convert <@@ JsonRuntime.GetArrayChildByTypeTag(%%jDoc, cultureStr, tagCode) @@> + + | InferedMultiplicity.Multiple -> + fun (Singleton jDoc) -> + // Generate method that calls `GetArrayChildrenByTypeTag` + // (unlike the previous easy case, this needs to call conversion function + // from the runtime similarly to options and arrays) + let cultureStr = ctx.CultureStr + + ctx.JsonRuntimeType?GetArrayChildrenByTypeTag + (result.ConvertedTypeErased ctx) + (jDoc, cultureStr, tagCode, result.ConverterFunc ctx) + + | InferedMultiplicity.OptionalSingle -> + fun (Singleton jDoc) -> + // 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 () -> + + // Generate a choice type that always calls `TryGetValueByTypeTag` + let types = + types + |> Map.map (fun _ v -> InferedMultiplicity.OptionalSingle, v) + + 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))) + + | InferedType.Json _ -> failwith "Json type not supported" diff --git a/src/Json/JsonInference.fs b/src/Json/JsonInference.fs index 9ba57d6e1..308a798d6 100644 --- a/src/Json/JsonInference.fs +++ b/src/Json/JsonInference.fs @@ -14,36 +14,61 @@ open FSharp.Data.Runtime.StructuralTypes /// `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 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 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 - match json with - // Null and primitives without subtyping hiearchies - | 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) - // 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 n when inferTypesFromValues && inRangeDecimal Int32.MinValue Int32.MaxValue n && isIntegerDecimal n -> InferedType.Primitive(typeof, None, false) - | JsonValue.Number n when inferTypesFromValues && inRangeDecimal Int64.MinValue Int64.MaxValue n && isIntegerDecimal n -> InferedType.Primitive(typeof, None, false) - | JsonValue.Number _ -> InferedType.Primitive(typeof, None, false) - | JsonValue.Float f when inferTypesFromValues && inRangeFloat Int32.MinValue Int32.MaxValue f && isIntegerFloat f -> InferedType.Primitive(typeof, None, false) - | 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 false (Seq.map (inferType inferTypesFromValues cultureInfo (NameUtils.singularize parentName)) ar) - | JsonValue.Record properties -> - let name = - if String.IsNullOrEmpty parentName - then None - else Some parentName - let props = - [ for propName, value in properties -> - let t = inferType inferTypesFromValues cultureInfo propName value - { Name = propName - Type = t } ] - InferedType.Record(name, props, false) + match json with + // Null and primitives without subtyping hiearchies + | 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) + // 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 n when + inferTypesFromValues + && inRangeDecimal Int32.MinValue Int32.MaxValue n + && isIntegerDecimal n + -> + InferedType.Primitive(typeof, None, false) + | JsonValue.Number n when + inferTypesFromValues + && inRangeDecimal Int64.MinValue Int64.MaxValue n + && isIntegerDecimal n + -> + InferedType.Primitive(typeof, None, false) + | JsonValue.Number _ -> InferedType.Primitive(typeof, None, false) + | JsonValue.Float f when + inferTypesFromValues + && inRangeFloat Int32.MinValue Int32.MaxValue f + && isIntegerFloat f + -> + InferedType.Primitive(typeof, None, false) + | 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 + false + (Seq.map (inferType inferTypesFromValues cultureInfo (NameUtils.singularize parentName)) ar) + | JsonValue.Record properties -> + let name = + if String.IsNullOrEmpty parentName then + None + else + Some parentName + + let props = + [ for propName, value in properties -> + let t = inferType inferTypesFromValues 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 fb78e6c8d..8dc171e7d 100644 --- a/src/Json/JsonProvider.fs +++ b/src/Json/JsonProvider.fs @@ -16,86 +16,96 @@ open FSharp.Data.Runtime.StructuralTypes #nowarn "10001" [] -type public JsonProvider(cfg:TypeProviderConfig) as this = - inherit DisposableTypeProviderForNamespaces(cfg, assemblyReplacementMap=[ "FSharp.Data.DesignTime", "FSharp.Data" ]) - +type public JsonProvider(cfg: TypeProviderConfig) as this = + inherit DisposableTypeProviderForNamespaces + ( + cfg, + assemblyReplacementMap = [ "FSharp.Data.DesignTime", "FSharp.Data" ] + ) + // Generate namespace and type 'FSharp.Data.JsonProvider' do AssemblyResolver.init () let asm = System.Reflection.Assembly.GetExecutingAssembly() let ns = "FSharp.Data" - let jsonProvTy = ProvidedTypeDefinition(asm, ns, "JsonProvider", None, hideObjectMethods=true, nonNullable=true) - - let buildTypes (typeName:string) (args:obj[]) = - + + let jsonProvTy = + ProvidedTypeDefinition(asm, ns, "JsonProvider", None, hideObjectMethods = true, nonNullable = true) + + let buildTypes (typeName: string) (args: obj[]) = + // Generate the required type - let tpType = ProvidedTypeDefinition(asm, ns, typeName, None, hideObjectMethods=true, nonNullable=true) - + let tpType = + ProvidedTypeDefinition(asm, ns, typeName, None, hideObjectMethods = true, nonNullable = true) + let sample = args.[0] :?> string let sampleIsList = args.[1] :?> bool let rootName = args.[2] :?> string - let rootName = if String.IsNullOrWhiteSpace rootName then "Root" else NameUtils.singularize rootName + + let rootName = + if String.IsNullOrWhiteSpace rootName then + "Root" + else + NameUtils.singularize rootName + let cultureStr = args.[3] :?> string let encodingStr = args.[4] :?> string let resolutionFolder = args.[5] :?> string let resource = args.[6] :?> string let inferTypesFromValues = args.[7] :?> bool let preferDictionaries = args.[8] :?> bool - + let cultureInfo = TextRuntime.GetCulture cultureStr - - let getSpec _ value = - + + let getSpec _ value = + let samples = use _holder = IO.logTime "Parsing" sample + if sampleIsList then JsonDocument.CreateList(new StringReader(value)) |> Array.map (fun doc -> doc.JsonValue) - else + else [| JsonValue.Parse(value) |] - + let inferedType = use _holder = IO.logTime "Inference" sample + samples |> Array.map (fun sampleJson -> JsonInference.inferType inferTypesFromValues cultureInfo "" sampleJson) |> Array.fold (StructuralInference.subtypeInfered false) InferedType.Top - + use _holder = IO.logTime "TypeGeneration" sample - - let ctx = JsonGenerationContext.Create(cultureStr, tpType, ?preferDictionaries = Some preferDictionaries) + + 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 - SampleList sample - else - Sample sample + 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 SampleList sample else Sample sample 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 = + + // Add static parameter that specifies the API we want to get (compile-time) + let parameters = [ ProvidedStaticParameter("Sample", typeof) - ProvidedStaticParameter("SampleIsList", typeof, parameterDefaultValue = false) - ProvidedStaticParameter("RootName", typeof, parameterDefaultValue = "Root") - ProvidedStaticParameter("Culture", typeof, parameterDefaultValue = "") - ProvidedStaticParameter("Encoding", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("SampleIsList", typeof, parameterDefaultValue = false) + ProvidedStaticParameter("RootName", typeof, parameterDefaultValue = "Root") + ProvidedStaticParameter("Culture", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("Encoding", typeof, parameterDefaultValue = "") ProvidedStaticParameter("ResolutionFolder", typeof, parameterDefaultValue = "") ProvidedStaticParameter("EmbeddedResource", typeof, parameterDefaultValue = "") ProvidedStaticParameter("InferTypesFromValues", typeof, parameterDefaultValue = true) ProvidedStaticParameter("PreferDictionaries", typeof, parameterDefaultValue = false) ] - - let helpText = + + let helpText = """Typed representation of a JSON document. Location of a JSON sample file or a string containing a sample JSON document. If true, sample should be a list of individual samples for the inference. @@ -108,9 +118,9 @@ type public JsonProvider(cfg:TypeProviderConfig) as this = 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 record is considered as a dictionary, if the names of all the its fields are infered (by type inference rules) into the same non-string primitive type.""" - + do jsonProvTy.AddXmlDoc helpText do jsonProvTy.DefineStaticParameters(parameters, buildTypes) - + // Register the main type with F# compiler do this.AddNamespace(ns, [ jsonProvTy ]) diff --git a/src/Json/JsonRuntime.fs b/src/Json/JsonRuntime.fs index 840d56f03..0c121bd9a 100644 --- a/src/Json/JsonRuntime.fs +++ b/src/Json/JsonRuntime.fs @@ -12,66 +12,90 @@ open FSharp.Data.Runtime /// type IJsonDocument = - abstract JsonValue : JsonValue + abstract JsonValue: JsonValue + [] - [] - abstract Path : unit -> string + [] + abstract Path: unit -> string + [] - [] - abstract CreateNew : value:JsonValue * pathIncrement:string -> IJsonDocument + [] + abstract CreateNew: value: JsonValue * pathIncrement: string -> IJsonDocument /// Underlying representation of types generated by JsonProvider /// /// Contains the runtime base types used by generated row types for FSharp.Data type providers. /// [] -type JsonDocument = +type JsonDocument = - private { /// - Json : JsonValue + private + { + /// + Json: JsonValue /// - Path : string } + Path: string + } - interface IJsonDocument with + interface IJsonDocument with + member x.JsonValue = x.Json + member x.Path() = x.Path + + member x.CreateNew(value, pathIncrement) = + JsonDocument.Create(value, x.Path + pathIncrement) + + /// The underlying JsonValue member x.JsonValue = x.Json - member x.Path() = x.Path - member x.CreateNew(value, pathIncrement) = - JsonDocument.Create(value, x.Path + pathIncrement) - - /// The underlying JsonValue - member x.JsonValue = x.Json - - /// - [] - [] - override x.ToString() = x.JsonValue.ToString() - - /// - [] - [] - static member Create(value, path) = - { Json = value - Path = path } :> IJsonDocument - - /// - [] - [] - static member Create(reader:TextReader) = - use reader = reader - let text = reader.ReadToEnd() - let value = JsonValue.Parse(text) - JsonDocument.Create(value, "") - - /// - [] - [] - static member CreateList(reader:TextReader) = - use reader = reader - let text = reader.ReadToEnd() - match JsonValue.ParseMultiple(text) |> Seq.toArray with - | [| JsonValue.Array array |] -> array - | array -> array - |> Array.mapi (fun i value -> JsonDocument.Create(value, "[" + (string i) + "]")) + + /// + [] + [] + override x.ToString() = x.JsonValue.ToString() + + /// + [] + [] + static member Create(value, path) = + { Json = value; Path = path } :> IJsonDocument + + /// + [] + [] + static member Create(reader: TextReader) = + use reader = reader + let text = reader.ReadToEnd() + let value = JsonValue.Parse(text) + JsonDocument.Create(value, "") + + /// + [] + [] + static member CreateList(reader: TextReader) = + use reader = reader + let text = reader.ReadToEnd() + + match JsonValue.ParseMultiple(text) |> Seq.toArray with + | [| JsonValue.Array array |] -> array + | array -> array + |> Array.mapi (fun i value -> JsonDocument.Create(value, "[" + (string i) + "]")) // -------------------------------------------------------------------------------------- @@ -86,288 +110,403 @@ open FSharp.Data.Runtime.BaseTypes open FSharp.Data.Runtime.StructuralTypes /// -type JsonValueOptionAndPath = - { JsonOpt : JsonValue option - Path : string } +type JsonValueOptionAndPath = + { JsonOpt: JsonValue option + Path: string } /// Static helper methods called from the generated code for working with JSON -type JsonRuntime = - - // -------------------------------------------------------------------------------------- - // json option -> type - - static member ConvertString(cultureStr, json) = - json |> Option.bind (JsonConversions.AsString true (TextRuntime.GetCulture cultureStr)) - - static member ConvertInteger(cultureStr, json) = - json |> Option.bind (JsonConversions.AsInteger (TextRuntime.GetCulture cultureStr)) - - static member ConvertInteger64(cultureStr, json) = - json |> Option.bind (JsonConversions.AsInteger64 (TextRuntime.GetCulture cultureStr)) - - static member ConvertDecimal(cultureStr, json) = - json |> Option.bind (JsonConversions.AsDecimal (TextRuntime.GetCulture cultureStr)) - - static member ConvertFloat(cultureStr, missingValuesStr, json) = - json |> Option.bind (JsonConversions.AsFloat (TextRuntime.GetMissingValues missingValuesStr) - true - (TextRuntime.GetCulture cultureStr)) - - static member ConvertBoolean(json) = - json |> Option.bind JsonConversions.AsBoolean - - static member ConvertDateTimeOffset(cultureStr, json) = - json |> Option.bind (JsonConversions.AsDateTimeOffset (TextRuntime.GetCulture cultureStr)) - - static member ConvertDateTime(cultureStr, json) = - json |> Option.bind (JsonConversions.AsDateTime (TextRuntime.GetCulture cultureStr)) - - static member ConvertTimeSpan(cultureStr, json) = - json |> Option.bind (JsonConversions.AsTimeSpan (TextRuntime.GetCulture cultureStr)) - - static member ConvertGuid(json) = - json |> Option.bind JsonConversions.AsGuid - - /// Operation that extracts the value from an option and reports a meaningful error message when the value is not there - /// If the originalValue is a scalar, for missing strings we return "", and for missing doubles we return NaN - /// For other types an error is thrown - static member GetNonOptionalValue<'T>(path:string, opt:option<'T>, originalValue) : 'T = - let getTypeName() = - let name = typeof<'T>.Name - if name.StartsWith("i", StringComparison.OrdinalIgnoreCase) - then "an " + name - else "a " + name - match opt, originalValue with - | Some value, _ -> value - | None, Some ((JsonValue.Array _ | JsonValue.Record _) as x) -> failwithf "Expecting %s at '%s', got %s" (getTypeName()) path <| x.ToString(JsonSaveOptions.DisableFormatting) - | None, _ when typeof<'T> = typeof -> "" |> unbox - | None, _ when typeof<'T> = typeof -> Double.NaN |> unbox - | None, None -> failwithf "'%s' is missing" path - | None, Some x -> failwithf "Expecting %s at '%s', got %s" (getTypeName()) path <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Converts JSON array to array of target types - static member ConvertArray<'T>(doc:IJsonDocument, mapping:Func) = - match doc.JsonValue with - | JsonValue.Array elements -> - elements - |> Array.filter (function JsonValue.Null -> false - | JsonValue.String s when s |> TextConversions.AsString |> Option.isNone -> false - | _ -> true) - |> Array.mapi (fun i value -> doc.CreateNew(value, "[" + (string i) + "]") |> mapping.Invoke) - | JsonValue.Null -> [| |] - | x -> failwithf "Expecting an array at '%s', got %s" (doc.Path()) <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Get properties of the record - static member GetRecordProperties(doc:IJsonDocument) = - match doc.JsonValue with - | JsonValue.Record items -> items - | JsonValue.Null -> [||] - | x -> failwithf "Expecting a record at '%s', got %s" (doc.Path()) <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Converts JSON record to dictionary - static member ConvertRecordToDictionary<'Key, 'Value when 'Key: equality>(doc:IJsonDocument, mappingKey:Func, mappingValue:Func) = - JsonRuntime.GetRecordProperties(doc) - |> Seq.map (fun (k, v) -> - let key = doc.CreateNew(JsonValue.String k, k) |> mappingKey.Invoke - let value = doc.CreateNew(v, k) |> mappingValue.Invoke - key, value) - - - /// Get a value by the key from infered dictionary - static member InferedDictionaryContainsKey<'Key when 'Key: equality>(doc:IJsonDocument, mappingKey:Func, key: 'Key) = - let finder (k, _) = - (doc.CreateNew(JsonValue.String k, k) |> mappingKey.Invoke) = key - (JsonRuntime.GetRecordProperties(doc) |> Array.tryFind finder).IsSome - - /// Try get a value by the key from infered dictionary - static member TryGetValueByKeyFromInferedDictionary<'Key, 'Value when 'Key: equality>(doc:IJsonDocument, mappingKey:Func, mappingValue:Func, key: 'Key) = - let picker (k, v) = - if (doc.CreateNew(JsonValue.String k, k) |> mappingKey.Invoke) = key then - doc.CreateNew(v, k) |> mappingValue.Invoke |> Some - else - None - JsonRuntime.GetRecordProperties(doc) |> Array.tryPick picker - - /// Get a value by the key from infered dictionary - static member GetValueByKeyFromInferedDictionary<'Key, 'Value when 'Key: equality>(doc:IJsonDocument, mappingKey:Func, mappingValue:Func, key: 'Key) = - match JsonRuntime.TryGetValueByKeyFromInferedDictionary(doc, mappingKey, mappingValue, key) with - | Some value -> value - | _ -> key - |> sprintf "The given key '%A' was not present in the dictionary." - |> System.Collections.Generic.KeyNotFoundException +type JsonRuntime = + + // -------------------------------------------------------------------------------------- + // json option -> type + + static member ConvertString(cultureStr, json) = + json + |> Option.bind (JsonConversions.AsString true (TextRuntime.GetCulture cultureStr)) + + static member ConvertInteger(cultureStr, json) = + json + |> Option.bind (JsonConversions.AsInteger(TextRuntime.GetCulture cultureStr)) + + static member ConvertInteger64(cultureStr, json) = + json + |> Option.bind (JsonConversions.AsInteger64(TextRuntime.GetCulture cultureStr)) + + static member ConvertDecimal(cultureStr, json) = + json + |> Option.bind (JsonConversions.AsDecimal(TextRuntime.GetCulture cultureStr)) + + static member ConvertFloat(cultureStr, missingValuesStr, json) = + json + |> Option.bind ( + JsonConversions.AsFloat + (TextRuntime.GetMissingValues missingValuesStr) + true + (TextRuntime.GetCulture cultureStr) + ) + + static member ConvertBoolean(json) = + json |> Option.bind JsonConversions.AsBoolean + + static member ConvertDateTimeOffset(cultureStr, json) = + json + |> Option.bind (JsonConversions.AsDateTimeOffset(TextRuntime.GetCulture cultureStr)) + + static member ConvertDateTime(cultureStr, json) = + json + |> Option.bind (JsonConversions.AsDateTime(TextRuntime.GetCulture cultureStr)) + + static member ConvertTimeSpan(cultureStr, json) = + json + |> Option.bind (JsonConversions.AsTimeSpan(TextRuntime.GetCulture cultureStr)) + + static member ConvertGuid(json) = + json |> Option.bind JsonConversions.AsGuid + + /// Operation that extracts the value from an option and reports a meaningful error message when the value is not there + /// If the originalValue is a scalar, for missing strings we return "", and for missing doubles we return NaN + /// For other types an error is thrown + static member GetNonOptionalValue<'T>(path: string, opt: option<'T>, originalValue) : 'T = + let getTypeName () = + let name = typeof<'T>.Name + + if name.StartsWith("i", StringComparison.OrdinalIgnoreCase) then + "an " + name + else + "a " + name + + match opt, originalValue with + | Some value, _ -> value + | None, + Some ((JsonValue.Array _ + | JsonValue.Record _) as x) -> + failwithf "Expecting %s at '%s', got %s" (getTypeName ()) path + <| x.ToString(JsonSaveOptions.DisableFormatting) + | None, _ when typeof<'T> = typeof -> "" |> unbox + | None, _ when typeof<'T> = typeof -> Double.NaN |> unbox + | None, None -> failwithf "'%s' is missing" path + | None, Some x -> + failwithf "Expecting %s at '%s', got %s" (getTypeName ()) path + <| x.ToString(JsonSaveOptions.DisableFormatting) + + /// Converts JSON array to array of target types + static member ConvertArray<'T>(doc: IJsonDocument, mapping: Func) = + match doc.JsonValue with + | JsonValue.Array elements -> + elements + |> Array.filter (function + | JsonValue.Null -> false + | JsonValue.String s when s |> TextConversions.AsString |> Option.isNone -> false + | _ -> true) + |> Array.mapi (fun i value -> + doc.CreateNew(value, "[" + (string i) + "]") + |> mapping.Invoke) + | JsonValue.Null -> [||] + | x -> + failwithf "Expecting an array at '%s', got %s" (doc.Path()) + <| x.ToString(JsonSaveOptions.DisableFormatting) + + /// Get properties of the record + static member GetRecordProperties(doc: IJsonDocument) = + match doc.JsonValue with + | JsonValue.Record items -> items + | JsonValue.Null -> [||] + | x -> + failwithf "Expecting a record at '%s', got %s" (doc.Path()) + <| x.ToString(JsonSaveOptions.DisableFormatting) + + /// Converts JSON record to dictionary + static member ConvertRecordToDictionary<'Key, 'Value when 'Key: equality> + ( + doc: IJsonDocument, + mappingKey: Func, + mappingValue: Func + ) = + JsonRuntime.GetRecordProperties(doc) + |> Seq.map (fun (k, v) -> + let key = + doc.CreateNew(JsonValue.String k, k) + |> mappingKey.Invoke + + let value = doc.CreateNew(v, k) |> mappingValue.Invoke + key, value) + + + /// Get a value by the key from infered dictionary + static member InferedDictionaryContainsKey<'Key when 'Key: equality> + ( + doc: IJsonDocument, + mappingKey: Func, + key: 'Key + ) = + let finder (k, _) = + (doc.CreateNew(JsonValue.String k, k) + |> mappingKey.Invoke) = key + + (JsonRuntime.GetRecordProperties(doc) + |> Array.tryFind finder) + .IsSome + + /// Try get a value by the key from infered dictionary + static member TryGetValueByKeyFromInferedDictionary<'Key, 'Value when 'Key: equality> + ( + doc: IJsonDocument, + mappingKey: Func, + mappingValue: Func, + key: 'Key + ) = + let picker (k, v) = + if (doc.CreateNew(JsonValue.String k, k) + |> mappingKey.Invoke) = key then + doc.CreateNew(v, k) |> mappingValue.Invoke |> Some + else + None + + JsonRuntime.GetRecordProperties(doc) + |> Array.tryPick picker + + /// Get a value by the key from infered dictionary + static member GetValueByKeyFromInferedDictionary<'Key, 'Value when 'Key: equality> + ( + doc: IJsonDocument, + mappingKey: Func, + mappingValue: Func, + key: 'Key + ) = + match JsonRuntime.TryGetValueByKeyFromInferedDictionary(doc, mappingKey, mappingValue, key) with + | Some value -> value + | _ -> + key + |> sprintf "The given key '%A' was not present in the dictionary." + |> System.Collections.Generic.KeyNotFoundException |> raise - - /// Get keys from infered dictionary - static member GetKeysFromInferedDictionary<'Key when 'Key: equality>(doc:IJsonDocument, mappingKey:Func) = - JsonRuntime.GetRecordProperties(doc) - |> Array.map (fun (k, _) -> doc.CreateNew(JsonValue.String k, k) |> mappingKey.Invoke) - - /// Get values from infered dictionary - static member GetValuesFromInferedDictionary<'Value>(doc:IJsonDocument, mappingValue:Func) = - JsonRuntime.GetRecordProperties(doc) - |> Array.map (fun (k, v) -> doc.CreateNew(v, k) |> mappingValue.Invoke) - - /// Get optional json property - static member TryGetPropertyUnpacked(doc:IJsonDocument, name) = - doc.JsonValue.TryGetProperty(name) - |> Option.bind (function JsonValue.Null | JsonValue.String "" -> None | x -> Some x) - - /// Get optional json property and wrap it together with path - static member TryGetPropertyUnpackedWithPath(doc:IJsonDocument, name) = - { JsonOpt = JsonRuntime.TryGetPropertyUnpacked(doc, name) - Path = doc.Path() + "/" + name } - - /// Get optional json property wrapped in json document - static member TryGetPropertyPacked(doc:IJsonDocument, name) = - JsonRuntime.TryGetPropertyUnpacked(doc, name) - |> Option.map (fun value -> doc.CreateNew(value, "/" + name)) - - /// Get json property and wrap in json document - static member GetPropertyPacked(doc:IJsonDocument, name) = - match JsonRuntime.TryGetPropertyPacked(doc, name) with - | Some doc -> doc - | None -> failwithf "Property '%s' not found at '%s': %s" name (doc.Path()) <| doc.JsonValue.ToString(JsonSaveOptions.DisableFormatting) - - /// Get json property and wrap in json document, and return null if not found - static member GetPropertyPackedOrNull(doc:IJsonDocument, name) = - match JsonRuntime.TryGetPropertyPacked(doc, name) with - | Some doc -> doc - | None -> doc.CreateNew(JsonValue.Null, "/" + name) - - /// Get optional json property and convert to a specified type - static member ConvertOptionalProperty<'T>(doc:IJsonDocument, name, mapping:Func) = - JsonRuntime.TryGetPropertyPacked(doc, name) - |> Option.map mapping.Invoke - - static member private Matches cultureStr tag = - match tag with - | InferedTypeTag.Number -> + + /// Get keys from infered dictionary + static member GetKeysFromInferedDictionary<'Key when 'Key: equality> + ( + doc: IJsonDocument, + mappingKey: Func + ) = + JsonRuntime.GetRecordProperties(doc) + |> Array.map (fun (k, _) -> + doc.CreateNew(JsonValue.String k, k) + |> mappingKey.Invoke) + + /// Get values from infered dictionary + static member GetValuesFromInferedDictionary<'Value> + ( + doc: IJsonDocument, + mappingValue: Func + ) = + JsonRuntime.GetRecordProperties(doc) + |> Array.map (fun (k, v) -> doc.CreateNew(v, k) |> mappingValue.Invoke) + + /// Get optional json property + static member TryGetPropertyUnpacked(doc: IJsonDocument, name) = + doc.JsonValue.TryGetProperty(name) + |> Option.bind (function + | JsonValue.Null + | JsonValue.String "" -> None + | x -> Some x) + + /// Get optional json property and wrap it together with path + static member TryGetPropertyUnpackedWithPath(doc: IJsonDocument, name) = + { JsonOpt = JsonRuntime.TryGetPropertyUnpacked(doc, name) + Path = doc.Path() + "/" + name } + + /// Get optional json property wrapped in json document + static member TryGetPropertyPacked(doc: IJsonDocument, name) = + JsonRuntime.TryGetPropertyUnpacked(doc, name) + |> Option.map (fun value -> doc.CreateNew(value, "/" + name)) + + /// Get json property and wrap in json document + static member GetPropertyPacked(doc: IJsonDocument, name) = + match JsonRuntime.TryGetPropertyPacked(doc, name) with + | Some doc -> doc + | None -> + failwithf "Property '%s' not found at '%s': %s" name (doc.Path()) + <| doc.JsonValue.ToString(JsonSaveOptions.DisableFormatting) + + /// Get json property and wrap in json document, and return null if not found + static member GetPropertyPackedOrNull(doc: IJsonDocument, name) = + match JsonRuntime.TryGetPropertyPacked(doc, name) with + | Some doc -> doc + | None -> doc.CreateNew(JsonValue.Null, "/" + name) + + /// Get optional json property and convert to a specified type + static member ConvertOptionalProperty<'T>(doc: IJsonDocument, name, mapping: Func) = + JsonRuntime.TryGetPropertyPacked(doc, name) + |> Option.map mapping.Invoke + + static member private Matches cultureStr tag = + match tag with + | InferedTypeTag.Number -> + let cultureInfo = TextRuntime.GetCulture cultureStr + + fun json -> + (JsonConversions.AsDecimal cultureInfo json).IsSome + || (JsonConversions.AsFloat [||] true cultureInfo json).IsSome + | InferedTypeTag.Boolean -> JsonConversions.AsBoolean >> Option.isSome + | InferedTypeTag.String -> + JsonConversions.AsString true (TextRuntime.GetCulture cultureStr) + >> Option.isSome + | InferedTypeTag.DateTime -> + let cultureInfo = TextRuntime.GetCulture cultureStr + + fun json -> + (JsonConversions.AsDateTimeOffset cultureInfo json).IsSome + || (JsonConversions.AsDateTime cultureInfo json).IsSome + | InferedTypeTag.DateTimeOffset -> + let cultureInfo = TextRuntime.GetCulture cultureStr + fun json -> (JsonConversions.AsDateTimeOffset cultureInfo json).IsSome + | InferedTypeTag.TimeSpan -> + JsonConversions.AsTimeSpan(TextRuntime.GetCulture cultureStr) + >> Option.isSome + | InferedTypeTag.Guid -> JsonConversions.AsGuid >> Option.isSome + | InferedTypeTag.Collection -> + function + | JsonValue.Array _ -> true + | _ -> false + | InferedTypeTag.Record _ -> + function + | JsonValue.Record _ -> true + | _ -> false + | InferedTypeTag.Json -> failwith "Json type not supported" + | InferedTypeTag.Null -> failwith "Null type not supported" + | InferedTypeTag.Heterogeneous -> failwith "Heterogeneous type not supported" + + /// Returns all array values that match the specified tag + static member GetArrayChildrenByTypeTag<'T> + ( + doc: IJsonDocument, + cultureStr, + tagCode, + mapping: Func + ) = + match doc.JsonValue with + | JsonValue.Array elements -> + elements + |> Array.filter (JsonRuntime.Matches cultureStr (InferedTypeTag.ParseCode tagCode)) + |> Array.mapi (fun i value -> + doc.CreateNew(value, "[" + (string i) + "]") + |> mapping.Invoke) + | JsonValue.Null -> [||] + | x -> + failwithf "Expecting an array at '%s', got %s" (doc.Path()) + <| x.ToString(JsonSaveOptions.DisableFormatting) + + /// Returns single or no value from an array matching the specified tag + static member TryGetArrayChildByTypeTag<'T>(doc, cultureStr, tagCode, mapping: Func) = + match JsonRuntime.GetArrayChildrenByTypeTag(doc, cultureStr, tagCode, mapping) with + | [| child |] -> Some child + | [||] -> None + | _ -> + failwithf "Expecting an array with single or no elements at '%s', got %s" (doc.Path()) + <| doc.JsonValue.ToString(JsonSaveOptions.DisableFormatting) + + /// Returns a single array children that matches the specified tag + static member GetArrayChildByTypeTag(doc, cultureStr, tagCode) = + match JsonRuntime.GetArrayChildrenByTypeTag(doc, cultureStr, tagCode, Func<_, _>(id)) with + | [| child |] -> child + | _ -> + failwithf "Expecting an array with single element at '%s', got %s" (doc.Path()) + <| doc.JsonValue.ToString(JsonSaveOptions.DisableFormatting) + + /// Returns a single or no value by tag type + static member TryGetValueByTypeTag<'T>(doc: IJsonDocument, cultureStr, tagCode, mapping: Func) = + if JsonRuntime.Matches cultureStr (InferedTypeTag.ParseCode tagCode) doc.JsonValue then + Some(mapping.Invoke doc) + else + None + + static member private ToJsonValue (cultureInfo: CultureInfo) (value: obj) = + let inline optionToJson f = + function + | None -> JsonValue.Null + | Some v -> f v + + match value with + | null -> JsonValue.Null + | :? Array as v -> JsonValue.Array [| for elem in v -> JsonRuntime.ToJsonValue cultureInfo elem |] + + | :? string as v -> JsonValue.String v + | :? DateTime as v -> v.ToString("O", cultureInfo) |> JsonValue.String + | :? DateTimeOffset as v -> v.ToString("O", cultureInfo) |> JsonValue.String + | :? TimeSpan as v -> v.ToString("g", cultureInfo) |> JsonValue.String + | :? int as v -> JsonValue.Number(decimal v) + | :? int64 as v -> JsonValue.Number(decimal v) + | :? float as v -> JsonValue.Number(decimal v) + | :? decimal as v -> JsonValue.Number v + | :? bool as v -> JsonValue.Boolean v + | :? Guid as v -> v.ToString() |> JsonValue.String + | :? IJsonDocument as v -> v.JsonValue + | :? JsonValue as v -> v + + | :? option as v -> optionToJson JsonValue.String v + | :? option as v -> + optionToJson (fun (dt: DateTime) -> dt.ToString(cultureInfo) |> JsonValue.String) v + | :? option as v -> + optionToJson (fun (dt: DateTimeOffset) -> dt.ToString(cultureInfo) |> JsonValue.String) v + | :? option as v -> + optionToJson (fun (ts: TimeSpan) -> ts.ToString("g", cultureInfo) |> JsonValue.String) v + | :? option as v -> optionToJson (decimal >> JsonValue.Number) v + | :? option as v -> optionToJson (decimal >> JsonValue.Number) v + | :? option as v -> optionToJson (decimal >> JsonValue.Number) v + | :? option as v -> optionToJson JsonValue.Number v + | :? option as v -> optionToJson JsonValue.Boolean v + | :? option as v -> optionToJson (fun (g: Guid) -> g.ToString() |> JsonValue.String) v + | :? option as v -> optionToJson (fun (v: IJsonDocument) -> v.JsonValue) v + | :? option as v -> optionToJson id v + + | _ -> failwithf "Can't create JsonValue from %A" value + + /// Creates a scalar JsonValue and wraps it in a json document + static member CreateValue(value: obj, cultureStr) = + let cultureInfo = TextRuntime.GetCulture cultureStr + let json = JsonRuntime.ToJsonValue cultureInfo value + JsonDocument.Create(json, "") + + // Creates a JsonValue.Record and wraps it in a json document + static member CreateRecord(properties, cultureStr) = let cultureInfo = TextRuntime.GetCulture cultureStr - fun json -> (JsonConversions.AsDecimal cultureInfo json).IsSome || - (JsonConversions.AsFloat [| |] true cultureInfo json).IsSome - | InferedTypeTag.Boolean -> - JsonConversions.AsBoolean >> Option.isSome - | InferedTypeTag.String -> - JsonConversions.AsString true (TextRuntime.GetCulture cultureStr) - >> Option.isSome - | InferedTypeTag.DateTime -> + + let json = + properties + |> Array.map (fun (k, v: obj) -> k, JsonRuntime.ToJsonValue cultureInfo v) + |> JsonValue.Record + + JsonDocument.Create(json, "") + + // Creates a JsonValue.Record from key*value seq and wraps it in a json document + static member CreateRecordFromDictionary<'Key, 'Value when 'Key: equality> + ( + keyValuePairs: ('Key * 'Value) seq, + cultureStr, + mappingKeyBack: Func<'Key, string> + ) = let cultureInfo = TextRuntime.GetCulture cultureStr - fun json -> (JsonConversions.AsDateTimeOffset cultureInfo json).IsSome || - (JsonConversions.AsDateTime cultureInfo json).IsSome - | InferedTypeTag.DateTimeOffset -> + + let json = + keyValuePairs + |> Seq.map (fun (k, v) -> (k |> mappingKeyBack.Invoke), JsonRuntime.ToJsonValue cultureInfo (v :> obj)) + |> Seq.toArray + |> JsonValue.Record + + JsonDocument.Create(json, "") + + /// Creates a scalar JsonValue.Array and wraps it in a json document + static member CreateArray(elements: obj[], cultureStr) = let cultureInfo = TextRuntime.GetCulture cultureStr - fun json -> (JsonConversions.AsDateTimeOffset cultureInfo json).IsSome - | InferedTypeTag.TimeSpan -> - JsonConversions.AsTimeSpan (TextRuntime.GetCulture cultureStr) - >> Option.isSome - | InferedTypeTag.Guid -> - JsonConversions.AsGuid >> Option.isSome - | InferedTypeTag.Collection -> - function JsonValue.Array _ -> true | _ -> false - | InferedTypeTag.Record _ -> - function JsonValue.Record _ -> true | _ -> false - | InferedTypeTag.Json -> - failwith "Json type not supported" - | InferedTypeTag.Null -> - failwith "Null type not supported" - | InferedTypeTag.Heterogeneous -> - failwith "Heterogeneous type not supported" - - /// Returns all array values that match the specified tag - static member GetArrayChildrenByTypeTag<'T>(doc:IJsonDocument, cultureStr, tagCode, mapping:Func) = - match doc.JsonValue with - | JsonValue.Array elements -> - elements - |> Array.filter (JsonRuntime.Matches cultureStr (InferedTypeTag.ParseCode tagCode)) - |> Array.mapi (fun i value -> doc.CreateNew(value, "[" + (string i) + "]") |> mapping.Invoke) - | JsonValue.Null -> [| |] - | x -> failwithf "Expecting an array at '%s', got %s" (doc.Path()) <| x.ToString(JsonSaveOptions.DisableFormatting) - - /// Returns single or no value from an array matching the specified tag - static member TryGetArrayChildByTypeTag<'T>(doc, cultureStr, tagCode, mapping:Func) = - match JsonRuntime.GetArrayChildrenByTypeTag(doc, cultureStr, tagCode, mapping) with - | [| child |] -> Some child - | [| |] -> None - | _ -> failwithf "Expecting an array with single or no elements at '%s', got %s" (doc.Path()) <| doc.JsonValue.ToString(JsonSaveOptions.DisableFormatting) - - /// Returns a single array children that matches the specified tag - static member GetArrayChildByTypeTag(doc, cultureStr, tagCode) = - match JsonRuntime.GetArrayChildrenByTypeTag(doc, cultureStr, tagCode, Func<_,_>(id)) with - | [| child |] -> child - | _ -> failwithf "Expecting an array with single element at '%s', got %s" (doc.Path()) <| doc.JsonValue.ToString(JsonSaveOptions.DisableFormatting) - - /// Returns a single or no value by tag type - static member TryGetValueByTypeTag<'T>(doc:IJsonDocument, cultureStr, tagCode, mapping:Func) = - if JsonRuntime.Matches cultureStr (InferedTypeTag.ParseCode tagCode) doc.JsonValue - then Some (mapping.Invoke doc) - else None - - static member private ToJsonValue (cultureInfo:CultureInfo) (value:obj) = - let inline optionToJson f = function None -> JsonValue.Null | Some v -> f v - match value with - | null -> JsonValue.Null - | :? Array as v -> JsonValue.Array [| for elem in v -> JsonRuntime.ToJsonValue cultureInfo elem |] - - | :? string as v -> JsonValue.String v - | :? DateTime as v -> v.ToString("O", cultureInfo) |> JsonValue.String - | :? DateTimeOffset as v -> v.ToString("O", cultureInfo) |> JsonValue.String - | :? TimeSpan as v -> v.ToString("g", cultureInfo) |> JsonValue.String - | :? int as v -> JsonValue.Number(decimal v) - | :? int64 as v -> JsonValue.Number(decimal v) - | :? float as v -> JsonValue.Number(decimal v) - | :? decimal as v -> JsonValue.Number v - | :? bool as v -> JsonValue.Boolean v - | :? Guid as v -> v.ToString() |> JsonValue.String - | :? IJsonDocument as v -> v.JsonValue - | :? JsonValue as v -> v - - | :? option as v -> optionToJson JsonValue.String v - | :? option as v -> optionToJson (fun (dt:DateTime) -> dt.ToString(cultureInfo) |> JsonValue.String) v - | :? option as v -> optionToJson (fun (dt:DateTimeOffset) -> dt.ToString(cultureInfo) |> JsonValue.String) v - | :? option as v -> optionToJson (fun (ts:TimeSpan) -> ts.ToString("g", cultureInfo) |> JsonValue.String) v - | :? option as v -> optionToJson (decimal >> JsonValue.Number) v - | :? option as v -> optionToJson (decimal >> JsonValue.Number) v - | :? option as v -> optionToJson (decimal >> JsonValue.Number) v - | :? option as v -> optionToJson JsonValue.Number v - | :? option as v -> optionToJson JsonValue.Boolean v - | :? option as v -> optionToJson (fun (g:Guid) -> g.ToString() |> JsonValue.String) v - | :? option as v -> optionToJson (fun (v:IJsonDocument) -> v.JsonValue) v - | :? option as v -> optionToJson id v - - | _ -> failwithf "Can't create JsonValue from %A" value - - /// Creates a scalar JsonValue and wraps it in a json document - static member CreateValue(value:obj, cultureStr) = - let cultureInfo = TextRuntime.GetCulture cultureStr - let json = JsonRuntime.ToJsonValue cultureInfo value - JsonDocument.Create(json, "") - - // Creates a JsonValue.Record and wraps it in a json document - static member CreateRecord(properties, cultureStr) = - let cultureInfo = TextRuntime.GetCulture cultureStr - let json = - properties - |> Array.map (fun (k, v:obj) -> k, JsonRuntime.ToJsonValue cultureInfo v) - |> JsonValue.Record - JsonDocument.Create(json, "") - - // Creates a JsonValue.Record from key*value seq and wraps it in a json document - static member CreateRecordFromDictionary<'Key, 'Value when 'Key: equality>(keyValuePairs: ('Key * 'Value) seq, cultureStr, mappingKeyBack: Func<'Key, string>) = - let cultureInfo = TextRuntime.GetCulture cultureStr - let json = - keyValuePairs - |> Seq.map (fun (k, v) -> (k |> mappingKeyBack.Invoke), JsonRuntime.ToJsonValue cultureInfo (v :> obj)) - |> Seq.toArray - |> JsonValue.Record - JsonDocument.Create(json, "") - - /// Creates a scalar JsonValue.Array and wraps it in a json document - static member CreateArray(elements:obj[], cultureStr) = - let cultureInfo = TextRuntime.GetCulture cultureStr - let json = - elements - |> Array.collect (JsonRuntime.ToJsonValue cultureInfo - >> - function JsonValue.Array elements -> elements | JsonValue.Null -> [| |] | element -> [| element |]) - |> JsonValue.Array - JsonDocument.Create(json, "") + + let json = + elements + |> Array.collect ( + JsonRuntime.ToJsonValue cultureInfo + >> function + | JsonValue.Array elements -> elements + | JsonValue.Null -> [||] + | element -> [| element |] + ) + |> JsonValue.Array + + JsonDocument.Create(json, "") diff --git a/src/Json/JsonValue.fs b/src/Json/JsonValue.fs index e66051145..557381c48 100644 --- a/src/Json/JsonValue.fs +++ b/src/Json/JsonValue.fs @@ -32,163 +32,190 @@ type JsonSaveOptions = [] [] type JsonValue = - | String of string - | Number of decimal - | Float of float - | Record of properties:(string * JsonValue)[] - | Array of elements:JsonValue[] - | Boolean of bool - | Null - - /// - [] - [] - member x._Print = - let str = x.ToString() - if str.Length > 512 then str.Substring(0, 509) + "..." - else str - - /// Serializes the JsonValue to the specified System.IO.TextWriter. - member x.WriteTo (w:TextWriter, saveOptions) = - - let newLine = - if saveOptions = JsonSaveOptions.None then - fun indentation plus -> - w.WriteLine() - System.String(' ', indentation + plus) |> w.Write - else - fun _ _ -> () - - let propSep = - if saveOptions = JsonSaveOptions.None then "\": " - else "\":" - - let rec serialize indentation = function - | Null -> w.Write "null" - | Boolean b -> w.Write(if b then "true" else "false") - | Number number -> w.Write number - | Float v when Double.IsInfinity v || Double.IsNaN v -> w.Write "null" - | Float number -> w.Write number - | String s -> - w.Write "\"" - JsonValue.JsonStringEncodeTo w s - w.Write "\"" - | Record properties -> - w.Write "{" - for i = 0 to properties.Length - 1 do - let k,v = properties.[i] - if i > 0 then w.Write "," - newLine indentation 2 - w.Write "\"" - JsonValue.JsonStringEncodeTo w k - w.Write propSep - serialize (indentation + 2) v - newLine indentation 0 - w.Write "}" - | Array elements -> - w.Write "[" - for i = 0 to elements.Length - 1 do - if i > 0 then w.Write "," - newLine indentation 2 - serialize (indentation + 2) elements.[i] - if elements.Length > 0 then - newLine indentation 0 - w.Write "]" - - serialize 0 x - - // Encode characters that are not valid in JS string. The implementation is based - // on https://github.com/mono/mono/blob/master/mcs/class/System.Web/System.Web/HttpUtility.cs - static member internal JsonStringEncodeTo (w:TextWriter) (value:string) = - if not (String.IsNullOrEmpty value) then - for i = 0 to value.Length - 1 do - let c = value.[i] - let ci = int c - if ci >= 0 && ci <= 7 || ci = 11 || ci >= 14 && ci <= 31 then - w.Write("\\u{0:x4}", ci) |> ignore - else - match c with - | '\b' -> w.Write "\\b" - | '\t' -> w.Write "\\t" - | '\n' -> w.Write "\\n" - | '\f' -> w.Write "\\f" - | '\r' -> w.Write "\\r" - | '"' -> w.Write "\\\"" - | '\\' -> w.Write "\\\\" - | _ -> w.Write c - - member x.ToString saveOptions = - let w = new StringWriter(CultureInfo.InvariantCulture) - x.WriteTo(w, saveOptions) - w.GetStringBuilder().ToString() - - override x.ToString() = x.ToString(JsonSaveOptions.None) + | String of string + | Number of decimal + | Float of float + | Record of properties: (string * JsonValue)[] + | Array of elements: JsonValue[] + | Boolean of bool + | Null + + /// + [] + [] + member x._Print = + let str = x.ToString() + + if str.Length > 512 then + str.Substring(0, 509) + "..." + else + str + + /// Serializes the JsonValue to the specified System.IO.TextWriter. + member x.WriteTo(w: TextWriter, saveOptions) = + + let newLine = + if saveOptions = JsonSaveOptions.None then + fun indentation plus -> + w.WriteLine() + System.String(' ', indentation + plus) |> w.Write + else + fun _ _ -> () + + let propSep = if saveOptions = JsonSaveOptions.None then "\": " else "\":" + + let rec serialize indentation = + function + | Null -> w.Write "null" + | Boolean b -> w.Write(if b then "true" else "false") + | Number number -> w.Write number + | Float v when Double.IsInfinity v || Double.IsNaN v -> w.Write "null" + | Float number -> w.Write number + | String s -> + w.Write "\"" + JsonValue.JsonStringEncodeTo w s + w.Write "\"" + | Record properties -> + w.Write "{" + + for i = 0 to properties.Length - 1 do + let k, v = properties.[i] + if i > 0 then w.Write "," + newLine indentation 2 + w.Write "\"" + JsonValue.JsonStringEncodeTo w k + w.Write propSep + serialize (indentation + 2) v + + newLine indentation 0 + w.Write "}" + | Array elements -> + w.Write "[" + + for i = 0 to elements.Length - 1 do + if i > 0 then w.Write "," + newLine indentation 2 + serialize (indentation + 2) elements.[i] + + if elements.Length > 0 then newLine indentation 0 + w.Write "]" + + serialize 0 x + + // Encode characters that are not valid in JS string. The implementation is based + // on https://github.com/mono/mono/blob/master/mcs/class/System.Web/System.Web/HttpUtility.cs + static member internal JsonStringEncodeTo (w: TextWriter) (value: string) = + if not (String.IsNullOrEmpty value) then + for i = 0 to value.Length - 1 do + let c = value.[i] + let ci = int c + + if ci >= 0 && ci <= 7 + || ci = 11 + || ci >= 14 && ci <= 31 then + w.Write("\\u{0:x4}", ci) |> ignore + else + match c with + | '\b' -> w.Write "\\b" + | '\t' -> w.Write "\\t" + | '\n' -> w.Write "\\n" + | '\f' -> w.Write "\\f" + | '\r' -> w.Write "\\r" + | '"' -> w.Write "\\\"" + | '\\' -> w.Write "\\\\" + | _ -> w.Write c + + member x.ToString saveOptions = + let w = new StringWriter(CultureInfo.InvariantCulture) + x.WriteTo(w, saveOptions) + w.GetStringBuilder().ToString() + + override x.ToString() = x.ToString(JsonSaveOptions.None) /// [] module JsonValue = - /// Active Pattern to view a `JsonValue.Record of (string * JsonValue)[]` as a `JsonValue.Object of Map` for - /// backwards compatibility reaons - [] - let (|Object|_|) x = - match x with - | JsonValue.Record properties -> Map.ofArray properties |> Some - | _ -> None + /// Active Pattern to view a `JsonValue.Record of (string * JsonValue)[]` as a `JsonValue.Object of Map` for + /// backwards compatibility reaons + [] + let (|Object|_|) x = + match x with + | JsonValue.Record properties -> Map.ofArray properties |> Some + | _ -> None - /// Constructor to create a `JsonValue.Record of (string * JsonValue)[]` as a `JsonValue.Object of Map` for - /// backwards compatibility reaons - [] - let Object = Map.toArray >> JsonValue.Record + /// Constructor to create a `JsonValue.Record of (string * JsonValue)[]` as a `JsonValue.Object of Map` for + /// backwards compatibility reaons + [] + let Object = Map.toArray >> JsonValue.Record // -------------------------------------------------------------------------------------- // JSON parser // -------------------------------------------------------------------------------------- -type private JsonParser(jsonText:string) = +type private JsonParser(jsonText: string) = let mutable i = 0 let s = jsonText - + let buf = StringBuilder() // pre-allocate buffers for strings // Helper functions - let skipWhitespace() = - while i < s.Length && Char.IsWhiteSpace s.[i] do - i <- i + 1 + let skipWhitespace () = + while i < s.Length && Char.IsWhiteSpace s.[i] do + i <- i + 1 + let isNumChar c = - Char.IsDigit c || c = '.' || c='e' || c='E' || c='+' || c='-' - let throw() = - let msg = - sprintf - "Invalid JSON starting at character %d, snippet = \n----\n%s\n-----\njson = \n------\n%s\n-------" - i (jsonText.[(max 0 (i-10))..(min (jsonText.Length-1) (i+10))]) (if jsonText.Length > 1000 then jsonText.Substring(0, 1000) else jsonText) - failwith msg - let ensure cond = - if not cond then throw() + Char.IsDigit c + || c = '.' + || c = 'e' + || c = 'E' + || c = '+' + || c = '-' + + let throw () = + let msg = + sprintf + "Invalid JSON starting at character %d, snippet = \n----\n%s\n-----\njson = \n------\n%s\n-------" + i + (jsonText.[(max 0 (i - 10)) .. (min (jsonText.Length - 1) (i + 10))]) + (if jsonText.Length > 1000 then + jsonText.Substring(0, 1000) + else + jsonText) + + failwith msg + + let ensure cond = if not cond then throw () // Recursive descent parser for JSON that uses global mutable index let rec parseValue cont = - skipWhitespace() - ensure(i < s.Length) + skipWhitespace () + ensure (i < s.Length) + match s.[i] with - | '"' -> cont (JsonValue.String(parseString())) - | '-' -> cont (parseNum()) - | c when Char.IsDigit(c) -> cont (parseNum()) + | '"' -> cont (JsonValue.String(parseString ())) + | '-' -> cont (parseNum ()) + | c when Char.IsDigit(c) -> cont (parseNum ()) | '{' -> parseObject cont | '[' -> parseArray cont - | 't' -> cont (parseLiteral("true", JsonValue.Boolean true)) - | 'f' -> cont (parseLiteral("false", JsonValue.Boolean false)) - | 'n' -> cont (parseLiteral("null", JsonValue.Null)) - | _ -> throw() + | 't' -> cont (parseLiteral ("true", JsonValue.Boolean true)) + | 'f' -> cont (parseLiteral ("false", JsonValue.Boolean false)) + | 'n' -> cont (parseLiteral ("null", JsonValue.Null)) + | _ -> throw () - and parseString() = - ensure(i < s.Length && s.[i] = '"') + and parseString () = + ensure (i < s.Length && s.[i] = '"') i <- i + 1 + while i < s.Length && s.[i] <> '"' do if s.[i] = '\\' then - ensure(i+1 < s.Length) - match s.[i+1] with + ensure (i + 1 < s.Length) + + match s.[i + 1] with | 'b' -> buf.Append('\b') |> ignore | 'f' -> buf.Append('\f') |> ignore | 'n' -> buf.Append('\n') |> ignore @@ -198,209 +225,236 @@ type private JsonParser(jsonText:string) = | '/' -> buf.Append('/') |> ignore | '"' -> buf.Append('"') |> ignore | 'u' -> - ensure(i+5 < s.Length) + ensure (i + 5 < s.Length) + let hexdigit d = if d >= '0' && d <= '9' then int32 d - int32 '0' elif d >= 'a' && d <= 'f' then int32 d - int32 'a' + 10 elif d >= 'A' && d <= 'F' then int32 d - int32 'A' + 10 else failwith "hexdigit" - let unicodeChar (s:string) = - if s.Length <> 4 then failwith "unicodeChar"; - char (hexdigit s.[0] * 4096 + hexdigit s.[1] * 256 + hexdigit s.[2] * 16 + hexdigit s.[3]) - let ch = unicodeChar (s.Substring(i+2, 4)) + + let unicodeChar (s: string) = + if s.Length <> 4 then failwith "unicodeChar" + + char ( + hexdigit s.[0] * 4096 + + hexdigit s.[1] * 256 + + hexdigit s.[2] * 16 + + hexdigit s.[3] + ) + + let ch = unicodeChar (s.Substring(i + 2, 4)) buf.Append(ch) |> ignore - i <- i + 4 // the \ and u will also be skipped past further below + i <- i + 4 // the \ and u will also be skipped past further below | 'U' -> - ensure(i+9 < s.Length) - let unicodeChar (s:string) = - if s.Length <> 8 then failwith "unicodeChar"; - if s.[0..1] <> "00" then failwith "unicodeChar"; - UnicodeHelper.getUnicodeSurrogatePair <| System.UInt32.Parse(s, NumberStyles.HexNumber) - let lead, trail = unicodeChar (s.Substring(i+2, 8)) + ensure (i + 9 < s.Length) + + let unicodeChar (s: string) = + if s.Length <> 8 then failwith "unicodeChar" + if s.[0..1] <> "00" then failwith "unicodeChar" + + UnicodeHelper.getUnicodeSurrogatePair + <| System.UInt32.Parse(s, NumberStyles.HexNumber) + + let lead, trail = unicodeChar (s.Substring(i + 2, 8)) buf.Append(lead) |> ignore buf.Append(trail) |> ignore - i <- i + 8 // the \ and u will also be skipped past further below - | _ -> throw() - i <- i + 2 // skip past \ and next char + i <- i + 8 // the \ and u will also be skipped past further below + | _ -> throw () + + i <- i + 2 // skip past \ and next char else buf.Append(s.[i]) |> ignore i <- i + 1 - ensure(i < s.Length && s.[i] = '"') + + ensure (i < s.Length && s.[i] = '"') i <- i + 1 let str = buf.ToString() buf.Clear() |> ignore str - and parseNum() = + and parseNum () = let start = i + while i < s.Length && (isNumChar s.[i]) do i <- i + 1 + let len = i - start - let sub = s.Substring(start,len) + let sub = s.Substring(start, len) + match TextConversions.AsDecimal CultureInfo.InvariantCulture sub with | Some x -> JsonValue.Number x | _ -> - match TextConversions.AsFloat [| |] false CultureInfo.InvariantCulture sub with + match TextConversions.AsFloat [||] false CultureInfo.InvariantCulture sub with | Some x -> JsonValue.Float x - | _ -> throw() + | _ -> throw () and parsePair cont = - let key = parseString() - skipWhitespace() - ensure(i < s.Length && s.[i] = ':') + let key = parseString () + skipWhitespace () + ensure (i < s.Length && s.[i] = ':') i <- i + 1 - skipWhitespace() + skipWhitespace () parseValue (fun v -> cont (key, v)) and parseObject cont = - ensure(i < s.Length && s.[i] = '{') + ensure (i < s.Length && s.[i] = '{') i <- i + 1 - skipWhitespace() + skipWhitespace () let pairs = ResizeArray<_>() - let parseObjectEnd() = - ensure(i < s.Length && s.[i] = '}') + + let parseObjectEnd () = + ensure (i < s.Length && s.[i] = '}') i <- i + 1 let res = pairs.ToArray() |> JsonValue.Record cont res + if i < s.Length && s.[i] = '"' then parsePair (fun p -> pairs.Add(p) - skipWhitespace() - let rec parsePairItem() = + skipWhitespace () + + let rec parsePairItem () = if i < s.Length && s.[i] = ',' then i <- i + 1 - skipWhitespace() + skipWhitespace () + parsePair (fun p -> pairs.Add(p) - skipWhitespace() - parsePairItem()) + skipWhitespace () + parsePairItem ()) else - parseObjectEnd() - parsePairItem()) + parseObjectEnd () + + parsePairItem ()) else - parseObjectEnd() + parseObjectEnd () and parseArray cont = - ensure(i < s.Length && s.[i] = '[') + ensure (i < s.Length && s.[i] = '[') i <- i + 1 - skipWhitespace() + skipWhitespace () let vals = ResizeArray<_>() - let parseArrayEnd() = - ensure(i < s.Length && s.[i] = ']') + + let parseArrayEnd () = + ensure (i < s.Length && s.[i] = ']') i <- i + 1 let res = vals.ToArray() |> JsonValue.Array cont res + if i < s.Length && s.[i] <> ']' then parseValue (fun v -> vals.Add(v) - skipWhitespace() - let rec parseArrayItem() = + skipWhitespace () + + let rec parseArrayItem () = if i < s.Length && s.[i] = ',' then i <- i + 1 - skipWhitespace() + skipWhitespace () + parseValue (fun v -> vals.Add(v) - skipWhitespace() - parseArrayItem()) + skipWhitespace () + parseArrayItem ()) else - parseArrayEnd() - parseArrayItem()) + parseArrayEnd () + + parseArrayItem ()) else - parseArrayEnd() + parseArrayEnd () + + and parseLiteral (expected, r) = + ensure (i + expected.Length <= s.Length) - and parseLiteral(expected, r) = - ensure(i+expected.Length <= s.Length) for j in 0 .. expected.Length - 1 do - ensure(s.[i+j] = expected.[j]) + ensure (s.[i + j] = expected.[j]) + i <- i + expected.Length r // Start by parsing the top-level value member x.Parse() = let value = parseValue id - skipWhitespace() - if i <> s.Length then - throw() + skipWhitespace () + if i <> s.Length then throw () value member x.ParseMultiple() = seq { while i <> s.Length do yield parseValue id - skipWhitespace() + skipWhitespace () } type JsonValue with - /// Parses the specified JSON string - static member Parse(text) = - JsonParser(text).Parse() - - /// Attempts to parse the specified JSON string - static member TryParse(text) = - try - Some <| JsonParser(text).Parse() - with - | _ -> None - - /// Loads JSON from the specified stream - static member Load(stream:Stream) = - use reader = new StreamReader(stream) - let text = reader.ReadToEnd() - JsonParser(text).Parse() - - /// Loads JSON from the specified reader - static member Load(reader:TextReader) = - let text = reader.ReadToEnd() - JsonParser(text).Parse() - - /// Loads JSON from the specified uri asynchronously - static member AsyncLoad(uri:string, [] ?encoding) = async { - let encoding = defaultArg encoding Encoding.UTF8 - let! reader = IO.asyncReadTextAtRuntime false "" "" "JSON" encoding.WebName uri - let text = reader.ReadToEnd() - return JsonParser(text).Parse() - } - - /// Loads JSON from the specified uri - static member Load(uri:string, [] ?encoding)= - JsonValue.AsyncLoad(uri, ?encoding=encoding) - |> Async.RunSynchronously - - /// Parses the specified string into multiple JSON values - static member ParseMultiple(text) = - JsonParser(text).ParseMultiple() - - member private x.PrepareRequest (httpMethod, headers) = - let httpMethod = defaultArg httpMethod HttpMethod.Post - let headers = defaultArg (Option.map List.ofSeq headers) [] - let headers = - if headers |> List.exists (fst >> (=) (fst (HttpRequestHeaders.UserAgent ""))) - then headers - else HttpRequestHeaders.UserAgent "FSharp.Data JSON Type Provider" :: headers - let headers = HttpRequestHeaders.ContentTypeWithEncoding (HttpContentTypes.Json, Encoding.UTF8) :: headers - TextRequest (x.ToString(JsonSaveOptions.DisableFormatting)), - headers, - httpMethod - - /// Sends the JSON to the specified URL synchronously. Defaults to a POST request. - member x.Request(url:string, [] ?httpMethod, [] ?headers:seq<_>) = - let body, headers, httpMethod = x.PrepareRequest(httpMethod, headers) - Http.Request( - url, - body = body, - headers = headers, - httpMethod = httpMethod) - - /// Sends the JSON to the specified URL asynchronously. Defaults to a POST request. - member x.RequestAsync(url:string, [] ?httpMethod, [] ?headers:seq<_>) = - let body, headers, httpMethod = x.PrepareRequest(httpMethod, headers) - Http.AsyncRequest( - url, - body = body, - headers = headers, - httpMethod = httpMethod) - - [] - member x.Post(uri:string, [] ?headers) = - x.Request(uri, ?headers = headers) + /// Parses the specified JSON string + static member Parse(text) = JsonParser(text).Parse() + + /// Attempts to parse the specified JSON string + static member TryParse(text) = + try + Some <| JsonParser(text).Parse() + with _ -> + None + + /// Loads JSON from the specified stream + static member Load(stream: Stream) = + use reader = new StreamReader(stream) + let text = reader.ReadToEnd() + JsonParser(text).Parse() + + /// Loads JSON from the specified reader + static member Load(reader: TextReader) = + let text = reader.ReadToEnd() + JsonParser(text).Parse() + + /// Loads JSON from the specified uri asynchronously + static member AsyncLoad(uri: string, [] ?encoding) = + async { + let encoding = defaultArg encoding Encoding.UTF8 + let! reader = IO.asyncReadTextAtRuntime false "" "" "JSON" encoding.WebName uri + let text = reader.ReadToEnd() + return JsonParser(text).Parse() + } + + /// Loads JSON from the specified uri + static member Load(uri: string, [] ?encoding) = + JsonValue.AsyncLoad(uri, ?encoding = encoding) + |> Async.RunSynchronously + + /// Parses the specified string into multiple JSON values + static member ParseMultiple(text) = JsonParser(text).ParseMultiple() + + member private x.PrepareRequest(httpMethod, headers) = + let httpMethod = defaultArg httpMethod HttpMethod.Post + let headers = defaultArg (Option.map List.ofSeq headers) [] + + let headers = + if + headers + |> List.exists (fst >> (=) (fst (HttpRequestHeaders.UserAgent ""))) + then + headers + else + HttpRequestHeaders.UserAgent "FSharp.Data JSON Type Provider" + :: headers + + let headers = + HttpRequestHeaders.ContentTypeWithEncoding(HttpContentTypes.Json, Encoding.UTF8) + :: headers + + TextRequest(x.ToString(JsonSaveOptions.DisableFormatting)), headers, httpMethod + + /// Sends the JSON to the specified URL synchronously. Defaults to a POST request. + member x.Request(url: string, [] ?httpMethod, [] ?headers: seq<_>) = + let body, headers, httpMethod = x.PrepareRequest(httpMethod, headers) + Http.Request(url, body = body, headers = headers, httpMethod = httpMethod) + + /// Sends the JSON to the specified URL asynchronously. Defaults to a POST request. + member x.RequestAsync(url: string, [] ?httpMethod, [] ?headers: seq<_>) = + let body, headers, httpMethod = x.PrepareRequest(httpMethod, headers) + Http.AsyncRequest(url, body = body, headers = headers, httpMethod = httpMethod) + + [] + member x.Post(uri: string, [] ?headers) = x.Request(uri, ?headers = headers) diff --git a/src/Net/Http.fs b/src/Net/Http.fs index 013e81b34..95411fef6 100644 --- a/src/Net/Http.fs +++ b/src/Net/Http.fs @@ -76,450 +76,566 @@ module HttpMethod = /// Headers that can be sent in an HTTP request module HttpRequestHeaders = /// Content-Types that are acceptable for the response - let Accept (contentType:string) = "Accept", contentType + let Accept (contentType: string) = "Accept", contentType /// Character sets that are acceptable - let AcceptCharset (characterSets:string) = "Accept-Charset", characterSets + let AcceptCharset (characterSets: string) = "Accept-Charset", characterSets /// Acceptable version in time - let AcceptDatetime (dateTime:DateTime) = "Accept-Datetime", dateTime.ToString("R", CultureInfo.InvariantCulture) + let AcceptDatetime (dateTime: DateTime) = + "Accept-Datetime", dateTime.ToString("R", CultureInfo.InvariantCulture) /// List of acceptable encodings. See HTTP compression. - let AcceptEncoding (encoding:string) = "Accept-Encoding", encoding + let AcceptEncoding (encoding: string) = "Accept-Encoding", encoding /// List of acceptable human languages for response - let AcceptLanguage (language:string) = "Accept-Language", language + let AcceptLanguage (language: string) = "Accept-Language", language /// The Allow header, which specifies the set of HTTP methods supported. - let Allow (methods:string) = "Allow", methods + let Allow (methods: string) = "Allow", methods /// Authentication credentials for HTTP authentication - let Authorization (credentials:string) = "Authorization", credentials + let Authorization (credentials: string) = "Authorization", credentials /// Authentication header using Basic Auth encoding - let BasicAuth (username:string) (password:string) = - let base64Encode (s:string) = + let BasicAuth (username: string) (password: string) = + let base64Encode (s: string) = let bytes = Encoding.UTF8.GetBytes(s) Convert.ToBase64String(bytes) - sprintf "%s:%s" username password |> base64Encode |> sprintf "Basic %s" |> Authorization + + sprintf "%s:%s" username password + |> base64Encode + |> sprintf "Basic %s" + |> Authorization /// Used to specify directives that MUST be obeyed by all caching mechanisms along the request/response chain - let CacheControl (control:string) = "Cache-Control", control + let CacheControl (control: string) = "Cache-Control", control /// What type of connection the user-agent would prefer - let Connection (connection:string) = "Connection", connection + let Connection (connection: string) = "Connection", connection /// Describes the placement of the content. Valid dispositions are: inline, attachment, form-data let ContentDisposition (placement: string, name: string option, fileName: string option) = - let namePart = match name with Some n -> sprintf "; name=\"%s\"" n | None -> "" - let fileNamePart = match fileName with Some n -> sprintf "; filename=\"%s\"" n | None -> "" + let namePart = + match name with + | Some n -> sprintf "; name=\"%s\"" n + | None -> "" + + let fileNamePart = + match fileName with + | Some n -> sprintf "; filename=\"%s\"" n + | None -> "" + "Content-Disposition", sprintf "%s%s%s" placement namePart fileNamePart /// The type of encoding used on the data - let ContentEncoding (encoding:string) = "Content-Encoding", encoding + let ContentEncoding (encoding: string) = "Content-Encoding", encoding /// The language the content is in - let ContentLanguage (language:string) = "Content-Language", language + let ContentLanguage (language: string) = "Content-Language", language /// An alternate location for the returned data - let ContentLocation (location:string) = "Content-Location", location + let ContentLocation (location: string) = "Content-Location", location /// A Base64-encoded binary MD5 sum of the content of the request body - let ContentMD5 (md5sum:string) = "Content-MD5", md5sum + let ContentMD5 (md5sum: string) = "Content-MD5", md5sum /// Where in a full body message this partial message belongs - let ContentRange (range:string) = "Content-Range", range + let ContentRange (range: string) = "Content-Range", range /// The MIME type of the body of the request (used with POST and PUT requests) - let ContentType (contentType:string) = "Content-Type", contentType + let ContentType (contentType: string) = "Content-Type", contentType /// The MIME type of the body of the request (used with POST and PUT requests) with an explicit encoding - let ContentTypeWithEncoding (contentType, charset:Encoding) = "Content-Type", sprintf "%s; charset=%s" contentType (charset.WebName) + let ContentTypeWithEncoding (contentType, charset: Encoding) = + "Content-Type", sprintf "%s; charset=%s" contentType (charset.WebName) /// The date and time that the message was sent - let Date (date:DateTime) = "Date", date.ToString("R", CultureInfo.InvariantCulture) + let Date (date: DateTime) = + "Date", date.ToString("R", CultureInfo.InvariantCulture) /// Indicates that particular server behaviors are required by the client - let Expect (behaviors:string) = "Expect", behaviors + let Expect (behaviors: string) = "Expect", behaviors /// Gives the date/time after which the response is considered stale - let Expires (dateTime:DateTime) = "Expires", dateTime.ToString("R", CultureInfo.InvariantCulture) + let Expires (dateTime: DateTime) = + "Expires", dateTime.ToString("R", CultureInfo.InvariantCulture) /// The email address of the user making the request - let From (email:string) = "From", email + let From (email: string) = "From", email /// The domain name of the server (for virtual hosting), and the TCP port number on which the server is listening. /// The port number may be omitted if the port is the standard port for the service requested. - let Host (host:string) = "Host", host + let Host (host: string) = "Host", host /// Only perform the action if the client supplied entity matches the same entity on the server. /// This is mainly for methods like PUT to only update a resource if it has not been modified since the user last updated it. If-Match: "737060cd8c284d8af7ad3082f209582d" Permanent - let IfMatch (entity:string) = "If-Match", entity + let IfMatch (entity: string) = "If-Match", entity /// Allows a 304 Not Modified to be returned if content is unchanged - let IfModifiedSince (dateTime:DateTime) = "If-Modified-Since", dateTime.ToString("R", CultureInfo.InvariantCulture) + let IfModifiedSince (dateTime: DateTime) = + "If-Modified-Since", dateTime.ToString("R", CultureInfo.InvariantCulture) /// Allows a 304 Not Modified to be returned if content is unchanged - let IfNoneMatch (etag:string) = "If-None-Match", etag + let IfNoneMatch (etag: string) = "If-None-Match", etag /// If the entity is unchanged, send me the part(s) that I am missing; otherwise, send me the entire new entity - let IfRange (range:string) = "If-Range", range + let IfRange (range: string) = "If-Range", range /// Only send the response if the entity has not been modified since a specific time - let IfUnmodifiedSince (dateTime:DateTime) = "If-Unmodified-Since", dateTime.ToString("R", CultureInfo.InvariantCulture) + let IfUnmodifiedSince (dateTime: DateTime) = + "If-Unmodified-Since", dateTime.ToString("R", CultureInfo.InvariantCulture) /// Specifies a parameter used into order to maintain a persistent connection - let KeepAlive (keepAlive:string) = "Keep-Alive", keepAlive + let KeepAlive (keepAlive: string) = "Keep-Alive", keepAlive /// Specifies the date and time at which the accompanying body data was last modified - let LastModified (dateTime:DateTime) = "Last-Modified", dateTime.ToString("R", CultureInfo.InvariantCulture) + let LastModified (dateTime: DateTime) = + "Last-Modified", dateTime.ToString("R", CultureInfo.InvariantCulture) /// Limit the number of times the message can be forwarded through proxies or gateways - let MaxForwards (count:int) = "Max-Forwards", count.ToString() + let MaxForwards (count: int) = "Max-Forwards", count.ToString() /// Initiates a request for cross-origin resource sharing (asks server for an 'Access-Control-Allow-Origin' response header) - let Origin (origin:string) = "Origin", origin + let Origin (origin: string) = "Origin", origin /// Implementation-specific headers that may have various effects anywhere along the request-response chain. - let Pragma (pragma:string) = "Pragma", pragma + let Pragma (pragma: string) = "Pragma", pragma /// Optional instructions to the server to control request processing. See RFC https://tools.ietf.org/html/rfc7240 for more details - let Prefer (prefer:string) = "Prefer", prefer + let Prefer (prefer: string) = "Prefer", prefer /// Authorization credentials for connecting to a proxy. - let ProxyAuthorization (credentials:string) = "Proxy-Authorization", credentials + let ProxyAuthorization (credentials: string) = "Proxy-Authorization", credentials /// Request only part of an entity. Bytes are numbered from 0 - let Range (start:int64, finish:int64) = "Range", sprintf "bytes=%d-%d" start finish + let Range (start: int64, finish: int64) = + "Range", sprintf "bytes=%d-%d" start finish /// This is the address of the previous web page from which a link to the currently requested page was followed. (The word "referrer" is misspelled in the RFC as well as in most implementations.) - let Referer (referer:string) = "Referer", referer + let Referer (referer: string) = "Referer", referer /// The transfer encodings the user agent is willing to accept: the same values as for the response header /// Transfer-Encoding can be used, plus the "trailers" value (related to the "chunked" transfer method) to /// notify the server it expects to receive additional headers (the trailers) after the last, zero-sized, chunk. - let TE (te:string) = "TE", te + let TE (te: string) = "TE", te /// The Trailer general field value indicates that the given set of header fields is present in the trailer of a message encoded with chunked transfer-coding - let Trailer (trailer:string) = "Trailer", trailer + let Trailer (trailer: string) = "Trailer", trailer /// The TransferEncoding header indicates the form of encoding used to safely transfer the entity to the user. The valid directives are one of: chunked, compress, deflate, gzip, or identity. let TransferEncoding (directive: string) = "Transfer-Encoding", directive /// Microsoft extension to the HTTP specification used in conjunction with WebDAV functionality. - let Translate (translate:string) = "Translate", translate + let Translate (translate: string) = "Translate", translate /// Specifies additional communications protocols that the client supports. - let Upgrade (upgrade:string) = "Upgrade", upgrade + let Upgrade (upgrade: string) = "Upgrade", upgrade /// The user agent string of the user agent - let UserAgent (userAgent:string) = "User-Agent", userAgent + let UserAgent (userAgent: string) = "User-Agent", userAgent /// Informs the server of proxies through which the request was sent - let Via (server:string) = "Via", server + let Via (server: string) = "Via", server /// A general warning about possible problems with the entity body - let Warning (message:string) = "Warning", message + let Warning (message: string) = "Warning", message /// Override HTTP method. - let XHTTPMethodOverride (httpMethod:string) = "X-HTTP-Method-Override", httpMethod + let XHTTPMethodOverride (httpMethod: string) = "X-HTTP-Method-Override", httpMethod /// Headers that can be received in an HTTP response module HttpResponseHeaders = /// Specifying which web sites can participate in cross-origin resource sharing - let [] AccessControlAllowOrigin = "Access-Control-Allow-Origin" + [] + let AccessControlAllowOrigin = "Access-Control-Allow-Origin" /// What partial content range types this server supports - let [] AcceptRanges = "Accept-Ranges" + [] + let AcceptRanges = "Accept-Ranges" /// The age the object has been in a proxy cache in seconds - let [] Age = "Age" + [] + let Age = "Age" /// Valid actions for a specified resource. To be used for a 405 Method not allowed - let [] Allow = "Allow" + [] + let Allow = "Allow" /// Tells all caching mechanisms from server to client whether they may cache this object. It is measured in seconds - let [] CacheControl = "Cache-Control" + [] + let CacheControl = "Cache-Control" /// Options that are desired for the connection - let [] Connection = "Connection" + [] + let Connection = "Connection" /// The type of encoding used on the data. See HTTP compression. - let [] ContentEncoding = "Content-Encoding" + [] + let ContentEncoding = "Content-Encoding" /// The language the content is in - let [] ContentLanguage = "Content-Language" + [] + let ContentLanguage = "Content-Language" /// The length of the response body in octets (8-bit bytes) - let [] ContentLength = "Content-Length" + [] + let ContentLength = "Content-Length" /// An alternate location for the returned data - let [] ContentLocation = "Content-Location" + [] + let ContentLocation = "Content-Location" /// A Base64-encoded binary MD5 sum of the content of the response - let [] ContentMD5 = "Content-MD5" + [] + let ContentMD5 = "Content-MD5" /// An opportunity to raise a "File Download" dialogue box for a known MIME type with binary format or suggest a filename for dynamic content. Quotes are necessary with special characters. - let [] ContentDisposition = "Content-Disposition" + [] + let ContentDisposition = "Content-Disposition" /// Where in a full body message this partial message belongs - let [] ContentRange = "Content-Range" + [] + let ContentRange = "Content-Range" /// The MIME type of this content - let [] ContentType = "Content-Type" + [] + let ContentType = "Content-Type" /// The date and time that the message was sent (in "HTTP-date" format as defined by RFC 2616) - let [] Date = "Date" + [] + let Date = "Date" /// An identifier for a specific version of a resource, often a message digest - let [] ETag = "ETag" + [] + let ETag = "ETag" /// Gives the date/time after which the response is considered stale - let [] Expires = "Expires" + [] + let Expires = "Expires" /// The last modified date for the requested object - let [] LastModified = "Last-Modified" + [] + let LastModified = "Last-Modified" /// Used to express a typed relationship with another resource, where the relation type is defined by RFC 5988 - let [] Link = "Link" + [] + let Link = "Link" /// Used in redirection, or when a new resource has been created. - let [] Location = "Location" + [] + let Location = "Location" /// This header is supposed to set P3P policy - let [] P3P = "P3P" + [] + let P3P = "P3P" /// Implementation-specific headers that may have various effects anywhere along the request-response chain. - let [] Pragma = "Pragma" + [] + let Pragma = "Pragma" /// Request authentication to access the proxy. - let [] ProxyAuthenticate = "Proxy-Authenticate" + [] + let ProxyAuthenticate = "Proxy-Authenticate" /// Used in redirection, or when a new resource has been created. This refresh redirects after 5 seconds. - let [] Refresh = "Refresh" + [] + let Refresh = "Refresh" /// If an entity is temporarily unavailable, this instructs the client to try again later. Value could be a specified period of time (in seconds) or a HTTP-date.[28] - let [] RetryAfter = "Retry-After" + [] + let RetryAfter = "Retry-After" /// A name for the server - let [] Server = "Server" + [] + let Server = "Server" /// An HTTP cookie - let [] SetCookie = "Set-Cookie" + [] + let SetCookie = "Set-Cookie" /// The HTTP status of the response - let [] Status = "Status" + [] + let Status = "Status" /// A HSTS Policy informing the HTTP client how long to cache the HTTPS only policy and whether this applies to subdomains. - let [] StrictTransportSecurity = "Strict-Transport-Security" + [] + let StrictTransportSecurity = "Strict-Transport-Security" /// The Trailer general field value indicates that the given set of header fields is present in the trailer of a message encoded with chunked transfer-coding. - let [] Trailer = "Trailer" + [] + let Trailer = "Trailer" /// The form of encoding used to safely transfer the entity to the user. Currently defined methods are: chunked, compress, deflate, gzip, identity. - let [] TransferEncoding = "Transfer-Encoding" + [] + let TransferEncoding = "Transfer-Encoding" /// Tells downstream proxies how to match future request headers to decide whether the cached response can be used rather than requesting a fresh one from the origin server. - let [] Vary = "Vary" + [] + let Vary = "Vary" /// Informs the client of proxies through which the response was sent. - let [] Via = "Via" + [] + let Via = "Via" /// A general warning about possible problems with the entity body. - let [] Warning = "Warning" + [] + let Warning = "Warning" /// Indicates the authentication scheme that should be used to access the requested entity. - let [] WWWAuthenticate = "WWW-Authenticate" + [] + let WWWAuthenticate = "WWW-Authenticate" /// Status codes that can be received in an HTTP response -module HttpStatusCodes = +module HttpStatusCodes = /// The server has received the request headers and the client should proceed to send the request body. - let [] Continue = 100 + [] + let Continue = 100 /// The requester has asked the server to switch protocols and the server has agreed to do so. - let [] SwitchingProtocols = 101 + [] + let SwitchingProtocols = 101 /// This code indicates that the server has received and is processing the request, but no response is available yet. - let [] Processing = 102 + [] + let Processing = 102 /// Used to return some response headers before final HTTP message. - let [] EarlyHints = 103 + [] + let EarlyHints = 103 /// Standard response for successful HTTP requests. - let [] OK = 200 + [] + let OK = 200 /// The request has been fulfilled, resulting in the creation of a new resource. - let [] Created = 201 + [] + let Created = 201 /// The request has been accepted for processing, but the processing has not been completed. - let [] Accepted = 202 + [] + let Accepted = 202 /// The server is a transforming proxy (e.g. a Web accelerator) that received a 200 OK from its origin, but is returning a modified version of the origin's response. - let [] NonAuthoritativeInformation = 203 + [] + let NonAuthoritativeInformation = 203 /// The server successfully processed the request and is not returning any content. - let [] NoContent = 204 + [] + let NoContent = 204 /// The server successfully processed the request, but is not returning any content. - let [] ResetContent = 205 + [] + let ResetContent = 205 /// The server is delivering only part of the resource (byte serving) due to a range header sent by the client. - let [] PartialContent = 206 + [] + let PartialContent = 206 /// The message body that follows is by default an XML message and can contain a number of separate response codes, depending on how many sub-requests were made. - let [] MultiStatus = 207 + [] + let MultiStatus = 207 /// The members of a DAV binding have already been enumerated in a preceding part of the (multistatus) response, and are not being included again. - let [] AlreadyReported = 208 + [] + let AlreadyReported = 208 /// The server has fulfilled a request for the resource, and the response is a representation of the result of one or more instance-manipulations applied to the current instance. - let [] IMUsed = 226 + [] + let IMUsed = 226 /// Indicates multiple options for the resource from which the client may choose (via agent-driven content negotiation). - let [] MultipleChoices = 300 + [] + let MultipleChoices = 300 /// This and all future requests should be directed to the given URI. - let [] MovedPermanently = 301 + [] + let MovedPermanently = 301 - /// Tells the client to look at (browse to) another url. 302 has been superseded by 303 and 307. - let [] Found = 302 + /// Tells the client to look at (browse to) another url. 302 has been superseded by 303 and 307. + [] + let Found = 302 /// The response to the request can be found under another URI using the GET method. - let [] SeeOther = 303 + [] + let SeeOther = 303 /// Indicates that the resource has not been modified since the version specified by the request headers If-Modified-Since or If-None-Match. - let [] NotModified = 304 + [] + let NotModified = 304 - /// The requested resource is available only through a proxy, the address for which is provided in the response. - let [] UseProxy = 305 + /// The requested resource is available only through a proxy, the address for which is provided in the response. + [] + let UseProxy = 305 /// No longer used. Originally meant "Subsequent requests should use the specified proxy." - let [] SwitchProxy = 306 + [] + let SwitchProxy = 306 /// In this case, the request should be repeated with another URI; however, future requests should still use the original URI. - let [] TemporaryRedirect = 307 + [] + let TemporaryRedirect = 307 - /// The request and all future requests should be repeated using another URI. - let [] PermanentRedirect = 308 + /// The request and all future requests should be repeated using another URI. + [] + let PermanentRedirect = 308 /// The server cannot or will not process the request due to an apparent client error. - let [] BadRequest = 400 + [] + let BadRequest = 400 /// Similar to 403 Forbidden, but specifically for use when authentication is required and has failed or has not yet been provided. - let [] Unauthorized = 401 + [] + let Unauthorized = 401 - /// Reserved for future use. - let [] PaymentRequired = 402 + /// Reserved for future use. + [] + let PaymentRequired = 402 /// The request was valid, but the server is refusing action. The user might not have the necessary permissions for a resource, or may need an account of some sort. - let [] Forbidden = 403 + [] + let Forbidden = 403 /// The requested resource could not be found but may be available in the future. Subsequent requests by the client are permissible. - let [] NotFound = 404 + [] + let NotFound = 404 /// A request method is not supported for the requested resource. - let [] MethodNotAllowed = 405 + [] + let MethodNotAllowed = 405 /// The requested resource is capable of generating only content not acceptable according to the Accept headers sent in the request. - let [] NotAcceptable = 406 + [] + let NotAcceptable = 406 /// The client must first authenticate itself with the proxy. - let [] ProxyAuthenticationRequired = 407 + [] + let ProxyAuthenticationRequired = 407 /// The server timed out waiting for the request. - let [] RequestTimeout = 408 + [] + let RequestTimeout = 408 /// Indicates that the request could not be processed because of conflict in the request, such as an edit conflict between multiple simultaneous updates. - let [] Conflict = 409 + [] + let Conflict = 409 /// Indicates that the resource requested is no longer available and will not be available again. - let [] Gone = 410 + [] + let Gone = 410 /// The request did not specify the length of its content, which is required by the requested resource. - let [] LengthRequired = 411 + [] + let LengthRequired = 411 /// The server does not meet one of the preconditions that the requester put on the request. - let [] PreconditionFailed = 412 + [] + let PreconditionFailed = 412 /// The request is larger than the server is willing or able to process. - let [] PayloadTooLarge = 413 + [] + let PayloadTooLarge = 413 /// The URI provided was too long for the server to process. - let [] URITooLong = 414 + [] + let URITooLong = 414 /// The request entity has a media type which the server or resource does not support. - let [] UnsupportedMediaType = 415 + [] + let UnsupportedMediaType = 415 /// The client has asked for a portion of the file (byte serving), but the server cannot supply that portion. - let [] RangeNotSatisfiable = 416 + [] + let RangeNotSatisfiable = 416 /// The server cannot meet the requirements of the Expect request-header field. - let [] ExpectationFailed = 417 + [] + let ExpectationFailed = 417 /// The request was directed at a server that is not able to produce a response. - let [] MisdirectedRequest = 421 + [] + let MisdirectedRequest = 421 /// The request was well-formed but was unable to be followed due to semantic errors. - let [] UnprocessableEntity = 422 + [] + let UnprocessableEntity = 422 /// The resource that is being accessed is locked. - let [] Locked = 423 + [] + let Locked = 423 /// The request failed because it depended on another request and that request failed (e.g., a PROPPATCH). - let [] FailedDependency = 424 + [] + let FailedDependency = 424 /// The client should switch to a different protocol such as TLS/1.0, given in the Upgrade header field. - let [] UpgradeRequired = 426 + [] + let UpgradeRequired = 426 /// The origin server requires the request to be conditional. - let [] PreconditionRequired = 428 + [] + let PreconditionRequired = 428 /// The user has sent too many requests in a given amount of time. - let [] TooManyRequests = 429 + [] + let TooManyRequests = 429 /// The server is unwilling to process the request because either an individual header field, or all the header fields collectively, are too large. - let [] RequestHeaderFieldsTooLarge = 431 + [] + let RequestHeaderFieldsTooLarge = 431 /// A server operator has received a legal demand to deny access to a resource or to a set of resources that includes the requested resource. - let [] UnavailableForLegalReasons = 451 + [] + let UnavailableForLegalReasons = 451 /// A generic error message, given when an unexpected condition was encountered and no more specific message is suitable. - let [] InternalServerError = 500 + [] + let InternalServerError = 500 - /// The server either does not recognize the request method, or it lacks the ability to fulfil the request. - let [] NotImplemented = 501 + /// The server either does not recognize the request method, or it lacks the ability to fulfil the request. + [] + let NotImplemented = 501 /// The server was acting as a gateway or proxy and received an invalid response from the upstream server. - let [] BadGateway = 502 + [] + let BadGateway = 502 /// The server is currently unavailable (because it is overloaded or down for maintenance). - let [] ServiceUnavailable = 503 + [] + let ServiceUnavailable = 503 /// The server was acting as a gateway or proxy and did not receive a timely response from the upstream server. - let [] GatewayTimeout = 504 + [] + let GatewayTimeout = 504 /// The server does not support the HTTP protocol version used in the request. - let [] HTTPVersionNotSupported = 505 + [] + let HTTPVersionNotSupported = 505 /// Transparent content negotiation for the request results in a circular reference. - let [] VariantAlsoNegotiates = 506 + [] + let VariantAlsoNegotiates = 506 /// The server is unable to store the representation needed to complete the request. - let [] InsufficientStorage = 507 + [] + let InsufficientStorage = 507 /// The server detected an infinite loop while processing the request. - let [] LoopDetected = 508 + [] + let LoopDetected = 508 /// Further extensions to the request are required for the server to fulfil it. - let [] NotExtended = 510 + [] + let NotExtended = 510 /// The client needs to authenticate to gain network access. - let [] NetworkAuthenticationRequired = 511 + [] + let NetworkAuthenticationRequired = 511 -type MultipartItem = | MultipartItem of formField: string * filename: string * content: Stream +type MultipartItem = MultipartItem of formField: string * filename: string * content: Stream /// The body to send in an HTTP request type HttpRequestBody = @@ -540,686 +656,709 @@ type HttpResponseBody = /// The response returned by an HTTP request type HttpResponse = - { Body : HttpResponseBody - StatusCode: int - ResponseUrl : string - /// If the same header is present multiple times, the values will be concatenated with comma as the separator - Headers : Map - Cookies : Map } + { + Body: HttpResponseBody + StatusCode: int + ResponseUrl: string + /// If the same header is present multiple times, the values will be concatenated with comma as the separator + Headers: Map + Cookies: Map + } /// The response returned by an HTTP request with direct access to the response stream type HttpResponseWithStream = - { ResponseStream : Stream - StatusCode: int - ResponseUrl : string - /// If the same header is present multiple times, the values will be concatenated with comma as the separator - Headers : Map - Cookies : Map } + { + ResponseStream: Stream + StatusCode: int + ResponseUrl: string + /// If the same header is present multiple times, the values will be concatenated with comma as the separator + Headers: Map + Cookies: Map + } /// Constants for common HTTP content types module HttpContentTypes = /// */* - let [] Any = "*/*" + [] + let Any = "*/*" /// plain/text - let [] Text = "text/plain" + [] + let Text = "text/plain" /// application/octet-stream - let [] Binary = "application/octet-stream" + [] + let Binary = "application/octet-stream" /// application/octet-stream - let [] Zip = "application/zip" + [] + let Zip = "application/zip" /// application/octet-stream - let [] GZip = "application/gzip" + [] + let GZip = "application/gzip" /// application/x-www-form-urlencoded - let [] FormValues = "application/x-www-form-urlencoded" + [] + let FormValues = "application/x-www-form-urlencoded" /// application/json - let [] Json = "application/json" + [] + let Json = "application/json" /// application/javascript - let [] JavaScript = "application/javascript" + [] + let JavaScript = "application/javascript" /// application/xml - let [] Xml = "application/xml" + [] + let Xml = "application/xml" /// application/rss+xml - let [] Rss = "application/rss+xml" + [] + let Rss = "application/rss+xml" /// application/atom+xml - let [] Atom = "application/atom+xml" + [] + let Atom = "application/atom+xml" /// application/rdf+xml - let [] Rdf = "application/rdf+xml" + [] + let Rdf = "application/rdf+xml" /// text/html - let [] Html = "text/html" + [] + let Html = "text/html" /// application/xhtml+xml - let [] XHtml = "application/xhtml+xml" + [] + let XHtml = "application/xhtml+xml" /// application/soap+xml - let [] Soap = "application/soap+xml" + [] + let Soap = "application/soap+xml" /// text/csv - let [] Csv = "text/csv" + [] + let Csv = "text/csv" /// application/json-rpc - let [] JsonRpc = "application/json-rpc" + [] + let JsonRpc = "application/json-rpc" /// multipart/form-data - let Multipart boundary = sprintf "multipart/form-data; boundary=%s" boundary + let Multipart boundary = + sprintf "multipart/form-data; boundary=%s" boundary type private HeaderEnum = System.Net.HttpRequestHeader module MimeTypes = open System.Collections.Generic + let private pairs = - [| - (".323", "text/h323") - (".3g2", "video/3gpp2") - (".3gp", "video/3gpp") - (".3gp2", "video/3gpp2") - (".3gpp", "video/3gpp") - (".7z", "application/x-7z-compressed") - (".aa", "audio/audible") - (".AAC", "audio/aac") - (".aaf", "application/octet-stream") - (".aax", "audio/vnd.audible.aax") - (".ac3", "audio/ac3") - (".aca", "application/octet-stream") - (".accda", "application/msaccess.addin") - (".accdb", "application/msaccess") - (".accdc", "application/msaccess.cab") - (".accde", "application/msaccess") - (".accdr", "application/msaccess.runtime") - (".accdt", "application/msaccess") - (".accdw", "application/msaccess.webapplication") - (".accft", "application/msaccess.ftemplate") - (".acx", "application/internet-property-stream") - (".AddIn", "text/xml") - (".ade", "application/msaccess") - (".adobebridge", "application/x-bridge-url") - (".adp", "application/msaccess") - (".ADT", "audio/vnd.dlna.adts") - (".ADTS", "audio/aac") - (".afm", "application/octet-stream") - (".ai", "application/postscript") - (".aif", "audio/aiff") - (".aifc", "audio/aiff") - (".aiff", "audio/aiff") - (".air", "application/vnd.adobe.air-application-installer-package+zip") - (".amc", "application/mpeg") - (".anx", "application/annodex") - (".apk", "application/vnd.android.package-archive" ) - (".application", "application/x-ms-application") - (".art", "image/x-jg") - (".asa", "application/xml") - (".asax", "application/xml") - (".ascx", "application/xml") - (".asd", "application/octet-stream") - (".asf", "video/x-ms-asf") - (".ashx", "application/xml") - (".asi", "application/octet-stream") - (".asm", "text/plain") - (".asmx", "application/xml") - (".aspx", "application/xml") - (".asr", "video/x-ms-asf") - (".asx", "video/x-ms-asf") - (".atom", "application/atom+xml") - (".au", "audio/basic") - (".avi", "video/x-msvideo") - (".axa", "audio/annodex") - (".axs", "application/olescript") - (".axv", "video/annodex") - (".bas", "text/plain") - (".bcpio", "application/x-bcpio") - (".bin", "application/octet-stream") - (".bmp", "image/bmp") - (".c", "text/plain") - (".cab", "application/octet-stream") - (".caf", "audio/x-caf") - (".calx", "application/vnd.ms-office.calx") - (".cat", "application/vnd.ms-pki.seccat") - (".cc", "text/plain") - (".cd", "text/plain") - (".cdda", "audio/aiff") - (".cdf", "application/x-cdf") - (".cer", "application/x-x509-ca-cert") - (".cfg", "text/plain") - (".chm", "application/octet-stream") - (".class", "application/x-java-applet") - (".clp", "application/x-msclip") - (".cmd", "text/plain") - (".cmx", "image/x-cmx") - (".cnf", "text/plain") - (".cod", "image/cis-cod") - (".config", "application/xml") - (".contact", "text/x-ms-contact") - (".coverage", "application/xml") - (".cpio", "application/x-cpio") - (".cpp", "text/plain") - (".crd", "application/x-mscardfile") - (".crl", "application/pkix-crl") - (".crt", "application/x-x509-ca-cert") - (".cs", "text/plain") - (".csdproj", "text/plain") - (".csh", "application/x-csh") - (".csproj", "text/plain") - (".css", "text/css") - (".csv", "text/csv") - (".cur", "application/octet-stream") - (".cxx", "text/plain") - (".dat", "application/octet-stream") - (".datasource", "application/xml") - (".dbproj", "text/plain") - (".dcr", "application/x-director") - (".def", "text/plain") - (".deploy", "application/octet-stream") - (".der", "application/x-x509-ca-cert") - (".dgml", "application/xml") - (".dib", "image/bmp") - (".dif", "video/x-dv") - (".dir", "application/x-director") - (".disco", "text/xml") - (".divx", "video/divx") - (".dll", "application/x-msdownload") - (".dll.config", "text/xml") - (".dlm", "text/dlm") - (".doc", "application/msword") - (".docm", "application/vnd.ms-word.document.macroEnabled.12") - (".docx", "application/vnd.openxmlformats-officedocument.wordprocessingml.document") - (".dot", "application/msword") - (".dotm", "application/vnd.ms-word.template.macroEnabled.12") - (".dotx", "application/vnd.openxmlformats-officedocument.wordprocessingml.template") - (".dsp", "application/octet-stream") - (".dsw", "text/plain") - (".dtd", "text/xml") - (".dtsConfig", "text/xml") - (".dv", "video/x-dv") - (".dvi", "application/x-dvi") - (".dwf", "drawing/x-dwf") - (".dwp", "application/octet-stream") - (".dxr", "application/x-director") - (".eml", "message/rfc822") - (".emz", "application/octet-stream") - (".eot", "application/vnd.ms-fontobject") - (".eps", "application/postscript") - (".etl", "application/etl") - (".etx", "text/x-setext") - (".evy", "application/envoy") - (".exe", "application/octet-stream") - (".exe.config", "text/xml") - (".fdf", "application/vnd.fdf") - (".fif", "application/fractals") - (".filters", "application/xml") - (".fla", "application/octet-stream") - (".flac", "audio/flac") - (".flr", "x-world/x-vrml") - (".flv", "video/x-flv") - (".fsscript", "application/fsharp-script") - (".fsx", "application/fsharp-script") - (".generictest", "application/xml") - (".gif", "image/gif") - (".gpx", "application/gpx+xml") - (".group", "text/x-ms-group") - (".gsm", "audio/x-gsm") - (".gtar", "application/x-gtar") - (".gz", "application/x-gzip") - (".h", "text/plain") - (".hdf", "application/x-hdf") - (".hdml", "text/x-hdml") - (".hhc", "application/x-oleobject") - (".hhk", "application/octet-stream") - (".hhp", "application/octet-stream") - (".hlp", "application/winhlp") - (".hpp", "text/plain") - (".hqx", "application/mac-binhex40") - (".hta", "application/hta") - (".htc", "text/x-component") - (".htm", "text/html") - (".html", "text/html") - (".htt", "text/webviewhtml") - (".hxa", "application/xml") - (".hxc", "application/xml") - (".hxd", "application/octet-stream") - (".hxe", "application/xml") - (".hxf", "application/xml") - (".hxh", "application/octet-stream") - (".hxi", "application/octet-stream") - (".hxk", "application/xml") - (".hxq", "application/octet-stream") - (".hxr", "application/octet-stream") - (".hxs", "application/octet-stream") - (".hxt", "text/html") - (".hxv", "application/xml") - (".hxw", "application/octet-stream") - (".hxx", "text/plain") - (".i", "text/plain") - (".ico", "image/x-icon") - (".ics", "application/octet-stream") - (".idl", "text/plain") - (".ief", "image/ief") - (".iii", "application/x-iphone") - (".inc", "text/plain") - (".inf", "application/octet-stream") - (".ini", "text/plain") - (".inl", "text/plain") - (".ins", "application/x-internet-signup") - (".ipa", "application/x-itunes-ipa") - (".ipg", "application/x-itunes-ipg") - (".ipproj", "text/plain") - (".ipsw", "application/x-itunes-ipsw") - (".iqy", "text/x-ms-iqy") - (".isp", "application/x-internet-signup") - (".ite", "application/x-itunes-ite") - (".itlp", "application/x-itunes-itlp") - (".itms", "application/x-itunes-itms") - (".itpc", "application/x-itunes-itpc") - (".IVF", "video/x-ivf") - (".jar", "application/java-archive") - (".java", "application/octet-stream") - (".jck", "application/liquidmotion") - (".jcz", "application/liquidmotion") - (".jfif", "image/pjpeg") - (".jnlp", "application/x-java-jnlp-file") - (".jpb", "application/octet-stream") - (".jpe", "image/jpeg") - (".jpeg", "image/jpeg") - (".jpg", "image/jpeg") - (".js", "application/javascript") - (".json", "application/json") - (".jsx", "text/jscript") - (".jsxbin", "text/plain") - (".latex", "application/x-latex") - (".library-ms", "application/windows-library+xml") - (".lit", "application/x-ms-reader") - (".loadtest", "application/xml") - (".lpk", "application/octet-stream") - (".lsf", "video/x-la-asf") - (".lst", "text/plain") - (".lsx", "video/x-la-asf") - (".lzh", "application/octet-stream") - (".m13", "application/x-msmediaview") - (".m14", "application/x-msmediaview") - (".m1v", "video/mpeg") - (".m2t", "video/vnd.dlna.mpeg-tts") - (".m2ts", "video/vnd.dlna.mpeg-tts") - (".m2v", "video/mpeg") - (".m3u", "audio/x-mpegurl") - (".m3u8", "audio/x-mpegurl") - (".m4a", "audio/m4a") - (".m4b", "audio/m4b") - (".m4p", "audio/m4p") - (".m4r", "audio/x-m4r") - (".m4v", "video/x-m4v") - (".mac", "image/x-macpaint") - (".mak", "text/plain") - (".man", "application/x-troff-man") - (".manifest", "application/x-ms-manifest") - (".map", "text/plain") - (".master", "application/xml") - (".mda", "application/msaccess") - (".mdb", "application/x-msaccess") - (".mde", "application/msaccess") - (".mdp", "application/octet-stream") - (".me", "application/x-troff-me") - (".mfp", "application/x-shockwave-flash") - (".mht", "message/rfc822") - (".mhtml", "message/rfc822") - (".mid", "audio/mid") - (".midi", "audio/mid") - (".mix", "application/octet-stream") - (".mk", "text/plain") - (".mmf", "application/x-smaf") - (".mno", "text/xml") - (".mny", "application/x-msmoney") - (".mod", "video/mpeg") - (".mov", "video/quicktime") - (".movie", "video/x-sgi-movie") - (".mp2", "video/mpeg") - (".mp2v", "video/mpeg") - (".mp3", "audio/mpeg") - (".mp4", "video/mp4") - (".mp4v", "video/mp4") - (".mpa", "video/mpeg") - (".mpe", "video/mpeg") - (".mpeg", "video/mpeg") - (".mpf", "application/vnd.ms-mediapackage") - (".mpg", "video/mpeg") - (".mpp", "application/vnd.ms-project") - (".mpv2", "video/mpeg") - (".mqv", "video/quicktime") - (".ms", "application/x-troff-ms") - (".msi", "application/octet-stream") - (".mso", "application/octet-stream") - (".mts", "video/vnd.dlna.mpeg-tts") - (".mtx", "application/xml") - (".mvb", "application/x-msmediaview") - (".mvc", "application/x-miva-compiled") - (".mxp", "application/x-mmxp") - (".nc", "application/x-netcdf") - (".nsc", "video/x-ms-asf") - (".nws", "message/rfc822") - (".ocx", "application/octet-stream") - (".oda", "application/oda") - (".odb", "application/vnd.oasis.opendocument.database") - (".odc", "application/vnd.oasis.opendocument.chart") - (".odf", "application/vnd.oasis.opendocument.formula") - (".odg", "application/vnd.oasis.opendocument.graphics") - (".odh", "text/plain") - (".odi", "application/vnd.oasis.opendocument.image") - (".odl", "text/plain") - (".odm", "application/vnd.oasis.opendocument.text-master") - (".odp", "application/vnd.oasis.opendocument.presentation") - (".ods", "application/vnd.oasis.opendocument.spreadsheet") - (".odt", "application/vnd.oasis.opendocument.text") - (".oga", "audio/ogg") - (".ogg", "audio/ogg") - (".ogv", "video/ogg") - (".ogx", "application/ogg") - (".one", "application/onenote") - (".onea", "application/onenote") - (".onepkg", "application/onenote") - (".onetmp", "application/onenote") - (".onetoc", "application/onenote") - (".onetoc2", "application/onenote") - (".opus", "audio/ogg") - (".orderedtest", "application/xml") - (".osdx", "application/opensearchdescription+xml") - (".otf", "application/font-sfnt") - (".otg", "application/vnd.oasis.opendocument.graphics-template") - (".oth", "application/vnd.oasis.opendocument.text-web") - (".otp", "application/vnd.oasis.opendocument.presentation-template") - (".ots", "application/vnd.oasis.opendocument.spreadsheet-template") - (".ott", "application/vnd.oasis.opendocument.text-template") - (".oxt", "application/vnd.openofficeorg.extension") - (".p10", "application/pkcs10") - (".p12", "application/x-pkcs12") - (".p7b", "application/x-pkcs7-certificates") - (".p7c", "application/pkcs7-mime") - (".p7m", "application/pkcs7-mime") - (".p7r", "application/x-pkcs7-certreqresp") - (".p7s", "application/pkcs7-signature") - (".pbm", "image/x-portable-bitmap") - (".pcast", "application/x-podcast") - (".pct", "image/pict") - (".pcx", "application/octet-stream") - (".pcz", "application/octet-stream") - (".pdf", "application/pdf") - (".pfb", "application/octet-stream") - (".pfm", "application/octet-stream") - (".pfx", "application/x-pkcs12") - (".pgm", "image/x-portable-graymap") - (".pic", "image/pict") - (".pict", "image/pict") - (".pkgdef", "text/plain") - (".pkgundef", "text/plain") - (".pko", "application/vnd.ms-pki.pko") - (".pls", "audio/scpls") - (".pma", "application/x-perfmon") - (".pmc", "application/x-perfmon") - (".pml", "application/x-perfmon") - (".pmr", "application/x-perfmon") - (".pmw", "application/x-perfmon") - (".png", "image/png") - (".pnm", "image/x-portable-anymap") - (".pnt", "image/x-macpaint") - (".pntg", "image/x-macpaint") - (".pnz", "image/png") - (".pot", "application/vnd.ms-powerpoint") - (".potm", "application/vnd.ms-powerpoint.template.macroEnabled.12") - (".potx", "application/vnd.openxmlformats-officedocument.presentationml.template") - (".ppa", "application/vnd.ms-powerpoint") - (".ppam", "application/vnd.ms-powerpoint.addin.macroEnabled.12") - (".ppm", "image/x-portable-pixmap") - (".pps", "application/vnd.ms-powerpoint") - (".ppsm", "application/vnd.ms-powerpoint.slideshow.macroEnabled.12") - (".ppsx", "application/vnd.openxmlformats-officedocument.presentationml.slideshow") - (".ppt", "application/vnd.ms-powerpoint") - (".pptm", "application/vnd.ms-powerpoint.presentation.macroEnabled.12") - (".pptx", "application/vnd.openxmlformats-officedocument.presentationml.presentation") - (".prf", "application/pics-rules") - (".prm", "application/octet-stream") - (".prx", "application/octet-stream") - (".ps", "application/postscript") - (".psc1", "application/PowerShell") - (".psd", "application/octet-stream") - (".psess", "application/xml") - (".psm", "application/octet-stream") - (".psp", "application/octet-stream") - (".pub", "application/x-mspublisher") - (".pwz", "application/vnd.ms-powerpoint") - (".qht", "text/x-html-insertion") - (".qhtm", "text/x-html-insertion") - (".qt", "video/quicktime") - (".qti", "image/x-quicktime") - (".qtif", "image/x-quicktime") - (".qtl", "application/x-quicktimeplayer") - (".qxd", "application/octet-stream") - (".ra", "audio/x-pn-realaudio") - (".ram", "audio/x-pn-realaudio") - (".rar", "application/x-rar-compressed") - (".ras", "image/x-cmu-raster") - (".rat", "application/rat-file") - (".rc", "text/plain") - (".rc2", "text/plain") - (".rct", "text/plain") - (".rdlc", "application/xml") - (".reg", "text/plain") - (".resx", "application/xml") - (".rf", "image/vnd.rn-realflash") - (".rgb", "image/x-rgb") - (".rgs", "text/plain") - (".rm", "application/vnd.rn-realmedia") - (".rmi", "audio/mid") - (".rmp", "application/vnd.rn-rn_music_package") - (".roff", "application/x-troff") - (".rpm", "audio/x-pn-realaudio-plugin") - (".rqy", "text/x-ms-rqy") - (".rtf", "application/rtf") - (".rtx", "text/richtext") - (".ruleset", "application/xml") - (".s", "text/plain") - (".safariextz", "application/x-safari-safariextz") - (".scd", "application/x-msschedule") - (".scr", "text/plain") - (".sct", "text/scriptlet") - (".sd2", "audio/x-sd2") - (".sdp", "application/sdp") - (".sea", "application/octet-stream") - (".searchConnector-ms", "application/windows-search-connector+xml") - (".setpay", "application/set-payment-initiation") - (".setreg", "application/set-registration-initiation") - (".settings", "application/xml") - (".sgimb", "application/x-sgimb") - (".sgml", "text/sgml") - (".sh", "application/x-sh") - (".shar", "application/x-shar") - (".shtml", "text/html") - (".sit", "application/x-stuffit") - (".sitemap", "application/xml") - (".skin", "application/xml") - (".sldm", "application/vnd.ms-powerpoint.slide.macroEnabled.12") - (".sldx", "application/vnd.openxmlformats-officedocument.presentationml.slide") - (".slk", "application/vnd.ms-excel") - (".sln", "text/plain") - (".slupkg-ms", "application/x-ms-license") - (".smd", "audio/x-smd") - (".smi", "application/octet-stream") - (".smx", "audio/x-smd") - (".smz", "audio/x-smd") - (".snd", "audio/basic") - (".snippet", "application/xml") - (".snp", "application/octet-stream") - (".sol", "text/plain") - (".sor", "text/plain") - (".spc", "application/x-pkcs7-certificates") - (".spl", "application/futuresplash") - (".spx", "audio/ogg") - (".src", "application/x-wais-source") - (".srf", "text/plain") - (".SSISDeploymentManifest", "text/xml") - (".ssm", "application/streamingmedia") - (".sst", "application/vnd.ms-pki.certstore") - (".stl", "application/vnd.ms-pki.stl") - (".sv4cpio", "application/x-sv4cpio") - (".sv4crc", "application/x-sv4crc") - (".svc", "application/xml") - (".svg", "image/svg+xml") - (".swf", "application/x-shockwave-flash") - (".step", "application/step") - (".stp", "application/step") - (".t", "application/x-troff") - (".tar", "application/x-tar") - (".tcl", "application/x-tcl") - (".testrunconfig", "application/xml") - (".testsettings", "application/xml") - (".tex", "application/x-tex") - (".texi", "application/x-texinfo") - (".texinfo", "application/x-texinfo") - (".tgz", "application/x-compressed") - (".thmx", "application/vnd.ms-officetheme") - (".thn", "application/octet-stream") - (".tif", "image/tiff") - (".tiff", "image/tiff") - (".tlh", "text/plain") - (".tli", "text/plain") - (".toc", "application/octet-stream") - (".tr", "application/x-troff") - (".trm", "application/x-msterminal") - (".trx", "application/xml") - (".ts", "video/vnd.dlna.mpeg-tts") - (".tsv", "text/tab-separated-values") - (".ttf", "application/font-sfnt") - (".tts", "video/vnd.dlna.mpeg-tts") - (".txt", "text/plain") - (".u32", "application/octet-stream") - (".uls", "text/iuls") - (".user", "text/plain") - (".ustar", "application/x-ustar") - (".vb", "text/plain") - (".vbdproj", "text/plain") - (".vbk", "video/mpeg") - (".vbproj", "text/plain") - (".vbs", "text/vbscript") - (".vcf", "text/x-vcard") - (".vcproj", "application/xml") - (".vcs", "text/plain") - (".vcxproj", "application/xml") - (".vddproj", "text/plain") - (".vdp", "text/plain") - (".vdproj", "text/plain") - (".vdx", "application/vnd.ms-visio.viewer") - (".vml", "text/xml") - (".vscontent", "application/xml") - (".vsct", "text/xml") - (".vsd", "application/vnd.visio") - (".vsi", "application/ms-vsi") - (".vsix", "application/vsix") - (".vsixlangpack", "text/xml") - (".vsixmanifest", "text/xml") - (".vsmdi", "application/xml") - (".vspscc", "text/plain") - (".vss", "application/vnd.visio") - (".vsscc", "text/plain") - (".vssettings", "text/xml") - (".vssscc", "text/plain") - (".vst", "application/vnd.visio") - (".vstemplate", "text/xml") - (".vsto", "application/x-ms-vsto") - (".vsw", "application/vnd.visio") - (".vsx", "application/vnd.visio") - (".vtx", "application/vnd.visio") - (".wav", "audio/wav") - (".wave", "audio/wav") - (".wax", "audio/x-ms-wax") - (".wbk", "application/msword") - (".wbmp", "image/vnd.wap.wbmp") - (".wcm", "application/vnd.ms-works") - (".wdb", "application/vnd.ms-works") - (".wdp", "image/vnd.ms-photo") - (".webarchive", "application/x-safari-webarchive") - (".webm", "video/webm") - (".webp", "image/webp") - (".webtest", "application/xml") - (".wiq", "application/xml") - (".wiz", "application/msword") - (".wks", "application/vnd.ms-works") - (".WLMP", "application/wlmoviemaker") - (".wlpginstall", "application/x-wlpg-detect") - (".wlpginstall3", "application/x-wlpg3-detect") - (".wm", "video/x-ms-wm") - (".wma", "audio/x-ms-wma") - (".wmd", "application/x-ms-wmd") - (".wmf", "application/x-msmetafile") - (".wml", "text/vnd.wap.wml") - (".wmlc", "application/vnd.wap.wmlc") - (".wmls", "text/vnd.wap.wmlscript") - (".wmlsc", "application/vnd.wap.wmlscriptc") - (".wmp", "video/x-ms-wmp") - (".wmv", "video/x-ms-wmv") - (".wmx", "video/x-ms-wmx") - (".wmz", "application/x-ms-wmz") - (".woff", "application/font-woff") - (".wpl", "application/vnd.ms-wpl") - (".wps", "application/vnd.ms-works") - (".wri", "application/x-mswrite") - (".wrl", "x-world/x-vrml") - (".wrz", "x-world/x-vrml") - (".wsc", "text/scriptlet") - (".wsdl", "text/xml") - (".wvx", "video/x-ms-wvx") - (".x", "application/directx") - (".xaf", "x-world/x-vrml") - (".xaml", "application/xaml+xml") - (".xap", "application/x-silverlight-app") - (".xbap", "application/x-ms-xbap") - (".xbm", "image/x-xbitmap") - (".xdr", "text/plain") - (".xht", "application/xhtml+xml") - (".xhtml", "application/xhtml+xml") - (".xla", "application/vnd.ms-excel") - (".xlam", "application/vnd.ms-excel.addin.macroEnabled.12") - (".xlc", "application/vnd.ms-excel") - (".xld", "application/vnd.ms-excel") - (".xlk", "application/vnd.ms-excel") - (".xll", "application/vnd.ms-excel") - (".xlm", "application/vnd.ms-excel") - (".xls", "application/vnd.ms-excel") - (".xlsb", "application/vnd.ms-excel.sheet.binary.macroEnabled.12") - (".xlsm", "application/vnd.ms-excel.sheet.macroEnabled.12") - (".xlsx", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet") - (".xlt", "application/vnd.ms-excel") - (".xltm", "application/vnd.ms-excel.template.macroEnabled.12") - (".xltx", "application/vnd.openxmlformats-officedocument.spreadsheetml.template") - (".xlw", "application/vnd.ms-excel") - (".xml", "text/xml") - (".xmta", "application/xml") - (".xof", "x-world/x-vrml") - (".XOML", "text/plain") - (".xpm", "image/x-xpixmap") - (".xps", "application/vnd.ms-xpsdocument") - (".xrm-ms", "text/xml") - (".xsc", "application/xml") - (".xsd", "text/xml") - (".xsf", "text/xml") - (".xsl", "text/xml") - (".xslt", "text/xml") - (".xsn", "application/octet-stream") - (".xss", "application/xml") - (".xspf", "application/xspf+xml") - (".xtp", "application/octet-stream") - (".xwd", "image/x-xwindowdump") - (".z", "application/x-compress") - (".zip", "application/zip") |] + [| (".323", "text/h323") + (".3g2", "video/3gpp2") + (".3gp", "video/3gpp") + (".3gp2", "video/3gpp2") + (".3gpp", "video/3gpp") + (".7z", "application/x-7z-compressed") + (".aa", "audio/audible") + (".AAC", "audio/aac") + (".aaf", "application/octet-stream") + (".aax", "audio/vnd.audible.aax") + (".ac3", "audio/ac3") + (".aca", "application/octet-stream") + (".accda", "application/msaccess.addin") + (".accdb", "application/msaccess") + (".accdc", "application/msaccess.cab") + (".accde", "application/msaccess") + (".accdr", "application/msaccess.runtime") + (".accdt", "application/msaccess") + (".accdw", "application/msaccess.webapplication") + (".accft", "application/msaccess.ftemplate") + (".acx", "application/internet-property-stream") + (".AddIn", "text/xml") + (".ade", "application/msaccess") + (".adobebridge", "application/x-bridge-url") + (".adp", "application/msaccess") + (".ADT", "audio/vnd.dlna.adts") + (".ADTS", "audio/aac") + (".afm", "application/octet-stream") + (".ai", "application/postscript") + (".aif", "audio/aiff") + (".aifc", "audio/aiff") + (".aiff", "audio/aiff") + (".air", "application/vnd.adobe.air-application-installer-package+zip") + (".amc", "application/mpeg") + (".anx", "application/annodex") + (".apk", "application/vnd.android.package-archive") + (".application", "application/x-ms-application") + (".art", "image/x-jg") + (".asa", "application/xml") + (".asax", "application/xml") + (".ascx", "application/xml") + (".asd", "application/octet-stream") + (".asf", "video/x-ms-asf") + (".ashx", "application/xml") + (".asi", "application/octet-stream") + (".asm", "text/plain") + (".asmx", "application/xml") + (".aspx", "application/xml") + (".asr", "video/x-ms-asf") + (".asx", "video/x-ms-asf") + (".atom", "application/atom+xml") + (".au", "audio/basic") + (".avi", "video/x-msvideo") + (".axa", "audio/annodex") + (".axs", "application/olescript") + (".axv", "video/annodex") + (".bas", "text/plain") + (".bcpio", "application/x-bcpio") + (".bin", "application/octet-stream") + (".bmp", "image/bmp") + (".c", "text/plain") + (".cab", "application/octet-stream") + (".caf", "audio/x-caf") + (".calx", "application/vnd.ms-office.calx") + (".cat", "application/vnd.ms-pki.seccat") + (".cc", "text/plain") + (".cd", "text/plain") + (".cdda", "audio/aiff") + (".cdf", "application/x-cdf") + (".cer", "application/x-x509-ca-cert") + (".cfg", "text/plain") + (".chm", "application/octet-stream") + (".class", "application/x-java-applet") + (".clp", "application/x-msclip") + (".cmd", "text/plain") + (".cmx", "image/x-cmx") + (".cnf", "text/plain") + (".cod", "image/cis-cod") + (".config", "application/xml") + (".contact", "text/x-ms-contact") + (".coverage", "application/xml") + (".cpio", "application/x-cpio") + (".cpp", "text/plain") + (".crd", "application/x-mscardfile") + (".crl", "application/pkix-crl") + (".crt", "application/x-x509-ca-cert") + (".cs", "text/plain") + (".csdproj", "text/plain") + (".csh", "application/x-csh") + (".csproj", "text/plain") + (".css", "text/css") + (".csv", "text/csv") + (".cur", "application/octet-stream") + (".cxx", "text/plain") + (".dat", "application/octet-stream") + (".datasource", "application/xml") + (".dbproj", "text/plain") + (".dcr", "application/x-director") + (".def", "text/plain") + (".deploy", "application/octet-stream") + (".der", "application/x-x509-ca-cert") + (".dgml", "application/xml") + (".dib", "image/bmp") + (".dif", "video/x-dv") + (".dir", "application/x-director") + (".disco", "text/xml") + (".divx", "video/divx") + (".dll", "application/x-msdownload") + (".dll.config", "text/xml") + (".dlm", "text/dlm") + (".doc", "application/msword") + (".docm", "application/vnd.ms-word.document.macroEnabled.12") + (".docx", "application/vnd.openxmlformats-officedocument.wordprocessingml.document") + (".dot", "application/msword") + (".dotm", "application/vnd.ms-word.template.macroEnabled.12") + (".dotx", "application/vnd.openxmlformats-officedocument.wordprocessingml.template") + (".dsp", "application/octet-stream") + (".dsw", "text/plain") + (".dtd", "text/xml") + (".dtsConfig", "text/xml") + (".dv", "video/x-dv") + (".dvi", "application/x-dvi") + (".dwf", "drawing/x-dwf") + (".dwp", "application/octet-stream") + (".dxr", "application/x-director") + (".eml", "message/rfc822") + (".emz", "application/octet-stream") + (".eot", "application/vnd.ms-fontobject") + (".eps", "application/postscript") + (".etl", "application/etl") + (".etx", "text/x-setext") + (".evy", "application/envoy") + (".exe", "application/octet-stream") + (".exe.config", "text/xml") + (".fdf", "application/vnd.fdf") + (".fif", "application/fractals") + (".filters", "application/xml") + (".fla", "application/octet-stream") + (".flac", "audio/flac") + (".flr", "x-world/x-vrml") + (".flv", "video/x-flv") + (".fsscript", "application/fsharp-script") + (".fsx", "application/fsharp-script") + (".generictest", "application/xml") + (".gif", "image/gif") + (".gpx", "application/gpx+xml") + (".group", "text/x-ms-group") + (".gsm", "audio/x-gsm") + (".gtar", "application/x-gtar") + (".gz", "application/x-gzip") + (".h", "text/plain") + (".hdf", "application/x-hdf") + (".hdml", "text/x-hdml") + (".hhc", "application/x-oleobject") + (".hhk", "application/octet-stream") + (".hhp", "application/octet-stream") + (".hlp", "application/winhlp") + (".hpp", "text/plain") + (".hqx", "application/mac-binhex40") + (".hta", "application/hta") + (".htc", "text/x-component") + (".htm", "text/html") + (".html", "text/html") + (".htt", "text/webviewhtml") + (".hxa", "application/xml") + (".hxc", "application/xml") + (".hxd", "application/octet-stream") + (".hxe", "application/xml") + (".hxf", "application/xml") + (".hxh", "application/octet-stream") + (".hxi", "application/octet-stream") + (".hxk", "application/xml") + (".hxq", "application/octet-stream") + (".hxr", "application/octet-stream") + (".hxs", "application/octet-stream") + (".hxt", "text/html") + (".hxv", "application/xml") + (".hxw", "application/octet-stream") + (".hxx", "text/plain") + (".i", "text/plain") + (".ico", "image/x-icon") + (".ics", "application/octet-stream") + (".idl", "text/plain") + (".ief", "image/ief") + (".iii", "application/x-iphone") + (".inc", "text/plain") + (".inf", "application/octet-stream") + (".ini", "text/plain") + (".inl", "text/plain") + (".ins", "application/x-internet-signup") + (".ipa", "application/x-itunes-ipa") + (".ipg", "application/x-itunes-ipg") + (".ipproj", "text/plain") + (".ipsw", "application/x-itunes-ipsw") + (".iqy", "text/x-ms-iqy") + (".isp", "application/x-internet-signup") + (".ite", "application/x-itunes-ite") + (".itlp", "application/x-itunes-itlp") + (".itms", "application/x-itunes-itms") + (".itpc", "application/x-itunes-itpc") + (".IVF", "video/x-ivf") + (".jar", "application/java-archive") + (".java", "application/octet-stream") + (".jck", "application/liquidmotion") + (".jcz", "application/liquidmotion") + (".jfif", "image/pjpeg") + (".jnlp", "application/x-java-jnlp-file") + (".jpb", "application/octet-stream") + (".jpe", "image/jpeg") + (".jpeg", "image/jpeg") + (".jpg", "image/jpeg") + (".js", "application/javascript") + (".json", "application/json") + (".jsx", "text/jscript") + (".jsxbin", "text/plain") + (".latex", "application/x-latex") + (".library-ms", "application/windows-library+xml") + (".lit", "application/x-ms-reader") + (".loadtest", "application/xml") + (".lpk", "application/octet-stream") + (".lsf", "video/x-la-asf") + (".lst", "text/plain") + (".lsx", "video/x-la-asf") + (".lzh", "application/octet-stream") + (".m13", "application/x-msmediaview") + (".m14", "application/x-msmediaview") + (".m1v", "video/mpeg") + (".m2t", "video/vnd.dlna.mpeg-tts") + (".m2ts", "video/vnd.dlna.mpeg-tts") + (".m2v", "video/mpeg") + (".m3u", "audio/x-mpegurl") + (".m3u8", "audio/x-mpegurl") + (".m4a", "audio/m4a") + (".m4b", "audio/m4b") + (".m4p", "audio/m4p") + (".m4r", "audio/x-m4r") + (".m4v", "video/x-m4v") + (".mac", "image/x-macpaint") + (".mak", "text/plain") + (".man", "application/x-troff-man") + (".manifest", "application/x-ms-manifest") + (".map", "text/plain") + (".master", "application/xml") + (".mda", "application/msaccess") + (".mdb", "application/x-msaccess") + (".mde", "application/msaccess") + (".mdp", "application/octet-stream") + (".me", "application/x-troff-me") + (".mfp", "application/x-shockwave-flash") + (".mht", "message/rfc822") + (".mhtml", "message/rfc822") + (".mid", "audio/mid") + (".midi", "audio/mid") + (".mix", "application/octet-stream") + (".mk", "text/plain") + (".mmf", "application/x-smaf") + (".mno", "text/xml") + (".mny", "application/x-msmoney") + (".mod", "video/mpeg") + (".mov", "video/quicktime") + (".movie", "video/x-sgi-movie") + (".mp2", "video/mpeg") + (".mp2v", "video/mpeg") + (".mp3", "audio/mpeg") + (".mp4", "video/mp4") + (".mp4v", "video/mp4") + (".mpa", "video/mpeg") + (".mpe", "video/mpeg") + (".mpeg", "video/mpeg") + (".mpf", "application/vnd.ms-mediapackage") + (".mpg", "video/mpeg") + (".mpp", "application/vnd.ms-project") + (".mpv2", "video/mpeg") + (".mqv", "video/quicktime") + (".ms", "application/x-troff-ms") + (".msi", "application/octet-stream") + (".mso", "application/octet-stream") + (".mts", "video/vnd.dlna.mpeg-tts") + (".mtx", "application/xml") + (".mvb", "application/x-msmediaview") + (".mvc", "application/x-miva-compiled") + (".mxp", "application/x-mmxp") + (".nc", "application/x-netcdf") + (".nsc", "video/x-ms-asf") + (".nws", "message/rfc822") + (".ocx", "application/octet-stream") + (".oda", "application/oda") + (".odb", "application/vnd.oasis.opendocument.database") + (".odc", "application/vnd.oasis.opendocument.chart") + (".odf", "application/vnd.oasis.opendocument.formula") + (".odg", "application/vnd.oasis.opendocument.graphics") + (".odh", "text/plain") + (".odi", "application/vnd.oasis.opendocument.image") + (".odl", "text/plain") + (".odm", "application/vnd.oasis.opendocument.text-master") + (".odp", "application/vnd.oasis.opendocument.presentation") + (".ods", "application/vnd.oasis.opendocument.spreadsheet") + (".odt", "application/vnd.oasis.opendocument.text") + (".oga", "audio/ogg") + (".ogg", "audio/ogg") + (".ogv", "video/ogg") + (".ogx", "application/ogg") + (".one", "application/onenote") + (".onea", "application/onenote") + (".onepkg", "application/onenote") + (".onetmp", "application/onenote") + (".onetoc", "application/onenote") + (".onetoc2", "application/onenote") + (".opus", "audio/ogg") + (".orderedtest", "application/xml") + (".osdx", "application/opensearchdescription+xml") + (".otf", "application/font-sfnt") + (".otg", "application/vnd.oasis.opendocument.graphics-template") + (".oth", "application/vnd.oasis.opendocument.text-web") + (".otp", "application/vnd.oasis.opendocument.presentation-template") + (".ots", "application/vnd.oasis.opendocument.spreadsheet-template") + (".ott", "application/vnd.oasis.opendocument.text-template") + (".oxt", "application/vnd.openofficeorg.extension") + (".p10", "application/pkcs10") + (".p12", "application/x-pkcs12") + (".p7b", "application/x-pkcs7-certificates") + (".p7c", "application/pkcs7-mime") + (".p7m", "application/pkcs7-mime") + (".p7r", "application/x-pkcs7-certreqresp") + (".p7s", "application/pkcs7-signature") + (".pbm", "image/x-portable-bitmap") + (".pcast", "application/x-podcast") + (".pct", "image/pict") + (".pcx", "application/octet-stream") + (".pcz", "application/octet-stream") + (".pdf", "application/pdf") + (".pfb", "application/octet-stream") + (".pfm", "application/octet-stream") + (".pfx", "application/x-pkcs12") + (".pgm", "image/x-portable-graymap") + (".pic", "image/pict") + (".pict", "image/pict") + (".pkgdef", "text/plain") + (".pkgundef", "text/plain") + (".pko", "application/vnd.ms-pki.pko") + (".pls", "audio/scpls") + (".pma", "application/x-perfmon") + (".pmc", "application/x-perfmon") + (".pml", "application/x-perfmon") + (".pmr", "application/x-perfmon") + (".pmw", "application/x-perfmon") + (".png", "image/png") + (".pnm", "image/x-portable-anymap") + (".pnt", "image/x-macpaint") + (".pntg", "image/x-macpaint") + (".pnz", "image/png") + (".pot", "application/vnd.ms-powerpoint") + (".potm", "application/vnd.ms-powerpoint.template.macroEnabled.12") + (".potx", "application/vnd.openxmlformats-officedocument.presentationml.template") + (".ppa", "application/vnd.ms-powerpoint") + (".ppam", "application/vnd.ms-powerpoint.addin.macroEnabled.12") + (".ppm", "image/x-portable-pixmap") + (".pps", "application/vnd.ms-powerpoint") + (".ppsm", "application/vnd.ms-powerpoint.slideshow.macroEnabled.12") + (".ppsx", "application/vnd.openxmlformats-officedocument.presentationml.slideshow") + (".ppt", "application/vnd.ms-powerpoint") + (".pptm", "application/vnd.ms-powerpoint.presentation.macroEnabled.12") + (".pptx", "application/vnd.openxmlformats-officedocument.presentationml.presentation") + (".prf", "application/pics-rules") + (".prm", "application/octet-stream") + (".prx", "application/octet-stream") + (".ps", "application/postscript") + (".psc1", "application/PowerShell") + (".psd", "application/octet-stream") + (".psess", "application/xml") + (".psm", "application/octet-stream") + (".psp", "application/octet-stream") + (".pub", "application/x-mspublisher") + (".pwz", "application/vnd.ms-powerpoint") + (".qht", "text/x-html-insertion") + (".qhtm", "text/x-html-insertion") + (".qt", "video/quicktime") + (".qti", "image/x-quicktime") + (".qtif", "image/x-quicktime") + (".qtl", "application/x-quicktimeplayer") + (".qxd", "application/octet-stream") + (".ra", "audio/x-pn-realaudio") + (".ram", "audio/x-pn-realaudio") + (".rar", "application/x-rar-compressed") + (".ras", "image/x-cmu-raster") + (".rat", "application/rat-file") + (".rc", "text/plain") + (".rc2", "text/plain") + (".rct", "text/plain") + (".rdlc", "application/xml") + (".reg", "text/plain") + (".resx", "application/xml") + (".rf", "image/vnd.rn-realflash") + (".rgb", "image/x-rgb") + (".rgs", "text/plain") + (".rm", "application/vnd.rn-realmedia") + (".rmi", "audio/mid") + (".rmp", "application/vnd.rn-rn_music_package") + (".roff", "application/x-troff") + (".rpm", "audio/x-pn-realaudio-plugin") + (".rqy", "text/x-ms-rqy") + (".rtf", "application/rtf") + (".rtx", "text/richtext") + (".ruleset", "application/xml") + (".s", "text/plain") + (".safariextz", "application/x-safari-safariextz") + (".scd", "application/x-msschedule") + (".scr", "text/plain") + (".sct", "text/scriptlet") + (".sd2", "audio/x-sd2") + (".sdp", "application/sdp") + (".sea", "application/octet-stream") + (".searchConnector-ms", "application/windows-search-connector+xml") + (".setpay", "application/set-payment-initiation") + (".setreg", "application/set-registration-initiation") + (".settings", "application/xml") + (".sgimb", "application/x-sgimb") + (".sgml", "text/sgml") + (".sh", "application/x-sh") + (".shar", "application/x-shar") + (".shtml", "text/html") + (".sit", "application/x-stuffit") + (".sitemap", "application/xml") + (".skin", "application/xml") + (".sldm", "application/vnd.ms-powerpoint.slide.macroEnabled.12") + (".sldx", "application/vnd.openxmlformats-officedocument.presentationml.slide") + (".slk", "application/vnd.ms-excel") + (".sln", "text/plain") + (".slupkg-ms", "application/x-ms-license") + (".smd", "audio/x-smd") + (".smi", "application/octet-stream") + (".smx", "audio/x-smd") + (".smz", "audio/x-smd") + (".snd", "audio/basic") + (".snippet", "application/xml") + (".snp", "application/octet-stream") + (".sol", "text/plain") + (".sor", "text/plain") + (".spc", "application/x-pkcs7-certificates") + (".spl", "application/futuresplash") + (".spx", "audio/ogg") + (".src", "application/x-wais-source") + (".srf", "text/plain") + (".SSISDeploymentManifest", "text/xml") + (".ssm", "application/streamingmedia") + (".sst", "application/vnd.ms-pki.certstore") + (".stl", "application/vnd.ms-pki.stl") + (".sv4cpio", "application/x-sv4cpio") + (".sv4crc", "application/x-sv4crc") + (".svc", "application/xml") + (".svg", "image/svg+xml") + (".swf", "application/x-shockwave-flash") + (".step", "application/step") + (".stp", "application/step") + (".t", "application/x-troff") + (".tar", "application/x-tar") + (".tcl", "application/x-tcl") + (".testrunconfig", "application/xml") + (".testsettings", "application/xml") + (".tex", "application/x-tex") + (".texi", "application/x-texinfo") + (".texinfo", "application/x-texinfo") + (".tgz", "application/x-compressed") + (".thmx", "application/vnd.ms-officetheme") + (".thn", "application/octet-stream") + (".tif", "image/tiff") + (".tiff", "image/tiff") + (".tlh", "text/plain") + (".tli", "text/plain") + (".toc", "application/octet-stream") + (".tr", "application/x-troff") + (".trm", "application/x-msterminal") + (".trx", "application/xml") + (".ts", "video/vnd.dlna.mpeg-tts") + (".tsv", "text/tab-separated-values") + (".ttf", "application/font-sfnt") + (".tts", "video/vnd.dlna.mpeg-tts") + (".txt", "text/plain") + (".u32", "application/octet-stream") + (".uls", "text/iuls") + (".user", "text/plain") + (".ustar", "application/x-ustar") + (".vb", "text/plain") + (".vbdproj", "text/plain") + (".vbk", "video/mpeg") + (".vbproj", "text/plain") + (".vbs", "text/vbscript") + (".vcf", "text/x-vcard") + (".vcproj", "application/xml") + (".vcs", "text/plain") + (".vcxproj", "application/xml") + (".vddproj", "text/plain") + (".vdp", "text/plain") + (".vdproj", "text/plain") + (".vdx", "application/vnd.ms-visio.viewer") + (".vml", "text/xml") + (".vscontent", "application/xml") + (".vsct", "text/xml") + (".vsd", "application/vnd.visio") + (".vsi", "application/ms-vsi") + (".vsix", "application/vsix") + (".vsixlangpack", "text/xml") + (".vsixmanifest", "text/xml") + (".vsmdi", "application/xml") + (".vspscc", "text/plain") + (".vss", "application/vnd.visio") + (".vsscc", "text/plain") + (".vssettings", "text/xml") + (".vssscc", "text/plain") + (".vst", "application/vnd.visio") + (".vstemplate", "text/xml") + (".vsto", "application/x-ms-vsto") + (".vsw", "application/vnd.visio") + (".vsx", "application/vnd.visio") + (".vtx", "application/vnd.visio") + (".wav", "audio/wav") + (".wave", "audio/wav") + (".wax", "audio/x-ms-wax") + (".wbk", "application/msword") + (".wbmp", "image/vnd.wap.wbmp") + (".wcm", "application/vnd.ms-works") + (".wdb", "application/vnd.ms-works") + (".wdp", "image/vnd.ms-photo") + (".webarchive", "application/x-safari-webarchive") + (".webm", "video/webm") + (".webp", "image/webp") + (".webtest", "application/xml") + (".wiq", "application/xml") + (".wiz", "application/msword") + (".wks", "application/vnd.ms-works") + (".WLMP", "application/wlmoviemaker") + (".wlpginstall", "application/x-wlpg-detect") + (".wlpginstall3", "application/x-wlpg3-detect") + (".wm", "video/x-ms-wm") + (".wma", "audio/x-ms-wma") + (".wmd", "application/x-ms-wmd") + (".wmf", "application/x-msmetafile") + (".wml", "text/vnd.wap.wml") + (".wmlc", "application/vnd.wap.wmlc") + (".wmls", "text/vnd.wap.wmlscript") + (".wmlsc", "application/vnd.wap.wmlscriptc") + (".wmp", "video/x-ms-wmp") + (".wmv", "video/x-ms-wmv") + (".wmx", "video/x-ms-wmx") + (".wmz", "application/x-ms-wmz") + (".woff", "application/font-woff") + (".wpl", "application/vnd.ms-wpl") + (".wps", "application/vnd.ms-works") + (".wri", "application/x-mswrite") + (".wrl", "x-world/x-vrml") + (".wrz", "x-world/x-vrml") + (".wsc", "text/scriptlet") + (".wsdl", "text/xml") + (".wvx", "video/x-ms-wvx") + (".x", "application/directx") + (".xaf", "x-world/x-vrml") + (".xaml", "application/xaml+xml") + (".xap", "application/x-silverlight-app") + (".xbap", "application/x-ms-xbap") + (".xbm", "image/x-xbitmap") + (".xdr", "text/plain") + (".xht", "application/xhtml+xml") + (".xhtml", "application/xhtml+xml") + (".xla", "application/vnd.ms-excel") + (".xlam", "application/vnd.ms-excel.addin.macroEnabled.12") + (".xlc", "application/vnd.ms-excel") + (".xld", "application/vnd.ms-excel") + (".xlk", "application/vnd.ms-excel") + (".xll", "application/vnd.ms-excel") + (".xlm", "application/vnd.ms-excel") + (".xls", "application/vnd.ms-excel") + (".xlsb", "application/vnd.ms-excel.sheet.binary.macroEnabled.12") + (".xlsm", "application/vnd.ms-excel.sheet.macroEnabled.12") + (".xlsx", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet") + (".xlt", "application/vnd.ms-excel") + (".xltm", "application/vnd.ms-excel.template.macroEnabled.12") + (".xltx", "application/vnd.openxmlformats-officedocument.spreadsheetml.template") + (".xlw", "application/vnd.ms-excel") + (".xml", "text/xml") + (".xmta", "application/xml") + (".xof", "x-world/x-vrml") + (".XOML", "text/plain") + (".xpm", "image/x-xpixmap") + (".xps", "application/vnd.ms-xpsdocument") + (".xrm-ms", "text/xml") + (".xsc", "application/xml") + (".xsd", "text/xml") + (".xsf", "text/xml") + (".xsl", "text/xml") + (".xslt", "text/xml") + (".xsn", "application/octet-stream") + (".xss", "application/xml") + (".xspf", "application/xspf+xml") + (".xtp", "application/octet-stream") + (".xwd", "image/x-xwindowdump") + (".z", "application/x-compress") + (".zip", "application/zip") |] let private map = Map.ofArray pairs - - let tryFind (ext: string) = Map.tryFind (ext.ToLowerInvariant()) map + + let tryFind (ext: string) = + Map.tryFind (ext.ToLowerInvariant()) map /// Constants for common HTTP encodings module HttpEncodings = @@ -1230,7 +1369,7 @@ module HttpEncodings = /// ISO-8859-1 let ResponseDefaultEncoding = Encoding.GetEncoding("ISO-8859-1") // http://www.ietf.org/rfc/rfc2616.txt - let internal getEncoding (encodingStr:string) = + let internal getEncoding (encodingStr: string) = match Int32.TryParse(encodingStr, NumberStyles.Integer, CultureInfo.InvariantCulture) with | true, codepage -> Encoding.GetEncoding codepage | _ -> Encoding.GetEncoding encodingStr @@ -1241,30 +1380,32 @@ module internal HttpHelpers = /// Decorator for System.Net.WebResponse class /// used to make response stream seekable /// in order to preserve it in the new response - type WebResponse(res : System.Net.WebResponse) = + type WebResponse(res: System.Net.WebResponse) = inherit System.Net.WebResponse() - let copyToMemoryStream (inputStream : Stream) = - let bufferLen : int = 4096 - let buffer : byte array = Array.zeroCreate bufferLen + let copyToMemoryStream (inputStream: Stream) = + let bufferLen: int = 4096 + let buffer: byte array = Array.zeroCreate bufferLen let outputStream = new MemoryStream() + let rec copy () = match inputStream.Read(buffer, 0, bufferLen) with | count when count > 0 -> outputStream.Write(buffer, 0, count) copy () | _ -> () + copy () outputStream.Position <- 0L outputStream let responseStream = res.GetResponseStream() |> copyToMemoryStream - let httpProperty f = + let httpProperty f = match res with - | :? HttpWebResponse as httpRes -> Some (f httpRes) - | _ -> None + | :? HttpWebResponse as httpRes -> Some(f httpRes) + | _ -> None override x.Headers = res.Headers override x.ResponseUri = res.ResponseUri @@ -1273,9 +1414,9 @@ module internal HttpHelpers = override x.SupportsHeaders = res.SupportsHeaders override x.IsFromCache = res.IsFromCache override x.IsMutuallyAuthenticated = res.IsMutuallyAuthenticated - override x.Close () = res.Close() - override x.GetResponseStream () = responseStream :> Stream - member x.ResetResponseStream () = responseStream.Position <- 0L + override x.Close() = res.Close() + override x.GetResponseStream() = responseStream :> Stream + member x.ResetResponseStream() = responseStream.Position <- 0L member x.CharacterSet = httpProperty (fun r -> r.CharacterSet) member x.ContentEncoding = httpProperty (fun r -> r.ContentEncoding) @@ -1284,31 +1425,39 @@ module internal HttpHelpers = member x.Method = httpProperty (fun r -> r.Method) member x.ProtocolVersion = httpProperty (fun r -> r.ProtocolVersion) member x.Server = httpProperty (fun r -> r.Server) - member x.StatusCode = httpProperty (fun r -> r.StatusCode) + member x.StatusCode = httpProperty (fun r -> r.StatusCode) member x.StatusDescription = httpProperty (fun r -> r.StatusDescription) member x.InnerResponse = res - + interface IDisposable with - member x.Dispose () = + member x.Dispose() = match res :> obj with - | :? IDisposable as res -> res.Dispose () + | :? IDisposable as res -> res.Dispose() | _ -> () - responseStream.Dispose () + + responseStream.Dispose() /// consumes a stream asynchronously until the end /// and returns a memory stream with the full content - let asyncRead (stream:Stream) = async { - use stream = stream - let output = new MemoryStream () - do! stream.CopyToAsync(output) |> Async.AwaitIAsyncResult |> Async.Ignore - output.Seek(0L, SeekOrigin.Begin) |> ignore - return output - } + let asyncRead (stream: Stream) = + async { + use stream = stream + let output = new MemoryStream() + + do! + stream.CopyToAsync(output) + |> Async.AwaitIAsyncResult + |> Async.Ignore + + output.Seek(0L, SeekOrigin.Begin) |> ignore + return output + } /// A stream class that abstracts away writing the contents of a series of other streams, closing them as they are consumed. Non-seekable, reading-only stream. type CombinedStream(length, streams: Stream seq) = - inherit Stream() with + inherit Stream() + with let mutable v = 0L let mutable streams = streams |> Seq.cache @@ -1316,30 +1465,54 @@ module internal HttpHelpers = match streams |> Seq.tryHead with | None -> 0 | Some stream -> - let qty = if stream.CanSeek then min count (int stream.Length) else count + let qty = + if stream.CanSeek then + min count (int stream.Length) + else + count + let read = stream.Read(buffer, offset, qty) - if read < count - then + + if read < count then stream.Dispose() streams <- streams |> Seq.skip 1 let readFromRest = readFromStream buffer (offset + read) (count - read) read + readFromRest - else read + else + read override x.CanRead = true - override x.CanSeek = match length with | None -> false | Some _ -> true + + override x.CanSeek = + match length with + | None -> false + | Some _ -> true + override x.CanWrite = false - override x.Length with get () = length |> Option.defaultWith (fun () -> failwith "One or more of the encompassed streams are not seekable and the length cannot be determine") - override x.Position with get () = v and set(_) = failwith "no position setting" + + override x.Length = + length + |> Option.defaultWith (fun () -> + failwith + "One or more of the encompassed streams are not seekable and the length cannot be determine") + + override x.Position + with get () = v + and set (_) = failwith "no position setting" + override x.Flush() = () override x.CanTimeout = false - override x.Seek(_,_) = failwith "no seeking" + override x.Seek(_, _) = failwith "no seeking" override x.SetLength(_) = failwith "no setting length" - override x.Write(_,_,_) = failwith "no writing" + override x.Write(_, _, _) = failwith "no writing" override x.WriteByte(_) = failwith "seriously, no writing" override x.Read(buffer, offset, count) = readFromStream buffer offset count + interface IDisposable with - member x.Dispose() = streams |> Seq.iter (fun s -> s.Dispose()) |> ignore + member x.Dispose() = + streams + |> Seq.iter (fun s -> s.Dispose()) + |> ignore /// 1) compute length (parts.Length * boundary_size) + Sum(parts.Streams.Length) /// 2) foreach part (formFieldName, fileName, fileContent) @@ -1348,39 +1521,56 @@ module internal HttpHelpers = /// c) write newline /// d) write section data /// 3) write trailing boundary - let writeMultipart (boundary: string) (parts: seq) (e : Encoding) = - let newlineStream () = new MemoryStream(e.GetBytes "\r\n") :> Stream + let writeMultipart (boundary: string) (parts: seq) (e: Encoding) = + let newlineStream () = + new MemoryStream(e.GetBytes "\r\n") :> Stream + let prefixedBoundary = sprintf "--%s" boundary + let trySumLength streams = //allows seq to be blocking & non seekable let mutable seekable = true let mutable length = 0L + let takeIfSeekable (str: Stream) = seekable <- str.CanSeek if str.CanSeek then length <- length + str.Length str.CanSeek - streams |> Seq.takeWhile takeIfSeekable |> List.ofSeq |> ignore + + streams + |> Seq.takeWhile takeIfSeekable + |> List.ofSeq + |> ignore + if seekable then Some length else None - let segments = parts |> Seq.map (fun (MultipartItem(formField, fileName, contentStream)) -> - let fileExt = Path.GetExtension fileName - let contentType = defaultArg (MimeTypes.tryFind fileExt) "application/octet-stream" - let printHeader (header, value) = sprintf "%s: %s" header value - let headerpart = - [ prefixedBoundary - HttpRequestHeaders.ContentDisposition("form-data", Some formField, Some fileName) |> printHeader - HttpRequestHeaders.ContentType contentType |> printHeader ] - |> String.concat "\r\n" - let headerStream = - let bytes = e.GetBytes headerpart - new MemoryStream(bytes) :> Stream - let partSubstreams = - [ headerStream - newlineStream() - newlineStream() - contentStream - newlineStream()] - let partLength = partSubstreams |> trySumLength - new CombinedStream(partLength, partSubstreams) :> Stream - ) + + let segments = + parts + |> Seq.map (fun (MultipartItem (formField, fileName, contentStream)) -> + let fileExt = Path.GetExtension fileName + let contentType = defaultArg (MimeTypes.tryFind fileExt) "application/octet-stream" + let printHeader (header, value) = sprintf "%s: %s" header value + + let headerpart = + [ prefixedBoundary + HttpRequestHeaders.ContentDisposition("form-data", Some formField, Some fileName) + |> printHeader + HttpRequestHeaders.ContentType contentType + |> printHeader ] + |> String.concat "\r\n" + + let headerStream = + let bytes = e.GetBytes headerpart + new MemoryStream(bytes) :> Stream + + let partSubstreams = + [ headerStream + newlineStream () + newlineStream () + contentStream + newlineStream () ] + + let partLength = partSubstreams |> trySumLength + new CombinedStream(partLength, partSubstreams) :> Stream) /// per spec, the end boundary is the given boundary with a trailing -- let endBoundaryStream = @@ -1389,72 +1579,106 @@ module internal HttpHelpers = new MemoryStream(bytes) :> Stream /// per spec, close-delimiter := "--" boundary "--" CRLF ; no need extra newline - let wholePayload = Seq.append segments [ endBoundaryStream; ] + let wholePayload = Seq.append segments [ endBoundaryStream ] let wholePayloadLength = wholePayload |> trySumLength new CombinedStream(wholePayloadLength, wholePayload) :> Stream let asyncCopy (source: Stream) (dest: Stream) = async { - do! source.CopyToAsync(dest) |> Async.AwaitIAsyncResult |> Async.Ignore - source.Dispose () + do! + source.CopyToAsync(dest) + |> Async.AwaitIAsyncResult + |> Async.Ignore + + source.Dispose() } - let runningOnMono = try System.Type.GetType("Mono.Runtime") <> null with e -> false + let runningOnMono = + try + System.Type.GetType("Mono.Runtime") <> null + with e -> + false - let writeBody (req:HttpWebRequest) (data: Stream) = + let writeBody (req: HttpWebRequest) (data: Stream) = async { - if data.CanSeek then - req.ContentLength <- data.Length - use! output = req.GetRequestStreamAsync () |> Async.AwaitTask + if data.CanSeek then req.ContentLength <- data.Length + use! output = req.GetRequestStreamAsync() |> Async.AwaitTask do! asyncCopy data output output.Flush() } - let reraisePreserveStackTrace (e:Exception) = + let reraisePreserveStackTrace (e: Exception) = try - let remoteStackTraceString = typeof.GetField("_remoteStackTraceString", BindingFlags.Instance ||| BindingFlags.NonPublic); + let remoteStackTraceString = + typeof.GetField ("_remoteStackTraceString", BindingFlags.Instance ||| BindingFlags.NonPublic) + if remoteStackTraceString <> null then remoteStackTraceString.SetValue(e, e.StackTrace + Environment.NewLine) - with _ -> () + with _ -> + () + raise e - let augmentWebExceptionsWithDetails f = async { - try - return! f() - with + let augmentWebExceptionsWithDetails f = + async { + try + return! f () + with // If an exception happens, augment the message with the response | :? WebException as exn -> - if exn.Response = null then reraisePreserveStackTrace exn - let responseExn = - try - let newResponse = new WebResponse(exn.Response) - let responseStream = newResponse.GetResponseStream() - let streamReader = new StreamReader(responseStream) - let responseText = streamReader.ReadToEnd() - newResponse.ResetResponseStream () - if String.IsNullOrEmpty responseText then None - else Some(WebException(sprintf "%s\nResponse from %s:\n%s" exn.Message newResponse.ResponseUri.OriginalString responseText, exn, exn.Status, newResponse)) - with _ -> None - match responseExn with - | Some e -> raise e - | None -> reraisePreserveStackTrace exn - // just to keep the type-checker happy: - return Unchecked.defaultof<_> - } + if exn.Response = null then reraisePreserveStackTrace exn + + let responseExn = + try + let newResponse = new WebResponse(exn.Response) + let responseStream = newResponse.GetResponseStream() + let streamReader = new StreamReader(responseStream) + let responseText = streamReader.ReadToEnd() + newResponse.ResetResponseStream() + + if String.IsNullOrEmpty responseText then + None + else + Some( + WebException( + sprintf + "%s\nResponse from %s:\n%s" + exn.Message + newResponse.ResponseUri.OriginalString + responseText, + exn, + exn.Status, + newResponse + ) + ) + with _ -> + None + + match responseExn with + | Some e -> raise e + | None -> reraisePreserveStackTrace exn + // just to keep the type-checker happy: + return Unchecked.defaultof<_> + } let rec checkForRepeatedHeaders visitedHeaders remainingHeaders = match remainingHeaders with | [] -> () - | header::remainingHeaders -> + | header :: remainingHeaders -> for visitedHeader in visitedHeaders do let name1, name2 = fst header, fst visitedHeader - if name1 = name2 then failwithf "Repeated headers: %A %A" visitedHeader header - checkForRepeatedHeaders (header::visitedHeaders) remainingHeaders - let setHeaders headers (req:HttpWebRequest) = + if name1 = name2 then + failwithf "Repeated headers: %A %A" visitedHeader header + + checkForRepeatedHeaders (header :: visitedHeaders) remainingHeaders + + let setHeaders headers (req: HttpWebRequest) = let mutable hasContentType = false checkForRepeatedHeaders [] headers - headers |> List.iter (fun (header:string, value) -> + + headers + |> List.iter (fun (header: string, value) -> match header.ToLowerInvariant() with | "accept" -> req.Accept <- value | "accept-charset" -> req.Headers.[HeaderEnum.AcceptCharset] <- value @@ -1473,13 +1697,23 @@ module internal HttpHelpers = | "content-type" -> req.ContentType <- value hasContentType <- true - | "date" -> req.Date <- DateTime.SpecifyKind(DateTime.ParseExact(value, "R", CultureInfo.InvariantCulture), DateTimeKind.Utc) + | "date" -> + req.Date <- + DateTime.SpecifyKind( + DateTime.ParseExact(value, "R", CultureInfo.InvariantCulture), + DateTimeKind.Utc + ) | "expect" -> req.Expect <- value | "expires" -> req.Headers.[HeaderEnum.Expires] <- value | "from" -> req.Headers.[HeaderEnum.From] <- value | "host" -> req.Host <- value | "if-match" -> req.Headers.[HeaderEnum.IfMatch] <- value - | "if-modified-since" -> req.IfModifiedSince <- DateTime.SpecifyKind(DateTime.ParseExact(value, "R", CultureInfo.InvariantCulture), DateTimeKind.Utc) + | "if-modified-since" -> + req.IfModifiedSince <- + DateTime.SpecifyKind( + DateTime.ParseExact(value, "R", CultureInfo.InvariantCulture), + DateTimeKind.Utc + ) | "if-none-match" -> req.Headers.[HeaderEnum.IfNoneMatch] <- value | "if-range" -> req.Headers.[HeaderEnum.IfRange] <- value | "if-unmodified-since" -> req.Headers.[HeaderEnum.IfUnmodifiedSince] <- value @@ -1489,9 +1723,14 @@ module internal HttpHelpers = | "origin" -> req.Headers.["Origin"] <- value | "pragma" -> req.Headers.[HeaderEnum.Pragma] <- value | "range" -> - if not (value.StartsWith("bytes=")) then failwith "Invalid value for the Range header" + if not (value.StartsWith("bytes=")) then + failwith "Invalid value for the Range header" + let bytes = value.Substring("bytes=".Length).Split('-') - if bytes.Length <> 2 then failwith "Invalid value for the Range header" + + if bytes.Length <> 2 then + failwith "Invalid value for the Range header" + req.AddRange(int64 bytes.[0], int64 bytes.[1]) | "proxy-authorization" -> req.Headers.[HeaderEnum.ProxyAuthorization] <- value | "referer" -> req.Referer <- value @@ -1502,161 +1741,216 @@ module internal HttpHelpers = | "user-agent" -> req.UserAgent <- value | "via" -> req.Headers.[HeaderEnum.Via] <- value | "warning" -> req.Headers.[HeaderEnum.Warning] <- value - | _ -> req.Headers.[header] <- value - ) + | _ -> req.Headers.[header] <- value) + hasContentType - let getResponse (req:HttpWebRequest) silentHttpErrors = + let getResponse (req: HttpWebRequest) silentHttpErrors = let getResponseFromBeginEnd = Async.FromBeginEnd(req.BeginGetResponse, req.EndGetResponse) - let getResponseAsync (req:HttpWebRequest) = - if req.Timeout = Timeout.Infinite - then getResponseFromBeginEnd - else - async { - let! child = Async.StartChild(getResponseFromBeginEnd, req.Timeout) - try - return! child - with - | :? TimeoutException as exc -> - req.Abort() - raise <| WebException("Timeout exceeded while getting response", exc, WebExceptionStatus.Timeout, null) - return Unchecked.defaultof<_> - } - - if defaultArg silentHttpErrors false - then + let getResponseAsync (req: HttpWebRequest) = + if req.Timeout = Timeout.Infinite then + getResponseFromBeginEnd + else async { + let! child = Async.StartChild(getResponseFromBeginEnd, req.Timeout) + try - return! getResponseAsync req - with - | :? WebException as exc -> - if exc.Response <> null then - return exc.Response - else - reraisePreserveStackTrace exc - return Unchecked.defaultof<_> + return! child + with :? TimeoutException as exc -> + req.Abort() + + raise + <| WebException( + "Timeout exceeded while getting response", + exc, + WebExceptionStatus.Timeout, + null + ) + + return Unchecked.defaultof<_> } - else getResponseAsync req - - let toHttpResponse forceText responseUrl statusCode contentType - characterSet responseEncodingOverride cookies headers stream = async { - - let isText (mimeType:string) = - let isText (mimeType:string) = - let mimeType = mimeType.Trim() - mimeType.StartsWith "text/" || - mimeType = HttpContentTypes.Json || - mimeType = HttpContentTypes.Xml || - mimeType = HttpContentTypes.JavaScript || - mimeType = HttpContentTypes.JsonRpc || - mimeType = "application/ecmascript" || - mimeType = "application/xml-dtd" || - mimeType.StartsWith "application/" && mimeType.EndsWith "+xml" || - mimeType.StartsWith "application/" && mimeType.EndsWith "+json" - mimeType.Split([| ';' |], StringSplitOptions.RemoveEmptyEntries) - |> Array.exists isText - - let! memoryStream = asyncRead stream - - let respBody = - if forceText || isText contentType then - let encoding = - match (defaultArg responseEncodingOverride ""), characterSet with - | "", "" -> HttpEncodings.ResponseDefaultEncoding - // some web servers respond with broken things like Content-Type: text/xml; charset="UTF-8" - // this goes against rfc2616, but it breaks Encoding.GetEncoding, so let us strip this char out - | "", characterSet -> Encoding.GetEncoding (characterSet.Replace("\"","")) - | responseEncodingOverride, _ -> HttpEncodings.getEncoding responseEncodingOverride - use sr = new StreamReader(memoryStream, encoding) - sr.ReadToEnd() |> Text - else - memoryStream.ToArray() |> Binary - return { Body = respBody - StatusCode = statusCode - ResponseUrl = responseUrl - Headers = headers - Cookies = cookies } - } + if defaultArg silentHttpErrors false then + async { + try + return! getResponseAsync req + with :? WebException as exc -> + if exc.Response <> null then + return exc.Response + else + reraisePreserveStackTrace exc + return Unchecked.defaultof<_> + } + else + getResponseAsync req + + let toHttpResponse + forceText + responseUrl + statusCode + contentType + characterSet + responseEncodingOverride + cookies + headers + stream + = + async { + + let isText (mimeType: string) = + let isText (mimeType: string) = + let mimeType = mimeType.Trim() + + mimeType.StartsWith "text/" + || mimeType = HttpContentTypes.Json + || mimeType = HttpContentTypes.Xml + || mimeType = HttpContentTypes.JavaScript + || mimeType = HttpContentTypes.JsonRpc + || mimeType = "application/ecmascript" + || mimeType = "application/xml-dtd" + || mimeType.StartsWith "application/" + && mimeType.EndsWith "+xml" + || mimeType.StartsWith "application/" + && mimeType.EndsWith "+json" + + mimeType.Split([| ';' |], StringSplitOptions.RemoveEmptyEntries) + |> Array.exists isText + + let! memoryStream = asyncRead stream + + let respBody = + if forceText || isText contentType then + let encoding = + match (defaultArg responseEncodingOverride ""), characterSet with + | "", "" -> HttpEncodings.ResponseDefaultEncoding + // some web servers respond with broken things like Content-Type: text/xml; charset="UTF-8" + // this goes against rfc2616, but it breaks Encoding.GetEncoding, so let us strip this char out + | "", characterSet -> Encoding.GetEncoding(characterSet.Replace("\"", "")) + | responseEncodingOverride, _ -> HttpEncodings.getEncoding responseEncodingOverride + + use sr = new StreamReader(memoryStream, encoding) + sr.ReadToEnd() |> Text + else + memoryStream.ToArray() |> Binary + + return + { Body = respBody + StatusCode = statusCode + ResponseUrl = responseUrl + Headers = headers + Cookies = cookies } + } module internal CookieHandling = // .NET has trouble parsing some cookies. See http://stackoverflow.com/a/22098131/165633 - let getAllCookiesFromHeader (header:string) (responseUri:Uri) = + let getAllCookiesFromHeader (header: string) (responseUri: Uri) = let cookiesWithWrongSplit = header.Replace("\r", "").Replace("\n", "").Split(',') - let isInvalidCookie (cookieStr:string) = + let isInvalidCookie (cookieStr: string) = let equalsPos = cookieStr.IndexOf '=' + equalsPos = -1 - || - let semicolonPos = cookieStr.IndexOf ';' - semicolonPos <> -1 && semicolonPos < equalsPos + || let semicolonPos = cookieStr.IndexOf ';' in + semicolonPos <> -1 && semicolonPos < equalsPos let cookies = ResizeArray() let mutable i = 0 + while i < cookiesWithWrongSplit.Length do // the next one is not a new cookie but part of the current one let mutable currentCookie = cookiesWithWrongSplit.[i] - while i < cookiesWithWrongSplit.Length - 1 && isInvalidCookie cookiesWithWrongSplit.[i + 1] do - currentCookie <- currentCookie + "," + cookiesWithWrongSplit.[i + 1] + + while i < cookiesWithWrongSplit.Length - 1 + && isInvalidCookie cookiesWithWrongSplit.[i + 1] do + currentCookie <- + currentCookie + + "," + + cookiesWithWrongSplit.[i + 1] + i <- i + 1 + cookies.Add(currentCookie) i <- i + 1 - let inline startsWithIgnoreCase prefix (str:string) = str.StartsWith(prefix, StringComparison.OrdinalIgnoreCase) - let inline equalsIgnoreCase other (str:string) = str.Equals(other, StringComparison.OrdinalIgnoreCase) + let inline startsWithIgnoreCase prefix (str: string) = + str.StartsWith(prefix, StringComparison.OrdinalIgnoreCase) + + let inline equalsIgnoreCase other (str: string) = + str.Equals(other, StringComparison.OrdinalIgnoreCase) + let stripPrefix prefix str = - if startsWithIgnoreCase prefix str - then str.Substring(prefix.Length) - else str - let createCookie (cookieParts:string[]) = + if startsWithIgnoreCase prefix str then + str.Substring(prefix.Length) + else + str + + let createCookie (cookieParts: string[]) = let cookie = Cookie() - cookieParts |> Array.iteri (fun i cookiePart -> + + cookieParts + |> Array.iteri (fun i cookiePart -> let cookiePart = cookiePart.Trim() + if i = 0 then let firstEqual = cookiePart.IndexOf '=' + if firstEqual > -1 then cookie.Name <- cookiePart.Substring(0, firstEqual) cookie.Value <- cookiePart.Substring(firstEqual + 1) else - cookie.Name <- cookiePart + cookie.Name <- cookiePart elif cookiePart |> startsWithIgnoreCase "path" then let kvp = cookiePart.Split '=' + if kvp.Length > 1 && kvp.[1] <> "" && kvp.[1] <> "/" then cookie.Path <- kvp.[1] elif cookiePart |> startsWithIgnoreCase "domain" then let kvp = cookiePart.Split '=' + if kvp.Length > 1 then - let domain = - kvp.[1] + let domain = + kvp.[1] // remove spurious domain prefixes |> stripPrefix "http://" |> stripPrefix "https://" - if domain <> "" then - cookie.Domain <- domain + + if domain <> "" then cookie.Domain <- domain elif cookiePart |> equalsIgnoreCase "secure" then cookie.Secure <- true elif cookiePart |> equalsIgnoreCase "httponly" then - cookie.HttpOnly <- true - ) + cookie.HttpOnly <- true) + cookie - [| for cookieStr in cookies do - let cookieParts = cookieStr.Split([|';'|],StringSplitOptions.RemoveEmptyEntries) - if cookieParts.Length > 0 then - let cookie = createCookie cookieParts - if cookie.Domain = "" then - cookie.Domain <- responseUri.Host - let uriString = (if cookie.Secure then "https://" else "http://") + cookie.Domain.TrimStart('.') + cookie.Path - match Uri.TryCreate(uriString, UriKind.Absolute) with - | true, uri -> yield uri, cookie - | _ -> () - |] - let getCookiesAndManageCookieContainer uri responseUri (headers:Map) (cookieContainer:CookieContainer) addCookiesToCookieContainer silentCookieErrors = + [| for cookieStr in cookies do + let cookieParts = cookieStr.Split([| ';' |], StringSplitOptions.RemoveEmptyEntries) + + if cookieParts.Length > 0 then + let cookie = createCookie cookieParts + if cookie.Domain = "" then cookie.Domain <- responseUri.Host + + let uriString = + (if cookie.Secure then "https://" else "http://") + + cookie.Domain.TrimStart('.') + + cookie.Path + + match Uri.TryCreate(uriString, UriKind.Absolute) with + | true, uri -> yield uri, cookie + | _ -> () |] + + let getCookiesAndManageCookieContainer + uri + responseUri + (headers: Map) + (cookieContainer: CookieContainer) + addCookiesToCookieContainer + silentCookieErrors + = let cookiesFromCookieContainer = cookieContainer.GetCookies uri |> Seq.cast @@ -1666,56 +1960,68 @@ module internal CookieHandling = match headers.TryFind HttpResponseHeaders.SetCookie with | Some cookieHeader -> getAllCookiesFromHeader cookieHeader responseUri - |> Array.fold (fun cookies (uri, cookie) -> - if addCookiesToCookieContainer then - if silentCookieErrors then - try cookieContainer.Add(uri, cookie) - with :? CookieException -> () - else - cookieContainer.Add(uri, cookie) - cookies |> Map.add cookie.Name cookie.Value) cookiesFromCookieContainer + |> Array.fold + (fun cookies (uri, cookie) -> + if addCookiesToCookieContainer then + if silentCookieErrors then + try + cookieContainer.Add(uri, cookie) + with :? CookieException -> + () + else + cookieContainer.Add(uri, cookie) + + cookies |> Map.add cookie.Name cookie.Value) + cookiesFromCookieContainer | None -> cookiesFromCookieContainer /// Utilities for working with network via HTTP. Includes methods for downloading /// resources with specified headers, query parameters and HTTP body [] -type Http private() = +type Http private () = static let charsetRegex = Regex("charset=([^;\s]*)", RegexOptions.Compiled) - + /// Correctly encodes large form data values. /// See https://blogs.msdn.microsoft.com/yangxind/2006/11/08/dont-use-net-system-uri-unescapedatastring-in-url-decoding/ /// and https://msdn.microsoft.com/en-us/library/system.uri.escapedatastring(v=vs.110).aspx - static member internal EncodeFormData (query:string) = - (WebUtility.UrlEncode query).Replace("+","%20") + static member internal EncodeFormData(query: string) = + (WebUtility.UrlEncode query).Replace("+", "%20") /// Appends the query parameters to the url, taking care of proper escaping - static member internal AppendQueryToUrl(url:string, query) = + static member internal AppendQueryToUrl(url: string, query) = match query with | [] -> url | query -> url + if url.Contains "?" then "&" else "?" - + String.concat "&" [ for k, v in query -> Uri.EscapeDataString k + "=" + Uri.EscapeDataString v ] + + String.concat + "&" + [ for k, v in query -> + Uri.EscapeDataString k + + "=" + + Uri.EscapeDataString v ] static member private InnerRequest - ( - url:string, - toHttpResponse, - [] ?query, - [] ?headers:seq<_>, - [] ?httpMethod, - [] ?body, - [] ?cookies:seq<_>, - [] ?cookieContainer, - [] ?silentHttpErrors, - [] ?silentCookieErrors, - [] ?responseEncodingOverride, - [] ?customizeHttpRequest, - [] ?timeout - ) = - - let uri = Http.AppendQueryToUrl(url, defaultArg query []) |> Uri + ( + url: string, + toHttpResponse, + [] ?query, + [] ?headers: seq<_>, + [] ?httpMethod, + [] ?body, + [] ?cookies: seq<_>, + [] ?cookieContainer, + [] ?silentHttpErrors, + [] ?silentCookieErrors, + [] ?responseEncodingOverride, + [] ?customizeHttpRequest, + [] ?timeout + ) = + + let uri = + Http.AppendQueryToUrl(url, defaultArg query []) + |> Uri let req = WebRequest.CreateHttp uri @@ -1727,7 +2033,9 @@ type Http private() = let headers = defaultArg (Option.map List.ofSeq headers) [] let hasContentType = setHeaders headers req - req.AutomaticDecompression <- DecompressionMethods.GZip ||| DecompressionMethods.Deflate + req.AutomaticDecompression <- + DecompressionMethods.GZip + ||| DecompressionMethods.Deflate // set cookies let addCookiesFromHeadersToCookieContainer, cookieContainer = @@ -1737,19 +2045,23 @@ type Http private() = match cookies with | None -> () - | Some cookies -> cookies |> List.ofSeq |> List.iter (fun (name, value) -> cookieContainer.Add(req.RequestUri, Cookie(name, value))) + | Some cookies -> + cookies + |> List.ofSeq + |> List.iter (fun (name, value) -> cookieContainer.Add(req.RequestUri, Cookie(name, value))) - req.CookieContainer <- cookieContainer + req.CookieContainer <- cookieContainer let getEncoding contentType = let charset = charsetRegex.Match(contentType) + if charset.Success then Encoding.GetEncoding charset.Groups.[1].Value else HttpEncodings.PostDefaultEncoding let body = - match body with + match body with | None -> None | Some body -> @@ -1758,10 +2070,14 @@ type Http private() = | 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 ] + 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 @@ -1772,47 +2088,67 @@ type Http private() = getEncoding req.ContentType - Some (bytes encoding) + Some(bytes encoding) match timeout with | Some timeout -> req.Timeout <- timeout | None -> () // Send the request and get the response - augmentWebExceptionsWithDetails (fun () -> async { - - let req = - match customizeHttpRequest with - | Some customizeHttpRequest -> customizeHttpRequest req - | None -> req - - match body with - | Some body -> do! writeBody req body - | None -> () - - let! resp = getResponse req silentHttpErrors - - let headers = - [ for header in resp.Headers.AllKeys do - yield header, resp.Headers.[header] ] - |> Map.ofList - - let cookies = CookieHandling.getCookiesAndManageCookieContainer uri resp.ResponseUri headers cookieContainer - addCookiesFromHeadersToCookieContainer (defaultArg silentCookieErrors false) - - let contentType = if resp.ContentType = null then "application/octet-stream" else resp.ContentType + augmentWebExceptionsWithDetails (fun () -> + async { + + let req = + match customizeHttpRequest with + | Some customizeHttpRequest -> customizeHttpRequest req + | None -> req + + match body with + | Some body -> do! writeBody req body + | None -> () + + let! resp = getResponse req silentHttpErrors + + let headers = + [ for header in resp.Headers.AllKeys do + yield header, resp.Headers.[header] ] + |> Map.ofList + + let cookies = + CookieHandling.getCookiesAndManageCookieContainer + uri + resp.ResponseUri + headers + cookieContainer + addCookiesFromHeadersToCookieContainer + (defaultArg silentCookieErrors false) + + let contentType = + if resp.ContentType = null then + "application/octet-stream" + else + resp.ContentType - let statusCode, characterSet = - match resp with - | :? HttpWebResponse as resp -> int resp.StatusCode, resp.CharacterSet - | _ -> 0, "" + let statusCode, characterSet = + match resp with + | :? HttpWebResponse as resp -> int resp.StatusCode, resp.CharacterSet + | _ -> 0, "" - let characterSet = if characterSet = null then "" else characterSet + let characterSet = if characterSet = null then "" else characterSet - let stream = resp.GetResponseStream() + let stream = resp.GetResponseStream() - return! toHttpResponse resp.ResponseUri.OriginalString statusCode contentType characterSet responseEncodingOverride cookies headers stream - }) + 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 @@ -1820,22 +2156,35 @@ type Http private() = /// The body for POST request can be specified either as text or as a list of parameters /// that will be encoded, and the method will automatically be set if not specified static member AsyncRequest - ( - url, - [] ?query, - [] ?headers, - [] ?httpMethod, - [] ?body, - [] ?cookies, - [] ?cookieContainer, - [] ?silentHttpErrors, - [] ?silentCookieErrors, - [] ?responseEncodingOverride, - [] ?customizeHttpRequest, - [] ?timeout - ) = - 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) + ( + url, + [] ?query, + [] ?headers, + [] ?httpMethod, + [] ?body, + [] ?cookies, + [] ?cookieContainer, + [] ?silentHttpErrors, + [] ?silentCookieErrors, + [] ?responseEncodingOverride, + [] ?customizeHttpRequest, + [] ?timeout + ) = + 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 /// (allows specifying query string parameters and HTTP headers including @@ -1843,23 +2192,38 @@ type Http private() = /// The body for POST request can be specified either as text or as a list of parameters /// that will be encoded, and the method will automatically be set if not specified static member AsyncRequestString - ( - url, - [] ?query, - [] ?headers, - [] ?httpMethod, - [] ?body, - [] ?cookies, - [] ?cookieContainer, - [] ?silentHttpErrors, - [] ?silentCookieErrors, - [] ?responseEncodingOverride, - [] ?customizeHttpRequest, - [] ?timeout - ) = + ( + url, + [] ?query, + [] ?headers, + [] ?httpMethod, + [] ?body, + [] ?cookies, + [] ?cookieContainer, + [] ?silentHttpErrors, + [] ?silentCookieErrors, + [] ?responseEncodingOverride, + [] ?customizeHttpRequest, + [] ?timeout + ) = async { - 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) + 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 | Text text -> text @@ -1872,28 +2236,52 @@ type Http private() = /// The body for POST request can be specified either as text or as a list of parameters /// that will be encoded, and the method will automatically be set if not specified static member AsyncRequestStream - ( - url, - [] ?query, - [] ?headers, - [] ?httpMethod, - [] ?body, - [] ?cookies, - [] ?cookieContainer, - [] ?silentHttpErrors, - [] ?silentCookieErrors, - [] ?customizeHttpRequest, - [] ?timeout - ) = - let toHttpResponse responseUrl statusCode _contentType _characterSet _responseEncodingOverride cookies headers stream = async { - return { ResponseStream = stream - StatusCode = statusCode - ResponseUrl = responseUrl - Headers = headers - Cookies = cookies } - } - Http.InnerRequest(url, toHttpResponse, ?query=query, ?headers=headers, ?httpMethod=httpMethod, ?body=body, ?cookies=cookies, ?cookieContainer=cookieContainer, ?silentCookieErrors=silentCookieErrors, - ?silentHttpErrors=silentHttpErrors, ?customizeHttpRequest=customizeHttpRequest, ?timeout = timeout) + ( + url, + [] ?query, + [] ?headers, + [] ?httpMethod, + [] ?body, + [] ?cookies, + [] ?cookieContainer, + [] ?silentHttpErrors, + [] ?silentCookieErrors, + [] ?customizeHttpRequest, + [] ?timeout + ) = + let toHttpResponse + responseUrl + statusCode + _contentType + _characterSet + _responseEncodingOverride + cookies + headers + stream + = + async { + return + { ResponseStream = stream + StatusCode = statusCode + ResponseUrl = responseUrl + Headers = headers + Cookies = cookies } + } + + Http.InnerRequest( + url, + toHttpResponse, + ?query = query, + ?headers = headers, + ?httpMethod = httpMethod, + ?body = body, + ?cookies = cookies, + ?cookieContainer = cookieContainer, + ?silentCookieErrors = silentCookieErrors, + ?silentHttpErrors = silentHttpErrors, + ?customizeHttpRequest = customizeHttpRequest, + ?timeout = timeout + ) /// Download an HTTP web resource from the specified URL synchronously /// (allows specifying query string parameters and HTTP headers including @@ -1901,22 +2289,34 @@ type Http private() = /// The body for POST request can be specified either as text or as a list of parameters /// that will be encoded, and the method will automatically be set if not specified static member Request - ( - url, - [] ?query, - [] ?headers, - [] ?httpMethod, - [] ?body, - [] ?cookies, - [] ?cookieContainer, - [] ?silentHttpErrors, - [] ?silentCookieErrors, - [] ?responseEncodingOverride, - [] ?customizeHttpRequest, - [] ?timeout - ) = - Http.AsyncRequest(url, ?query=query, ?headers=headers, ?httpMethod=httpMethod, ?body=body, ?cookies=cookies, ?cookieContainer=cookieContainer,?silentCookieErrors=silentCookieErrors, - ?silentHttpErrors=silentHttpErrors, ?responseEncodingOverride=responseEncodingOverride, ?customizeHttpRequest=customizeHttpRequest, ?timeout=timeout) + ( + url, + [] ?query, + [] ?headers, + [] ?httpMethod, + [] ?body, + [] ?cookies, + [] ?cookieContainer, + [] ?silentHttpErrors, + [] ?silentCookieErrors, + [] ?responseEncodingOverride, + [] ?customizeHttpRequest, + [] ?timeout + ) = + Http.AsyncRequest( + url, + ?query = query, + ?headers = headers, + ?httpMethod = httpMethod, + ?body = body, + ?cookies = cookies, + ?cookieContainer = cookieContainer, + ?silentCookieErrors = silentCookieErrors, + ?silentHttpErrors = silentHttpErrors, + ?responseEncodingOverride = responseEncodingOverride, + ?customizeHttpRequest = customizeHttpRequest, + ?timeout = timeout + ) |> Async.RunSynchronously /// Download an HTTP web resource from the specified URL synchronously @@ -1925,22 +2325,34 @@ type Http private() = /// The body for POST request can be specified either as text or as a list of parameters /// that will be encoded, and the method will automatically be set if not specified static member RequestString - ( - url, - [] ?query, - [] ?headers, - [] ?httpMethod, - [] ?body, - [] ?cookies, - [] ?cookieContainer, - [] ?silentHttpErrors, - [] ?silentCookieErrors, - [] ?responseEncodingOverride, - [] ?customizeHttpRequest, - [] ?timeout - ) = - Http.AsyncRequestString(url, ?query=query, ?headers=headers, ?httpMethod=httpMethod, ?body=body, ?cookies=cookies, ?cookieContainer=cookieContainer, ?silentCookieErrors=silentCookieErrors, - ?silentHttpErrors=silentHttpErrors, ?responseEncodingOverride=responseEncodingOverride, ?customizeHttpRequest=customizeHttpRequest, ?timeout=timeout) + ( + url, + [] ?query, + [] ?headers, + [] ?httpMethod, + [] ?body, + [] ?cookies, + [] ?cookieContainer, + [] ?silentHttpErrors, + [] ?silentCookieErrors, + [] ?responseEncodingOverride, + [] ?customizeHttpRequest, + [] ?timeout + ) = + Http.AsyncRequestString( + url, + ?query = query, + ?headers = headers, + ?httpMethod = httpMethod, + ?body = body, + ?cookies = cookies, + ?cookieContainer = cookieContainer, + ?silentCookieErrors = silentCookieErrors, + ?silentHttpErrors = silentHttpErrors, + ?responseEncodingOverride = responseEncodingOverride, + ?customizeHttpRequest = customizeHttpRequest, + ?timeout = timeout + ) |> Async.RunSynchronously /// Download an HTTP web resource from the specified URL synchronously @@ -1949,19 +2361,30 @@ type Http private() = /// The body for POST request can be specified either as text or as a list of parameters /// that will be encoded, and the method will automatically be set if not specified static member RequestStream - ( - url, - [] ?query, - [] ?headers, - [] ?httpMethod, - [] ?body, - [] ?cookies, - [] ?cookieContainer, - [] ?silentHttpErrors, - [] ?silentCookieErrors, - [] ?customizeHttpRequest, - [] ?timeout - ) = - Http.AsyncRequestStream(url, ?query=query, ?headers=headers, ?httpMethod=httpMethod, ?body=body, ?cookies=cookies, ?cookieContainer=cookieContainer, ?silentCookieErrors=silentCookieErrors, - ?silentHttpErrors=silentHttpErrors, ?customizeHttpRequest=customizeHttpRequest, ?timeout=timeout) + ( + url, + [] ?query, + [] ?headers, + [] ?httpMethod, + [] ?body, + [] ?cookies, + [] ?cookieContainer, + [] ?silentHttpErrors, + [] ?silentCookieErrors, + [] ?customizeHttpRequest, + [] ?timeout + ) = + Http.AsyncRequestStream( + url, + ?query = query, + ?headers = headers, + ?httpMethod = httpMethod, + ?body = body, + ?cookies = cookies, + ?cookieContainer = cookieContainer, + ?silentCookieErrors = silentCookieErrors, + ?silentHttpErrors = silentHttpErrors, + ?customizeHttpRequest = customizeHttpRequest, + ?timeout = timeout + ) |> Async.RunSynchronously diff --git a/src/Runtime.fs b/src/Runtime.fs index d611f9607..739899daa 100644 --- a/src/Runtime.fs +++ b/src/Runtime.fs @@ -3,6 +3,6 @@ open System.Runtime.CompilerServices open FSharp.Core.CompilerServices -[] -[] -do() +[] +[] +do () diff --git a/src/WorldBank/WorldBankProvider.fs b/src/WorldBank/WorldBankProvider.fs index 96fbbe143..7e38500f6 100644 --- a/src/WorldBank/WorldBankProvider.fs +++ b/src/WorldBank/WorldBankProvider.fs @@ -1,5 +1,5 @@ // -------------------------------------------------------------------------------------- -// The World Bank type provider +// The World Bank type provider // -------------------------------------------------------------------------------------- namespace ProviderImplementation @@ -17,188 +17,368 @@ open FSharp.Data.Runtime.WorldBank // -------------------------------------------------------------------------------------- [] -type public WorldBankProvider(cfg:TypeProviderConfig) as this = - inherit DisposableTypeProviderForNamespaces(cfg, assemblyReplacementMap=[ "FSharp.Data.DesignTime", "FSharp.Data" ]) +type public WorldBankProvider(cfg: TypeProviderConfig) as this = + inherit DisposableTypeProviderForNamespaces + ( + cfg, + assemblyReplacementMap = [ "FSharp.Data.DesignTime", "FSharp.Data" ] + ) do AssemblyResolver.init () let asm = System.Reflection.Assembly.GetExecutingAssembly() - let ns = "FSharp.Data" + let ns = "FSharp.Data" let defaultServiceUrl = "http://api.worldbank.org/v2" let cacheDuration = TimeSpan.FromDays 30.0 let restCache = createInternetFileCache "WorldBankSchema" cacheDuration - let createTypesForSources(sources, worldBankTypeName, asynchronous, addAttributes) = - - ProviderHelpers.getOrCreateProvidedType cfg this worldBankTypeName (fun () -> - - let connection = ServiceConnection(restCache, defaultServiceUrl, sources) - - let resTy = ProvidedTypeDefinition(asm, ns, worldBankTypeName, None, hideObjectMethods = addAttributes, nonNullable = addAttributes ) - - let serviceTypesType = - let t = ProvidedTypeDefinition("ServiceTypes", None, hideObjectMethods = true, nonNullable = true) - t.AddXmlDoc("Contains the types that describe the data service") - resTy.AddMember t - t - - let indicatorsType = - let t = ProvidedTypeDefinition("Indicators", Some typeof, hideObjectMethods = true, nonNullable = true) - t.AddMembersDelayed (fun () -> - [ for indicator in connection.Indicators do - let indicatorIdVal = indicator.Id - let prop = - if asynchronous then - ProvidedProperty - ( indicator.Name, typeof> , - getterCode = (fun (Singleton arg) -> <@@ ((%%arg : Indicators) :> IIndicators).AsyncGetIndicator(indicatorIdVal) @@>)) - else - ProvidedProperty - ( indicator.Name, typeof, - getterCode = (fun (Singleton arg) -> <@@ ((%%arg : Indicators) :> IIndicators).GetIndicator(indicatorIdVal) @@>)) - - if not (String.IsNullOrEmpty indicator.Description) then prop.AddXmlDoc(indicator.Description) - yield prop ] ) - serviceTypesType.AddMember t - t - - let indicatorsDescriptionsType = - let t = ProvidedTypeDefinition("IndicatorsDescriptions", Some typeof , hideObjectMethods = true, nonNullable = true) - t.AddMembersDelayed (fun () -> - [ for indicator in connection.Indicators do - let indicatorIdVal = indicator.Id - let prop = - ProvidedProperty - ( indicator.Name, - typeof , - getterCode = (fun (Singleton arg) -> <@@ ((%%arg : IndicatorsDescriptions) :> IIndicatorsDescriptions).GetIndicator(indicatorIdVal) @@>)) - if not (String.IsNullOrEmpty indicator.Description) then prop.AddXmlDoc(indicator.Description) - yield prop ] ) - serviceTypesType.AddMember t - t - - let countryType = - let t = ProvidedTypeDefinition("Country", Some typeof, hideObjectMethods = true, nonNullable = true) - t.AddMembersDelayed (fun () -> - [ let prop = ProvidedProperty("Indicators", indicatorsType, - getterCode = (fun (Singleton arg) -> <@@ ((%%arg : Country) :> ICountry).GetIndicators() @@>)) - prop.AddXmlDoc("The indicators for the country") - yield prop ] ) - serviceTypesType.AddMember t - t - - let countriesType = - let countryCollectionType = ProvidedTypeBuilder.MakeGenericType(typedefof>, [ countryType ]) - let t = ProvidedTypeDefinition("Countries", Some countryCollectionType, hideObjectMethods = true, nonNullable = true) - t.AddMembersDelayed (fun () -> - [ for country in connection.Countries do - let countryIdVal = country.Id - let name = country.Name - let prop = - ProvidedProperty - ( name, countryType, - getterCode = (fun (Singleton arg) -> <@@ ((%%arg : CountryCollection) :> ICountryCollection).GetCountry(countryIdVal, name) @@>)) - prop.AddXmlDoc (sprintf "The data for country '%s'" country.Name) - yield prop ]) - serviceTypesType.AddMember t - t - - let regionType = - let t = ProvidedTypeDefinition("Region", Some typeof, hideObjectMethods = true, nonNullable = true) - t.AddMembersDelayed (fun () -> - [ let prop = ProvidedProperty("Indicators", indicatorsType, - getterCode = (fun (Singleton arg) -> <@@ ((%%arg : Region) :> IRegion).GetIndicators() @@>)) - prop.AddXmlDoc("The indicators for the region") - yield prop - let prop = ProvidedProperty("Countries", countriesType, - getterCode = (fun (Singleton arg) -> <@@ ((%%arg : Region) :> IRegion).GetCountries() @@>)) - prop.AddXmlDoc("The indicators for the region") - yield prop ] ) - serviceTypesType.AddMember t - t - - let regionsType = - let regionCollectionType = ProvidedTypeBuilder.MakeGenericType(typedefof>, [ regionType ]) - let t = ProvidedTypeDefinition("Regions", Some regionCollectionType, hideObjectMethods = true, nonNullable = true) - t.AddMembersDelayed (fun () -> - [ for code, name in connection.Regions do - let prop = - ProvidedProperty - ( name, regionType, - getterCode = (fun (Singleton arg) -> <@@ ((%%arg : RegionCollection) :> IRegionCollection).GetRegion(code) @@>)) - prop.AddXmlDoc (sprintf "The data for region '%s'" name) - yield prop ]) - serviceTypesType.AddMember t - t - - let topicType = - let t = ProvidedTypeDefinition("Topic", Some typeof, hideObjectMethods = true, nonNullable = true) - t.AddMembersDelayed (fun () -> - [ let prop = ProvidedProperty("Indicators", indicatorsDescriptionsType, - getterCode = (fun (Singleton arg) -> <@@ ((%%arg : Topic) :> ITopic).GetIndicators() @@>)) - prop.AddXmlDoc("The indicators for the topic") - yield prop ] ) - serviceTypesType.AddMember t - t - - let topicsType = - let topicCollectionType = ProvidedTypeBuilder.MakeGenericType(typedefof>, [ topicType ]) - let t = ProvidedTypeDefinition("Topics", Some topicCollectionType, hideObjectMethods = true, nonNullable = true) - t.AddMembersDelayed (fun () -> - [ for topic in connection.Topics do - let topicIdVal = topic.Id - let prop = - ProvidedProperty - ( topic.Name, topicType, - getterCode = (fun (Singleton arg) -> <@@ ((%%arg : TopicCollection) :> ITopicCollection).GetTopic(topicIdVal) @@>)) - if not (String.IsNullOrEmpty topic.Description) then prop.AddXmlDoc(topic.Description) - prop ]) - serviceTypesType.AddMember t - t - - let worldBankDataServiceType = - let t = ProvidedTypeDefinition("WorldBankDataService", Some typeof, hideObjectMethods = true, nonNullable = true) - t.AddMembersDelayed (fun () -> - [ 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 ";" - let gdcCode _ = <@@ WorldBankData(urlVal, sourcesVal) @@> - ProvidedMethod ("GetDataContext", [], worldBankDataServiceType, isStatic=true, invokeCode = gdcCode) - ]) - - resTy - ) + let createTypesForSources (sources, worldBankTypeName, asynchronous, addAttributes) = + + ProviderHelpers.getOrCreateProvidedType cfg this worldBankTypeName (fun () -> + + let connection = ServiceConnection(restCache, defaultServiceUrl, sources) + + let resTy = + ProvidedTypeDefinition( + asm, + ns, + worldBankTypeName, + None, + hideObjectMethods = addAttributes, + nonNullable = addAttributes + ) + + let serviceTypesType = + let t = + ProvidedTypeDefinition("ServiceTypes", None, hideObjectMethods = true, nonNullable = true) + + t.AddXmlDoc("Contains the types that describe the data service") + resTy.AddMember t + t + + let indicatorsType = + let t = + ProvidedTypeDefinition( + "Indicators", + Some typeof, + hideObjectMethods = true, + nonNullable = true + ) + + t.AddMembersDelayed(fun () -> + [ for indicator in connection.Indicators do + let indicatorIdVal = indicator.Id + + let prop = + if asynchronous then + ProvidedProperty( + indicator.Name, + typeof>, + getterCode = + (fun (Singleton arg) -> + <@@ ((%%arg: Indicators) :> IIndicators).AsyncGetIndicator(indicatorIdVal) @@>) + ) + else + ProvidedProperty( + indicator.Name, + typeof, + getterCode = + (fun (Singleton arg) -> + <@@ ((%%arg: Indicators) :> IIndicators).GetIndicator(indicatorIdVal) @@>) + ) + + if not (String.IsNullOrEmpty indicator.Description) then + prop.AddXmlDoc(indicator.Description) + + yield prop ]) + + serviceTypesType.AddMember t + t + + let indicatorsDescriptionsType = + let t = + ProvidedTypeDefinition( + "IndicatorsDescriptions", + Some typeof, + hideObjectMethods = true, + nonNullable = true + ) + + t.AddMembersDelayed(fun () -> + [ for indicator in connection.Indicators do + let indicatorIdVal = indicator.Id + + let prop = + ProvidedProperty( + indicator.Name, + typeof, + getterCode = + (fun (Singleton arg) -> + <@@ + ((%%arg: IndicatorsDescriptions) :> IIndicatorsDescriptions) + .GetIndicator(indicatorIdVal) + @@>) + ) + + if not (String.IsNullOrEmpty indicator.Description) then + prop.AddXmlDoc(indicator.Description) + + yield prop ]) + + serviceTypesType.AddMember t + t + + let countryType = + let t = + ProvidedTypeDefinition( + "Country", + Some typeof, + hideObjectMethods = true, + nonNullable = true + ) + + t.AddMembersDelayed(fun () -> + [ let prop = + ProvidedProperty( + "Indicators", + indicatorsType, + getterCode = + (fun (Singleton arg) -> <@@ ((%%arg: Country) :> ICountry).GetIndicators() @@>) + ) + + prop.AddXmlDoc("The indicators for the country") + yield prop ]) + + serviceTypesType.AddMember t + t + + let countriesType = + let countryCollectionType = + ProvidedTypeBuilder.MakeGenericType(typedefof>, [ countryType ]) + + let t = + ProvidedTypeDefinition( + "Countries", + Some countryCollectionType, + hideObjectMethods = true, + nonNullable = true + ) + + t.AddMembersDelayed(fun () -> + [ for country in connection.Countries do + let countryIdVal = country.Id + let name = country.Name + + let prop = + ProvidedProperty( + name, + countryType, + getterCode = + (fun (Singleton arg) -> + <@@ + ((%%arg: CountryCollection) :> ICountryCollection) + .GetCountry(countryIdVal, name) + @@>) + ) + + prop.AddXmlDoc(sprintf "The data for country '%s'" country.Name) + yield prop ]) + + serviceTypesType.AddMember t + t + + let regionType = + let t = + ProvidedTypeDefinition("Region", Some typeof, hideObjectMethods = true, nonNullable = true) + + t.AddMembersDelayed(fun () -> + [ let prop = + ProvidedProperty( + "Indicators", + indicatorsType, + getterCode = (fun (Singleton arg) -> <@@ ((%%arg: Region) :> IRegion).GetIndicators() @@>) + ) + + prop.AddXmlDoc("The indicators for the region") + yield prop + + let prop = + ProvidedProperty( + "Countries", + countriesType, + getterCode = (fun (Singleton arg) -> <@@ ((%%arg: Region) :> IRegion).GetCountries() @@>) + ) + + prop.AddXmlDoc("The indicators for the region") + yield prop ]) + + serviceTypesType.AddMember t + t + + let regionsType = + let regionCollectionType = + ProvidedTypeBuilder.MakeGenericType(typedefof>, [ regionType ]) + + let t = + ProvidedTypeDefinition( + "Regions", + Some regionCollectionType, + hideObjectMethods = true, + nonNullable = true + ) + + t.AddMembersDelayed(fun () -> + [ for code, name in connection.Regions do + let prop = + ProvidedProperty( + name, + regionType, + getterCode = + (fun (Singleton arg) -> + <@@ ((%%arg: RegionCollection) :> IRegionCollection).GetRegion(code) @@>) + ) + + prop.AddXmlDoc(sprintf "The data for region '%s'" name) + yield prop ]) + + serviceTypesType.AddMember t + t + + let topicType = + let t = + ProvidedTypeDefinition("Topic", Some typeof, hideObjectMethods = true, nonNullable = true) + + t.AddMembersDelayed(fun () -> + [ let prop = + ProvidedProperty( + "Indicators", + indicatorsDescriptionsType, + getterCode = (fun (Singleton arg) -> <@@ ((%%arg: Topic) :> ITopic).GetIndicators() @@>) + ) + + prop.AddXmlDoc("The indicators for the topic") + yield prop ]) + + serviceTypesType.AddMember t + t + + let topicsType = + let topicCollectionType = + ProvidedTypeBuilder.MakeGenericType(typedefof>, [ topicType ]) + + let t = + ProvidedTypeDefinition( + "Topics", + Some topicCollectionType, + hideObjectMethods = true, + nonNullable = true + ) + + t.AddMembersDelayed(fun () -> + [ for topic in connection.Topics do + let topicIdVal = topic.Id + + let prop = + ProvidedProperty( + topic.Name, + topicType, + getterCode = + (fun (Singleton arg) -> + <@@ ((%%arg: TopicCollection) :> ITopicCollection).GetTopic(topicIdVal) @@>) + ) + + if not (String.IsNullOrEmpty topic.Description) then + prop.AddXmlDoc(topic.Description) + + prop ]) + + serviceTypesType.AddMember t + t + + let worldBankDataServiceType = + let t = + ProvidedTypeDefinition( + "WorldBankDataService", + Some typeof, + hideObjectMethods = true, + nonNullable = true + ) + + t.AddMembersDelayed(fun () -> + [ 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 ";" + + 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" ] + let defaultSources = + [ "World Development Indicators" + "Global Financial Development" ] - let worldBankType = createTypesForSources(defaultSources, "WorldBankData", false, false) + let worldBankType = + createTypesForSources (defaultSources, "WorldBankData", false, false) //do worldBankType.AddXmlDoc "Typed representation of WorldBank data. See http://www.worldbank.org for terms and conditions." - let paramWorldBankType = - let t = ProvidedTypeDefinition(asm, ns, "WorldBankDataProvider", None, hideObjectMethods = true, nonNullable = true) - + let paramWorldBankType = + let t = + ProvidedTypeDefinition(asm, ns, "WorldBankDataProvider", None, hideObjectMethods = true, nonNullable = true) + let defaultSourcesStr = String.Join(";", defaultSources) - let helpText = "Typed representation of WorldBank data with additional configuration parameters. See http://www.worldbank.org for terms and conditions. - The World Bank data sources to include, separated by semicolons. Defaults to " + defaultSourcesStr + ". + + let helpText = + "Typed representation of WorldBank data with additional configuration parameters. See http://www.worldbank.org for terms and conditions. + The World Bank data sources to include, separated by semicolons. Defaults to " + + defaultSourcesStr + + ". If an empty string is specified, includes all data sources. Generate asynchronous calls. Defaults to false." + t.AddXmlDoc(helpText) let parameters = [ ProvidedStaticParameter("Sources", typeof, defaultSourcesStr) ProvidedStaticParameter("Asynchronous", typeof, false) ] - t.DefineStaticParameters(parameters, fun typeName providerArgs -> - let sources = (providerArgs.[0] :?> string).Split([| ';' |], StringSplitOptions.RemoveEmptyEntries) |> Array.toList - let isAsync = providerArgs.[1] :?> bool - createTypesForSources(sources, typeName, isAsync, true)) + t.DefineStaticParameters( + parameters, + fun typeName providerArgs -> + let sources = + (providerArgs.[0] :?> string) + .Split([| ';' |], StringSplitOptions.RemoveEmptyEntries) + |> Array.toList + + let isAsync = providerArgs.[1] :?> bool + createTypesForSources (sources, typeName, isAsync, true) + ) + t - + do this.AddNamespace(ns, [ worldBankType; paramWorldBankType ]) diff --git a/src/WorldBank/WorldBankRuntime.fs b/src/WorldBank/WorldBankRuntime.fs index 41630b1fb..f850a00c8 100644 --- a/src/WorldBank/WorldBankRuntime.fs +++ b/src/WorldBank/WorldBankRuntime.fs @@ -1,5 +1,5 @@ // -------------------------------------------------------------------------------------- -// WorldBank type provider - runtime components +// WorldBank type provider - runtime components // -------------------------------------------------------------------------------------- namespace FSharp.Data.Runtime.WorldBank @@ -15,156 +15,234 @@ open FSharp.Data.Runtime.Caching /// [] -module Implementation = +module Implementation = let private retryCount = 5 let private parallelIndicatorPageDownloads = 8 - type internal IndicatorRecord = - { Id : string + type internal IndicatorRecord = + { Id: string Name: string - TopicIds : string list - Source : string - Description : string } - - type internal CountryRecord = - { Id : string - Name : string - CapitalCity : string - Region : string } + TopicIds: string list + Source: string + Description: string } + + type internal CountryRecord = + { Id: string + Name: string + CapitalCity: string + Region: string } member x.IsRegion = x.Region = "Aggregates" - type internal TopicRecord = - { Id : string - Name : string - Description : string } + type internal TopicRecord = + { Id: string + Name: string + Description: string } - type internal ServiceConnection(restCache:ICache<_,_>,serviceUrl:string, sources) = + type internal ServiceConnection(restCache: ICache<_, _>, serviceUrl: string, sources) = - let worldBankUrl (functions: string list) (props: (string * string) list) = - let url = - serviceUrl::(List.map Uri.EscapeUriString functions) + let worldBankUrl (functions: string list) (props: (string * string) list) = + let url = + serviceUrl + :: (List.map Uri.EscapeUriString functions) |> String.concat "/" - let query = [ "per_page", "1000" - "format", "json" ] @ props + + let query = [ "per_page", "1000"; "format", "json" ] @ props Http.AppendQueryToUrl(url, query) // The WorldBank data changes very slowly indeed (monthly updates to values, rare updates to schema), hence caching it is ok. - let rec worldBankRequest attempt funcs args : Async = - async { + let rec worldBankRequest attempt funcs args : Async = + async { let url = worldBankUrl funcs args + match restCache.TryRetrieve(url) with | Some res -> return res - | None -> - Debug.WriteLine (sprintf "[WorldBank] downloading (%d): %s" attempt url) + | None -> + Debug.WriteLine(sprintf "[WorldBank] downloading (%d): %s" attempt url) + try - let! doc = Http.AsyncRequestString(url, headers = [ HttpRequestHeaders.UserAgent "FSharp.Data WorldBank Type Provider" - HttpRequestHeaders.Accept HttpContentTypes.Json ]) - Debug.WriteLine (sprintf "[WorldBank] got text: %s" (if doc = null then "null" elif doc.Length > 50 then doc.[0..49] + "..." else doc)) - if not (String.IsNullOrEmpty doc) then + let! doc = + Http.AsyncRequestString( + url, + headers = + [ HttpRequestHeaders.UserAgent "FSharp.Data WorldBank Type Provider" + HttpRequestHeaders.Accept HttpContentTypes.Json ] + ) + + Debug.WriteLine( + sprintf + "[WorldBank] got text: %s" + (if doc = null then "null" + elif doc.Length > 50 then doc.[0..49] + "..." + else doc) + ) + + if not (String.IsNullOrEmpty doc) then restCache.Set(url, doc) - return doc + + return doc with e -> - Debug.WriteLine (sprintf "[WorldBank] error: %s" (e.ToString())) + Debug.WriteLine(sprintf "[WorldBank] error: %s" (e.ToString())) + if attempt > 0 then return! worldBankRequest (attempt - 1) funcs args - else return! failwithf "Failed to request '%s'. Error: %O" url e } - - let rec getDocuments funcs args page parallelPages = - async { let! docs = - Async.Parallel - [ for i in 0 .. parallelPages - 1 -> - worldBankRequest retryCount funcs (args @ ["page", string (page+i)]) ] - let docs = docs |> Array.map JsonValue.Parse - Debug.WriteLine (sprintf "[WorldBank] geting page count") - let pages = docs.[0].[0]?pages.AsInteger() - Debug.WriteLine (sprintf "[WorldBank] got page count = %d" pages) - if (pages < page + parallelPages) then - return Array.toList docs - else - let! rest = getDocuments funcs args (page + parallelPages) (pages - parallelPages) - return Array.toList docs @ rest } - - let getIndicators() = + else + return! failwithf "Failed to request '%s'. Error: %O" url e + } + + let rec getDocuments funcs args page parallelPages = + async { + let! docs = + Async.Parallel + [ for i in 0 .. parallelPages - 1 -> + worldBankRequest retryCount funcs (args @ [ "page", string (page + i) ]) ] + + let docs = docs |> Array.map JsonValue.Parse + Debug.WriteLine(sprintf "[WorldBank] geting page count") + let pages = docs.[0].[0]?pages.AsInteger() + Debug.WriteLine(sprintf "[WorldBank] got page count = %d" pages) + + if (pages < page + parallelPages) then + return Array.toList docs + else + let! rest = getDocuments funcs args (page + parallelPages) (pages - parallelPages) + return Array.toList docs @ rest + } + + let getIndicators () = // Get the indicators in parallel, initially using 'parallelIndicatorPageDownloads' pages - async { let! docs = getDocuments ["indicator"] [] 1 parallelIndicatorPageDownloads - return - [ for doc in docs do - for ind in doc.[1] do - let id = ind?id.AsString() - let name = ind?name.AsString().Trim([|'"'|]).Trim() - let sourceName = ind?source?value.AsString() - if sources = [] || sources |> List.exists (fun source -> String.Compare(source, sourceName, StringComparison.OrdinalIgnoreCase) = 0) then - let topicIds = Seq.toList <| seq { - for item in ind?topics do - match item.TryGetProperty("id") with - | Some id -> yield id.AsString() - | None -> () - } - let sourceNote = ind?sourceNote.AsString() - yield { Id = id - Name = name - TopicIds = topicIds - Source = sourceName - Description = sourceNote} ] } - - let getTopics() = - async { let! docs = getDocuments ["topic"] [] 1 1 - return - [ for doc in docs do - for topic in doc.[1] do - let id = topic?id.AsString() - let name = topic?value.AsString() - let sourceNote = topic?sourceNote.AsString() - yield { Id = id - Name = name - Description = sourceNote } ] } - - let getCountries(args) = - async { let! docs = getDocuments ["country"] args 1 1 - return - [ for doc in docs do - for country in doc.[1] do - let region = country?region?value.AsString() - let id = country?id.AsString() - let name = country?name.AsString() - let capitalCity = country?capitalCity.AsString() - yield { Id = id + async { + let! docs = getDocuments [ "indicator" ] [] 1 parallelIndicatorPageDownloads + + return + [ for doc in docs do + for ind in doc.[1] do + let id = ind?id.AsString() + let name = ind?name.AsString().Trim([| '"' |]).Trim() + let sourceName = ind?source?value.AsString() + + if sources = [] + || sources + |> List.exists (fun source -> + String.Compare(source, sourceName, StringComparison.OrdinalIgnoreCase) = 0) then + let topicIds = + Seq.toList + <| seq { + for item in ind?topics do + match item.TryGetProperty("id") with + | Some id -> yield id.AsString() + | None -> () + } + + let sourceNote = ind?sourceNote.AsString() + + yield + { Id = id Name = name - CapitalCity = capitalCity - Region = region } ] } - - let getRegions() = - async { let! docs = getDocuments ["region"] [] 1 1 - return - [ for doc in docs do - for ind in doc.[1] do - yield ind?code.AsString(), - ind?name.AsString() ] } - - let getData funcs args (key:string) = - async { let! docs = getDocuments funcs args 1 1 - return - [ for doc in docs do - for ind in doc.[1] do - yield ind.[key].AsString(), - ind?value.AsString() ] } + TopicIds = topicIds + Source = sourceName + Description = sourceNote } ] + } + + let getTopics () = + async { + let! docs = getDocuments [ "topic" ] [] 1 1 + + return + [ for doc in docs do + for topic in doc.[1] do + let id = topic?id.AsString() + let name = topic?value.AsString() + let sourceNote = topic?sourceNote.AsString() + + yield + { Id = id + Name = name + Description = sourceNote } ] + } + + let getCountries (args) = + async { + let! docs = getDocuments [ "country" ] args 1 1 + + return + [ for doc in docs do + for country in doc.[1] do + let region = country?region?value.AsString() + let id = country?id.AsString() + let name = country?name.AsString() + let capitalCity = country?capitalCity.AsString() + + yield + { Id = id + Name = name + CapitalCity = capitalCity + Region = region } ] + } + + let getRegions () = + async { + let! docs = getDocuments [ "region" ] [] 1 1 + + return + [ for doc in docs do + for ind in doc.[1] do + yield ind?code.AsString(), ind?name.AsString() ] + } + + let getData funcs args (key: string) = + async { + let! docs = getDocuments funcs args 1 1 + + return + [ for doc in docs do + for ind in doc.[1] do + yield ind.[key].AsString(), ind?value.AsString() ] + } /// At compile time, download the schema - let topics = lazy (getTopics() |> Async.RunSynchronously) - let topicsIndexed = lazy (topics.Force() |> Seq.map (fun t -> t.Id, t) |> dict) - let indicators = lazy (getIndicators() |> Async.RunSynchronously |> List.toSeq |> Seq.distinctBy (fun i -> i.Name) |> Seq.toList) - let indicatorsIndexed = lazy (indicators.Force() |> Seq.map (fun i -> i.Id, i) |> dict) - let indicatorsByTopic = lazy ( - indicators.Force() - |> Seq.collect (fun i -> i.TopicIds |> Seq.map (fun topicId -> topicId, i.Id)) - |> Seq.groupBy fst - |> Seq.map (fun (topicId, indicatorIds) -> topicId, indicatorIds |> Seq.map snd |> Seq.cache) - |> dict) + let topics = lazy (getTopics () |> Async.RunSynchronously) + + let topicsIndexed = + lazy + (topics.Force() + |> Seq.map (fun t -> t.Id, t) + |> dict) + + let indicators = + lazy + (getIndicators () + |> Async.RunSynchronously + |> List.toSeq + |> Seq.distinctBy (fun i -> i.Name) + |> Seq.toList) + + let indicatorsIndexed = + lazy + (indicators.Force() + |> Seq.map (fun i -> i.Id, i) + |> dict) + + let indicatorsByTopic = + lazy + (indicators.Force() + |> Seq.collect (fun i -> + i.TopicIds + |> Seq.map (fun topicId -> topicId, i.Id)) + |> Seq.groupBy fst + |> Seq.map (fun (topicId, indicatorIds) -> topicId, indicatorIds |> Seq.map snd |> Seq.cache) + |> dict) + let countries = lazy (getCountries [] |> Async.RunSynchronously) - let countriesIndexed = lazy (countries.Force() |> Seq.map (fun c -> c.Id, c) |> dict) - let regions = lazy (getRegions() |> Async.RunSynchronously) + + let countriesIndexed = + lazy + (countries.Force() + |> Seq.map (fun c -> c.Id, c) + |> dict) + + let regions = lazy (getRegions () |> Async.RunSynchronously) let regionsIndexed = lazy (regions.Force() |> dict) member internal __.Topics = topics.Force() @@ -176,78 +254,93 @@ module Implementation = member internal __.CountriesIndexed = countriesIndexed.Force() member internal __.Regions = regions.Force() member internal __.RegionsIndexed = regionsIndexed.Force() + /// At runtime, download the data - member internal __.GetDataAsync(countryOrRegionCode, indicatorCode) = - async { let! data = - getData + member internal __.GetDataAsync(countryOrRegionCode, indicatorCode) = + async { + let! data = + getData [ "countries" countryOrRegionCode "indicators" indicatorCode ] [ "date", "" ] "date" - return - seq { for k, v in data do - if not (String.IsNullOrEmpty v) then - yield int k, float v } - // It's a time series - sort it :-) We should probably also interpolate (e.g. see R time series library) - |> Seq.sortBy fst } - - member internal x.GetData(countryOrRegionCode, indicatorCode) = - x.GetDataAsync(countryOrRegionCode, indicatorCode) |> Async.RunSynchronously - member internal __.GetCountriesInRegion region = getCountries ["region", region] |> Async.RunSynchronously - + + return + seq { + for k, v in data do + if not (String.IsNullOrEmpty v) then yield int k, float v + } + // It's a time series - sort it :-) We should probably also interpolate (e.g. see R time series library) + |> Seq.sortBy fst + } + + member internal x.GetData(countryOrRegionCode, indicatorCode) = + 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 +type Indicator internal (connection: ServiceConnection, countryOrRegionCode: string, indicatorCode: string) = + let data = + connection.GetData(countryOrRegionCode, indicatorCode) + |> Seq.cache + let dataDict = lazy (dict data) - + /// Get the code for the country or region of the indicator member x.Code = countryOrRegionCode - + /// Get the code for the indicator member x.IndicatorCode = indicatorCode - + /// Get the name of the indicator member x.Name = connection.IndicatorsIndexed.[indicatorCode].Name - + /// Get the source of the indicator member x.Source = connection.IndicatorsIndexed.[indicatorCode].Source - + /// Get the description of the indicator member x.Description = connection.IndicatorsIndexed.[indicatorCode].Description - + /// Get the indicator value for the given year. If there's no data for that year, NaN is returned member x.Item - with get year = + with get year = match dataDict.Force().TryGetValue year with | true, value -> value | _ -> Double.NaN - + /// Get the indicator value for the given year, if present - member x.TryGetValueAt year = + member x.TryGetValueAt year = match dataDict.Force().TryGetValue year with | true, value -> Some value | _ -> None - + /// Get the years for which the indicator has values member x.Years = dataDict.Force().Keys - + /// Get the values for the indicator (without years) member x.Values = dataDict.Force().Values - interface seq with member x.GetEnumerator() = data.GetEnumerator() - interface IEnumerable with member x.GetEnumerator() = (data.GetEnumerator() :> _) + interface seq with + member x.GetEnumerator() = data.GetEnumerator() + + interface IEnumerable with + member x.GetEnumerator() = (data.GetEnumerator() :> _) /// Metadata for an Indicator [] [] -type IndicatorDescription internal (connection:ServiceConnection, topicCode:string, indicatorCode:string) = +type IndicatorDescription internal (connection: ServiceConnection, topicCode: string, indicatorCode: string) = /// Get the code for the topic of the indicator member x.Code = topicCode /// Get the code for the indicator @@ -261,122 +354,174 @@ type IndicatorDescription internal (connection:ServiceConnection, topicCode:stri /// type IIndicators = - abstract GetIndicator : indicatorCode:string -> Indicator - abstract AsyncGetIndicator : indicatorCode:string -> Async + abstract GetIndicator: indicatorCode: string -> Indicator + abstract AsyncGetIndicator: indicatorCode: string -> Async /// -type Indicators internal (connection:ServiceConnection, countryOrRegionCode) = - let indicators = seq { for indicator in connection.Indicators -> Indicator(connection, countryOrRegionCode, indicator.Id) } +type Indicators internal (connection: ServiceConnection, countryOrRegionCode) = + let indicators = + seq { for indicator in connection.Indicators -> Indicator(connection, countryOrRegionCode, indicator.Id) } + interface IIndicators with - member x.GetIndicator(indicatorCode) = Indicator(connection, countryOrRegionCode, indicatorCode) - member x.AsyncGetIndicator(indicatorCode) = async { return Indicator(connection, countryOrRegionCode, indicatorCode) } - interface seq with member x.GetEnumerator() = indicators.GetEnumerator() - interface IEnumerable with member x.GetEnumerator() = indicators.GetEnumerator() :> _ + member x.GetIndicator(indicatorCode) = + Indicator(connection, countryOrRegionCode, indicatorCode) + + member x.AsyncGetIndicator(indicatorCode) = + async { return Indicator(connection, countryOrRegionCode, indicatorCode) } + + interface seq with + member x.GetEnumerator() = indicators.GetEnumerator() + + interface IEnumerable with + member x.GetEnumerator() = indicators.GetEnumerator() :> _ /// type IIndicatorsDescriptions = - abstract GetIndicator : indicatorCode:string -> IndicatorDescription + abstract GetIndicator: indicatorCode: string -> IndicatorDescription /// -type IndicatorsDescriptions internal (connection:ServiceConnection, topicCode) = - let indicatorsDescriptions = seq { for indicatorId in connection.IndicatorsByTopic.[topicCode] -> IndicatorDescription(connection, topicCode, indicatorId) } - interface IIndicatorsDescriptions with member x.GetIndicator(indicatorCode) = IndicatorDescription(connection, topicCode, indicatorCode) - interface seq with member x.GetEnumerator() = indicatorsDescriptions.GetEnumerator() - interface IEnumerable with member x.GetEnumerator() = indicatorsDescriptions.GetEnumerator() :> _ +type IndicatorsDescriptions internal (connection: ServiceConnection, topicCode) = + let indicatorsDescriptions = + seq { + for indicatorId in connection.IndicatorsByTopic.[topicCode] -> + IndicatorDescription(connection, topicCode, indicatorId) + } + + interface IIndicatorsDescriptions with + member x.GetIndicator(indicatorCode) = + IndicatorDescription(connection, topicCode, indicatorCode) + + interface seq with + member x.GetEnumerator() = indicatorsDescriptions.GetEnumerator() + + interface IEnumerable with + member x.GetEnumerator() = + indicatorsDescriptions.GetEnumerator() :> _ /// -type ICountry = - abstract GetIndicators : unit -> Indicators +type ICountry = + abstract GetIndicators: unit -> Indicators /// Metadata for a Country [] [] -type Country internal (connection:ServiceConnection, countryCode:string) = +type Country internal (connection: ServiceConnection, countryCode: string) = let indicators = new Indicators(connection, countryCode) /// Get the WorldBank code of the country member x.Code = countryCode - /// Get the name of the country + /// Get the name of the country member x.Name = connection.CountriesIndexed.[countryCode].Name - /// Get the capital city of the country + /// Get the capital city of the country member x.CapitalCity = connection.CountriesIndexed.[countryCode].CapitalCity - /// Get the region of the country + /// Get the region of the country member x.Region = connection.CountriesIndexed.[countryCode].Region - interface ICountry with member x.GetIndicators() = indicators + + interface ICountry with + member x.GetIndicators() = indicators /// type ICountryCollection = - abstract GetCountry : countryCode:string * countryName:string -> Country + abstract GetCountry: countryCode: string * countryName: string -> Country /// -type CountryCollection<'T when 'T :> Country> internal (connection: ServiceConnection, regionCodeOpt) = - let items = - seq { let countries = - match regionCodeOpt with - | None -> connection.Countries - | Some r -> connection.GetCountriesInRegion(r) - for country in countries do +type CountryCollection<'T when 'T :> Country> internal (connection: ServiceConnection, regionCodeOpt) = + let items = + seq { + let countries = + match regionCodeOpt with + | None -> connection.Countries + | Some r -> connection.GetCountriesInRegion(r) + + for country in countries do if not country.IsRegion then - yield Country(connection, country.Id) :?> 'T } - interface seq<'T> with member x.GetEnumerator() = items.GetEnumerator() - interface IEnumerable with member x.GetEnumerator() = (items :> IEnumerable).GetEnumerator() - interface ICountryCollection with member x.GetCountry(countryCode, (*this parameter is only here to help FunScript*)_countryName) = Country(connection, countryCode) - + yield Country(connection, country.Id) :?> 'T + } + + interface seq<'T> with + member x.GetEnumerator() = items.GetEnumerator() + + interface IEnumerable with + member x.GetEnumerator() = (items :> IEnumerable).GetEnumerator() + + interface ICountryCollection with + member x.GetCountry(countryCode (*this parameter is only here to help FunScript*) , _countryName) = + Country(connection, countryCode) + /// type IRegion = abstract GetCountries<'T when 'T :> Country> : unit -> CountryCollection<'T> - abstract GetIndicators : unit -> Indicators + abstract GetIndicators: unit -> Indicators /// Metadata for a Region [] [] -type Region internal (connection:ServiceConnection, regionCode:string) = +type Region internal (connection: ServiceConnection, regionCode: string) = let indicators = new Indicators(connection, regionCode) /// Get the WorldBank code for the region member x.RegionCode = regionCode /// Get the name of the region member x.Name = connection.RegionsIndexed.[regionCode] + interface IRegion with - member x.GetCountries() = CountryCollection(connection,Some regionCode) + member x.GetCountries() = + CountryCollection(connection, Some regionCode) + member x.GetIndicators() = indicators - + /// type IRegionCollection = - abstract GetRegion : regionCode:string -> Region + abstract GetRegion: regionCode: string -> Region /// -type RegionCollection<'T when 'T :> Region> internal (connection: ServiceConnection) = - let items = seq { for (code, _) in connection.Regions -> Region(connection, code) :?> 'T } - interface seq<'T> with member x.GetEnumerator() = items.GetEnumerator() - interface IEnumerable with member x.GetEnumerator() = (items :> IEnumerable).GetEnumerator() - interface IRegionCollection with member x.GetRegion(regionCode) = Region(connection, regionCode) +type RegionCollection<'T when 'T :> Region> internal (connection: ServiceConnection) = + let items = + seq { for (code, _) in connection.Regions -> Region(connection, code) :?> 'T } + + interface seq<'T> with + member x.GetEnumerator() = items.GetEnumerator() + + interface IEnumerable with + member x.GetEnumerator() = (items :> IEnumerable).GetEnumerator() + + interface IRegionCollection with + member x.GetRegion(regionCode) = Region(connection, regionCode) /// -type ITopic = - abstract GetIndicators : unit -> IndicatorsDescriptions +type ITopic = + abstract GetIndicators: unit -> IndicatorsDescriptions /// Metadata for a Topic [] [] -type Topic internal (connection:ServiceConnection, topicCode:string) = +type Topic internal (connection: ServiceConnection, topicCode: string) = let indicatorsDescriptions = new IndicatorsDescriptions(connection, topicCode) /// Get the WorldBank code of the topic member x.Code = topicCode - /// Get the name of the topic + /// Get the name of the topic member x.Name = connection.TopicsIndexed.[topicCode].Name - /// Get the description of the topic + /// Get the description of the topic member x.Description = connection.TopicsIndexed.[topicCode].Description - interface ITopic with member x.GetIndicators() = indicatorsDescriptions + + interface ITopic with + member x.GetIndicators() = indicatorsDescriptions /// type ITopicCollection = - abstract GetTopic : topicCode:string -> Topic + abstract GetTopic: topicCode: string -> Topic /// -type TopicCollection<'T when 'T :> Topic> internal (connection: ServiceConnection) = - let items = seq { for topic in connection.Topics -> Topic(connection, topic.Id) :?> 'T } - interface seq<'T> with member x.GetEnumerator() = items.GetEnumerator() - interface IEnumerable with member x.GetEnumerator() = (items :> IEnumerable).GetEnumerator() - interface ITopicCollection with member x.GetTopic(topicCode) = Topic(connection, topicCode) +type TopicCollection<'T when 'T :> Topic> internal (connection: ServiceConnection) = + let items = + seq { for topic in connection.Topics -> Topic(connection, topic.Id) :?> 'T } + + interface seq<'T> with + member x.GetEnumerator() = items.GetEnumerator() + + interface IEnumerable with + member x.GetEnumerator() = (items :> IEnumerable).GetEnumerator() + + interface ITopicCollection with + member x.GetTopic(topicCode) = Topic(connection, topicCode) /// type IWorldBankData = @@ -385,11 +530,17 @@ type IWorldBankData = abstract GetTopics<'T when 'T :> Topic> : unit -> seq<'T> /// -type WorldBankData(serviceUrl:string, sources:string) = - let sources = sources.Split([| ';' |], StringSplitOptions.RemoveEmptyEntries) |> Array.toList +type WorldBankData(serviceUrl: string, sources: string) = + let sources = + sources.Split([| ';' |], StringSplitOptions.RemoveEmptyEntries) + |> Array.toList + let restCache = createInternetFileCache "WorldBankRuntime" (TimeSpan.FromDays 30.0) let connection = new ServiceConnection(restCache, serviceUrl, sources) + interface IWorldBankData with - member x.GetCountries() = CountryCollection(connection, None) :> seq<_> + member x.GetCountries() = + CountryCollection(connection, None) :> seq<_> + member x.GetRegions() = RegionCollection(connection) :> seq<_> member x.GetTopics() = TopicCollection(connection) :> seq<_> diff --git a/src/Xml/XmlGenerator.fs b/src/Xml/XmlGenerator.fs index 72f6da49a..bcfdb67f6 100644 --- a/src/Xml/XmlGenerator.fs +++ b/src/Xml/XmlGenerator.fs @@ -20,36 +20,42 @@ open ProviderImplementation.QuotationBuilder /// Context that is used to generate the XML types. type internal XmlGenerationContext = - { CultureStr : string - ProvidedType : ProvidedTypeDefinition + { CultureStr: string + ProvidedType: ProvidedTypeDefinition // to nameclash type names - UniqueNiceName : string -> string - UnifyGlobally : bool - XmlTypeCache : Dictionary - JsonTypeCache : Dictionary } + UniqueNiceName: string -> string + UnifyGlobally: bool + XmlTypeCache: Dictionary + JsonTypeCache: Dictionary } static member Create(cultureStr, tpType, unifyGlobally) = let uniqueNiceName = NameUtils.uniqueGenerator NameUtils.nicePascalName uniqueNiceName "XElement" |> ignore + { CultureStr = cultureStr ProvidedType = tpType UniqueNiceName = uniqueNiceName UnifyGlobally = unifyGlobally XmlTypeCache = Dictionary() JsonTypeCache = Dictionary() } + member x.ConvertValue prop = let typ, _, conv, _ = ConversionsGenerator.convertStringValue "" x.CultureStr prop typ, conv + member x.ConvertValueBack prop = - let typ, _, _, convBack = ConversionsGenerator.convertStringValue "" x.CultureStr prop + let typ, _, _, convBack = + ConversionsGenerator.convertStringValue "" x.CultureStr prop + typ, convBack - member x.MakeOptionType(typ:Type) = + + member x.MakeOptionType(typ: Type) = typedefof>.MakeGenericType typ -and internal XmlGenerationResult = - { ConvertedType : Type - Converter : Expr -> Expr } +and internal XmlGenerationResult = + { ConvertedType: Type + Converter: Expr -> Expr } -module internal XmlTypeBuilder = +module internal XmlTypeBuilder = /// Recognizes different valid infered types of content: /// @@ -59,140 +65,178 @@ module internal XmlTypeBuilder = /// /// We return a list with all possible primitive types and all possible /// children types (both may be empty) - let (|ContentType|_|) inferedProp = + let (|ContentType|_|) inferedProp = - let inOrder order types = - types |> Map.toList |> List.sortBy (fun (tag, _) -> List.findIndex ((=) tag) order) + let inOrder order types = + types + |> Map.toList + |> List.sortBy (fun (tag, _) -> List.findIndex ((=) tag) order) - match inferedProp with - | { Type = (InferedType.Primitive _ | InferedType.Json _) as typ } -> Some([typ], []) + 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 } -> - let collections, others = Map.toList cases |> List.partition (fst >> (=) InferedTypeTag.Collection) - match collections with - | [InferedTypeTag.Collection, InferedType.Collection (order, types)] -> Some(List.map snd others, inOrder order types) - | [] -> Some(List.map snd others, []) - | _ -> failwith "(|ContentType|_|): Only one collection type expected" + let collections, others = + Map.toList cases + |> List.partition (fst >> (=) InferedTypeTag.Collection) + + match collections with + | [ InferedTypeTag.Collection, InferedType.Collection (order, types) ] -> + Some(List.map snd others, inOrder order types) + | [] -> Some(List.map snd others, []) + | _ -> failwith "(|ContentType|_|): Only one collection type expected" // an empty element | { Type = InferedType.Top } -> Some([], []) | _ -> None - + /// Succeeds when type is a heterogeneous type containing recors /// 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 -> - let records = - cases - |> List.ofSeq - |> List.choose (function - | KeyValue(InferedTypeTag.Record (Some name), v) -> Some(name, v) - | _ -> None) - if cases.Count = records.Length then Some records - else failwith "HeterogeneousRecords: Unexpected mix of records and other type kinds" + let records = + cases + |> List.ofSeq + |> List.choose (function + | KeyValue (InferedTypeTag.Record (Some name), v) -> Some(name, v) + | _ -> None) + + if cases.Count = records.Length then + Some records + else + failwith "HeterogeneousRecords: Unexpected mix of records and other type kinds" | _ -> None - - // For every possible primitive type add 'Value' property that - // returns it converted to the right type (or an option) - let getTypesForPrimitives (ctx:XmlGenerationContext) forceOptional (primitives:_ list) = [ - - for primitive in primitives -> - - let name = - if primitives.Length = 1 - then "Value" - else (StructuralInference.typeTag primitive).NiceName - - match primitive with - | InferedType.Primitive(typ, unit, optional) -> - - let optional = optional || forceOptional - let optionalJustBecauseThereAreMultiple = primitives.Length > 1 && not optional - let optional = optional || primitives.Length > 1 - - let typ, conv = ctx.ConvertValue <| PrimitiveInferedProperty.Create("Value", typ, optional, unit) - let conv = fun xml -> conv <@ XmlRuntime.TryGetValue(%%xml) @> - - typ, name, conv, optionalJustBecauseThereAreMultiple - - | InferedType.Json(typ, optional) -> - - let cultureStr = ctx.CultureStr - let ctx = JsonGenerationContext.Create(cultureStr, ctx.ProvidedType, ctx.UniqueNiceName, ctx.JsonTypeCache) - let result = JsonTypeBuilder.generateJsonType ctx false true "" typ - - let optional = optional || forceOptional - let optionalJustBecauseThereAreMultiple = primitives.Length > 1 && not optional - let optional = optional || primitives.Length > 1 - - let typ = - if optional - then ctx.MakeOptionType result.ConvertedType - else result.ConvertedType - - let conv = fun xml -> - if optional - then <@@ XmlRuntime.TryGetJsonValue(%%xml) @@> - else <@@ XmlRuntime.GetJsonValue(%%xml) @@> - |> result.Convert - - typ, name, conv, optionalJustBecauseThereAreMultiple - - | _ -> failwithf "generatePropertiesForValue: Primitive or Json type expected: %A" primitive - ] - - /// Recursively walks over inferred type information and + + // For every possible primitive type add 'Value' property that + // returns it converted to the right type (or an option) + let getTypesForPrimitives (ctx: XmlGenerationContext) forceOptional (primitives: _ list) = + [ + + for primitive in primitives -> + + let name = + if primitives.Length = 1 then + "Value" + else + (StructuralInference.typeTag primitive).NiceName + + match primitive with + | InferedType.Primitive (typ, unit, optional) -> + + let optional = optional || forceOptional + let optionalJustBecauseThereAreMultiple = primitives.Length > 1 && not optional + let optional = optional || primitives.Length > 1 + + let typ, conv = + ctx.ConvertValue + <| PrimitiveInferedProperty.Create("Value", typ, optional, unit) + + let conv = fun xml -> conv <@ XmlRuntime.TryGetValue(%%xml) @> + + typ, name, conv, optionalJustBecauseThereAreMultiple + + | InferedType.Json (typ, optional) -> + + let cultureStr = ctx.CultureStr + + let ctx = + JsonGenerationContext.Create(cultureStr, ctx.ProvidedType, ctx.UniqueNiceName, ctx.JsonTypeCache) + + let result = JsonTypeBuilder.generateJsonType ctx false true "" typ + + let optional = optional || forceOptional + let optionalJustBecauseThereAreMultiple = primitives.Length > 1 && not optional + let optional = optional || primitives.Length > 1 + + let typ = + if optional then + ctx.MakeOptionType result.ConvertedType + else + result.ConvertedType + + let conv = + fun xml -> + if optional then + <@@ XmlRuntime.TryGetJsonValue(%%xml) @@> + else + <@@ XmlRuntime.GetJsonValue(%%xml) @@> + |> result.Convert + + typ, name, conv, optionalJustBecauseThereAreMultiple + + | _ -> failwithf "generatePropertiesForValue: Primitive or Json type expected: %A" primitive ] + + /// Recursively walks over inferred type information and /// generates types for read-only access to the document - let rec generateXmlType ctx inferedType = - + let rec generateXmlType ctx inferedType = + match inferedType with - + // If we already generated object for this type, return it - | InferedType.Record(Some _, _, false) when ctx.XmlTypeCache.ContainsKey inferedType -> + | InferedType.Record (Some _, _, false) when ctx.XmlTypeCache.ContainsKey inferedType -> ctx.XmlTypeCache.[inferedType] - + // If the element does not have any children and always contains only primitive type // then we turn it into a primitive value of type such as int/string/etc. - | InferedType.Record(Some _, [{ Name = "" - Type = (InferedType.Primitive _ | InferedType.Json _) as primitive }], false) -> - - let typ, _, conv, _ = getTypesForPrimitives ctx false [ primitive ] |> Seq.exactlyOne + | InferedType.Record (Some _, + [ { Name = "" + Type = (InferedType.Primitive _ | InferedType.Json _) as primitive } ], + false) -> + + let typ, _, conv, _ = + getTypesForPrimitives ctx false [ primitive ] + |> Seq.exactlyOne + { ConvertedType = typ Converter = conv } - + // If the element is a heterogeneous type containing records, generate type with multiple // optional properties (this can only happen when using sample list with multiple root // elements of different names). Otherwise, heterogeneous types appear only as child elements // of an element (handled similarly below) | HeterogeneousRecords cases -> - + // Generate new choice type for the element - let objectTy = ProvidedTypeDefinition(ctx.UniqueNiceName "Choice", Some typeof, hideObjectMethods = true, nonNullable = true) + let objectTy = + ProvidedTypeDefinition( + ctx.UniqueNiceName "Choice", + Some typeof, + hideObjectMethods = true, + nonNullable = true + ) + ctx.ProvidedType.AddMember objectTy - + // to nameclash property names let makeUnique = NameUtils.uniqueGenerator NameUtils.nicePascalName makeUnique "XElement" |> ignore - + // For each case, add property of optional type - let members = + let members = [ for nameWithNS, case in cases -> - - let result = generateXmlType ctx case - let convFunc = ReflectionHelpers.makeDelegate result.Converter typeof - let name = makeUnique (XName.Get(nameWithNS).LocalName) - - ProvidedProperty(name, ctx.MakeOptionType result.ConvertedType, getterCode = fun (Singleton xml) -> - // XmlRuntime.ConvertAsName checks that the name of the current element - // has the required name and returns Some/None - let xmlRuntime = typeof - (xmlRuntime?ConvertAsName (result.ConvertedType) (xml, nameWithNS, convFunc) : Expr) - ), - ((if result.ConvertedType :? ProvidedTypeDefinition then "" else nameWithNS), - ProvidedParameter(NameUtils.niceCamelName name, result.ConvertedType)) ] - - let properties, parameters = List.unzip members + + let result = generateXmlType ctx case + let convFunc = ReflectionHelpers.makeDelegate result.Converter typeof + let name = makeUnique (XName.Get(nameWithNS).LocalName) + + ProvidedProperty( + name, + ctx.MakeOptionType result.ConvertedType, + getterCode = + fun (Singleton xml) -> + // XmlRuntime.ConvertAsName checks that the name of the current element + // has the required name and returns Some/None + let xmlRuntime = typeof + (xmlRuntime?ConvertAsName (result.ConvertedType) (xml, nameWithNS, convFunc): Expr) + ), + ((if result.ConvertedType :? ProvidedTypeDefinition then + "" + else + nameWithNS), + ProvidedParameter(NameUtils.niceCamelName name, result.ConvertedType)) ] + + let properties, parameters = List.unzip members objectTy.AddMembers properties let cultureStr = ctx.CultureStr @@ -204,231 +248,366 @@ module internal XmlTypeBuilder = else let arg = Expr.Coerce(arg, typeof) <@@ XmlRuntime.CreateValue(nameWithNS, %%arg, cultureStr) @@> - let ctor = - ProvidedConstructor([param], ctorCode) + + let ctor = ProvidedConstructor([ param ], ctorCode) objectTy.AddMember ctor let ctorCode (Singleton arg: Expr list) = - <@@ XmlElement.Create(%%arg:XElement) @@> + <@@ XmlElement.Create(%%arg: XElement) @@> + let ctor = - ProvidedConstructor([ProvidedParameter("xElement",typeof)], ctorCode) + ProvidedConstructor([ ProvidedParameter("xElement", typeof) ], ctorCode) + objectTy.AddMember ctor { ConvertedType = objectTy Converter = id } - + // If the element is more complicated, then we generate a type to represent it properly - | InferedType.Record(Some nameWithNS, props, false) -> - - let names = nameWithNS.Split [| '|' |] |> Array.map (fun nameWithNS -> XName.Get(nameWithNS).LocalName) + | InferedType.Record (Some nameWithNS, props, false) -> + + let names = + nameWithNS.Split [| '|' |] + |> Array.map (fun nameWithNS -> XName.Get(nameWithNS).LocalName) + + let objectTy = + ProvidedTypeDefinition( + ctx.UniqueNiceName names.[0], + Some typeof, + hideObjectMethods = true, + nonNullable = true + ) - let objectTy = ProvidedTypeDefinition(ctx.UniqueNiceName names.[0], - Some typeof, - hideObjectMethods = true, nonNullable = true) ctx.ProvidedType.AddMember objectTy - + // If we unify types globally, then save type for this record if ctx.UnifyGlobally then - ctx.XmlTypeCache.Add(inferedType, { ConvertedType = objectTy - Converter = id }) - - // Split the properties into attributes and a + ctx.XmlTypeCache.Add( + inferedType, + { ConvertedType = objectTy + Converter = id } + ) + + // Split the properties into attributes and a // special property representing the content let attrs, content = - props |> List.partition (fun prop -> prop.Name <> "") - + props + |> List.partition (fun prop -> prop.Name <> "") + // to nameclash property names let makeUnique = NameUtils.uniqueGenerator NameUtils.nicePascalName makeUnique "XElement" |> ignore - + // Generate properties for all XML attributes - let attributeResults = + let attributeResults = [ for attr in attrs -> - - let nameWithNS = attr.Name - let name = XName.Get(nameWithNS).LocalName - - let createMember (typ: Type) (conv : _ -> Expr) = - nameWithNS, - ProvidedProperty(makeUnique name, typ, getterCode = fun (Singleton xml) -> - conv <@ XmlRuntime.TryGetAttribute(%%xml, nameWithNS) @> ), - ProvidedParameter(NameUtils.niceCamelName name, typ) - - let createPrimitiveMember typ unit (optional:bool) = - let typ, conv = ctx.ConvertValue <| PrimitiveInferedProperty.Create("Attribute " + name, typ, optional, unit) - createMember typ conv - - match attr.Type with - | 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 - // the attribute is always optional) - let choiceTy = ProvidedTypeDefinition(ctx.UniqueNiceName (name + "Choice"), Some typeof>, hideObjectMethods = true, nonNullable = true) - ctx.ProvidedType.AddMember choiceTy - - for KeyValue(tag, typ) in types do - - if typ.IsOptional then - failwithf "generateXmlType: Type shouldn't be optional: %A" typ - - match typ with - | InferedType.Primitive(primTyp, unit, false) -> - - let typ, conv = ctx.ConvertValue <| PrimitiveInferedProperty.Create(tag.NiceName, primTyp, true, unit) - choiceTy.AddMember <| - ProvidedProperty(tag.NiceName, typ , getterCode = fun (Singleton attrVal) -> - attrVal |> Expr.Cast |> conv) - - let typ, convBack = ctx.ConvertValueBack <| PrimitiveInferedProperty.Create(tag.NiceName, primTyp, false, unit) - let valueCode (Singleton arg: Expr list) = - arg |> convBack |> ProviderHelpers.some typeof - let valueCtor = - let parameter = ProvidedParameter("value", typ) - ProvidedConstructor([parameter], invokeCode = valueCode) - choiceTy.AddMember valueCtor - - | _ -> failwithf "generateXmlType: A choice type of an attribute can only contain primitive types, got %A" typ - - let defaultCtor = ProvidedConstructor([], invokeCode = fun _ -> <@@ option.None @@>) - choiceTy.AddMember defaultCtor - - createMember choiceTy (fun x -> x :> Expr) - - | 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] + + let nameWithNS = attr.Name + let name = XName.Get(nameWithNS).LocalName + + let createMember (typ: Type) (conv: _ -> Expr) = + nameWithNS, + ProvidedProperty( + makeUnique name, + typ, + getterCode = + fun (Singleton xml) -> conv <@ XmlRuntime.TryGetAttribute(%%xml, nameWithNS) @> + ), + ProvidedParameter(NameUtils.niceCamelName name, typ) + + let createPrimitiveMember typ unit (optional: bool) = + let typ, conv = + ctx.ConvertValue + <| PrimitiveInferedProperty.Create("Attribute " + name, typ, optional, unit) + + createMember typ conv + + match attr.Type with + | 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 + // the attribute is always optional) + let choiceTy = + ProvidedTypeDefinition( + ctx.UniqueNiceName(name + "Choice"), + Some typeof>, + hideObjectMethods = true, + nonNullable = true + ) + + ctx.ProvidedType.AddMember choiceTy + + for KeyValue (tag, typ) in types do + + if typ.IsOptional then + failwithf "generateXmlType: Type shouldn't be optional: %A" typ + + match typ with + | InferedType.Primitive (primTyp, unit, false) -> + + let typ, conv = + ctx.ConvertValue + <| PrimitiveInferedProperty.Create(tag.NiceName, primTyp, true, unit) + + choiceTy.AddMember + <| ProvidedProperty( + tag.NiceName, + typ, + getterCode = fun (Singleton attrVal) -> attrVal |> Expr.Cast |> conv + ) + + let typ, convBack = + ctx.ConvertValueBack + <| PrimitiveInferedProperty.Create(tag.NiceName, primTyp, false, unit) + + let valueCode (Singleton arg: Expr list) = + arg + |> convBack + |> ProviderHelpers.some typeof + + let valueCtor = + let parameter = ProvidedParameter("value", typ) + ProvidedConstructor([ parameter ], invokeCode = valueCode) + + choiceTy.AddMember valueCtor + + | _ -> + failwithf + "generateXmlType: A choice type of an attribute can only contain primitive types, got %A" + typ + + let defaultCtor = + ProvidedConstructor([], invokeCode = fun _ -> <@@ option.None @@>) + + choiceTy.AddMember defaultCtor + + createMember choiceTy (fun x -> x :> Expr) + + | 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 ] // Add properties that can be used to access content of the element // (either child elements or primitive values if the element contains only simple values) - let primitiveResults, childResults = - match content with - | [ContentType(primitives, children)] -> - + let primitiveResults, childResults = + match content with + | [ ContentType (primitives, children) ] -> + // If there may be other children, make it optional let forceOptional = children.Length > 0 - + let primitiveResults = - [ for typ, name, conv, optionalJustBecauseThereAreMultiple in getTypesForPrimitives ctx forceOptional primitives -> - let nonOptionalType = if optionalJustBecauseThereAreMultiple && typ.IsGenericType then typ.GetGenericArguments().[0] else typ - let name = makeUnique name - ProvidedProperty(name, typ, getterCode = fun (Singleton xml) -> conv xml), - ProvidedParameter(NameUtils.niceCamelName name, nonOptionalType) ] - + [ for typ, name, conv, optionalJustBecauseThereAreMultiple in + getTypesForPrimitives ctx forceOptional primitives -> + let nonOptionalType = + if optionalJustBecauseThereAreMultiple + && typ.IsGenericType then + typ.GetGenericArguments().[0] + else + typ + + let name = makeUnique name + + ProvidedProperty(name, typ, getterCode = fun (Singleton xml) -> conv xml), + ProvidedParameter(NameUtils.niceCamelName name, nonOptionalType) ] + // For every possible child element, generate a getter property let childResults = [ for child in children -> - let isCollectionName parentName childName = - parentName = NameUtils.pluralize childName || parentName.StartsWith childName - - let child = - match child with - | InferedTypeTag.Record(Some parentNameWithNS), - (InferedMultiplicity.Single, - InferedType.Record(Some parentNameWithNS2, - [ { Type = InferedType.Collection (_, SingletonMap (InferedTypeTag.Record (Some childNameWithNS), - (_, InferedType.Record(Some childNameWithNS2, _, false) as multiplicityAndType))) } ], false)) - when parentNameWithNS = parentNameWithNS2 && childNameWithNS = childNameWithNS2 && isCollectionName (XName.Get(parentNameWithNS).LocalName) (XName.Get(childNameWithNS).LocalName) -> - let combinedName = Some (parentNameWithNS + "|" + childNameWithNS) + let isCollectionName parentName childName = + parentName = NameUtils.pluralize childName + || parentName.StartsWith childName + + let child = + match child with + | InferedTypeTag.Record (Some parentNameWithNS), + (InferedMultiplicity.Single, + InferedType.Record (Some parentNameWithNS2, + [ { Type = InferedType.Collection (_, + SingletonMap (InferedTypeTag.Record (Some childNameWithNS), + (_, + InferedType.Record (Some childNameWithNS2, + _, + false) as multiplicityAndType))) } ], + false)) when + parentNameWithNS = parentNameWithNS2 + && childNameWithNS = childNameWithNS2 + && isCollectionName + (XName.Get(parentNameWithNS).LocalName) + (XName.Get(childNameWithNS).LocalName) + -> + let combinedName = Some(parentNameWithNS + "|" + childNameWithNS) InferedTypeTag.Record combinedName, multiplicityAndType - | x -> x - - match child with - | InferedTypeTag.Record(Some nameWithNS), (multiplicity, typ) -> - - let names = nameWithNS.Split [| '|' |] |> Array.map (fun nameWithNS -> XName.Get(nameWithNS).LocalName) - let result = generateXmlType ctx typ - - match multiplicity with - | InferedMultiplicity.Single -> - let name = makeUnique names.[names.Length - 1] - nameWithNS, - ProvidedProperty(name, result.ConvertedType, getterCode = fun (Singleton xml) -> - result.Converter <@@ XmlRuntime.GetChild(%%xml, nameWithNS) @@> - ), - ProvidedParameter(NameUtils.niceCamelName name, result.ConvertedType) - - // For options and arrays, we need to generate call to ConvertArray or ConvertOption - // (because the child may be represented as primitive type - so we cannot just - // return array of XmlElement - it might be for example int[]) - | InferedMultiplicity.Multiple -> - let convFunc = ReflectionHelpers.makeDelegate result.Converter typeof - let isCollectionName = names.[0].EndsWith "List" || names.[0].EndsWith "Array" || names.[0].EndsWith "Collection" - let name = makeUnique (if isCollectionName then names.[0] else NameUtils.pluralize names.[0]) - let typ = result.ConvertedType.MakeArrayType() - nameWithNS, - ProvidedProperty(name, typ, getterCode = fun (Singleton xml) -> - let xmlRuntime = typeof - xmlRuntime?ConvertArray (result.ConvertedType) (xml, nameWithNS, convFunc)), - ProvidedParameter(NameUtils.niceCamelName name, typ) - - | InferedMultiplicity.OptionalSingle -> - let convFunc = ReflectionHelpers.makeDelegate result.Converter typeof - let name = makeUnique names.[names.Length - 1] - if result.ConvertedType.Name.StartsWith "FSharpOption`1" then - nameWithNS, - ProvidedProperty(name, result.ConvertedType, getterCode = fun (Singleton xml) -> - let xmlRuntime = typeof - xmlRuntime?ConvertOptional2 (result.ConvertedType.GenericTypeArguments.[0]) (xml, nameWithNS, convFunc) - ), - ProvidedParameter(NameUtils.niceCamelName name, result.ConvertedType) - else - let typ = ctx.MakeOptionType result.ConvertedType - nameWithNS, - ProvidedProperty(name, typ, getterCode = fun (Singleton xml) -> - let xmlRuntime = typeof - xmlRuntime?ConvertOptional (result.ConvertedType) (xml, nameWithNS, convFunc) - ), - ProvidedParameter(NameUtils.niceCamelName name, typ) - - | _ -> failwithf "generateXmlType: Child elements should be named record types, got %A" child ] + | x -> x + + match child with + | InferedTypeTag.Record (Some nameWithNS), (multiplicity, typ) -> + + let names = + nameWithNS.Split [| '|' |] + |> Array.map (fun nameWithNS -> XName.Get(nameWithNS).LocalName) + + let result = generateXmlType ctx typ + + match multiplicity with + | InferedMultiplicity.Single -> + let name = makeUnique names.[names.Length - 1] + + nameWithNS, + ProvidedProperty( + name, + result.ConvertedType, + getterCode = + fun (Singleton xml) -> + result.Converter <@@ XmlRuntime.GetChild(%%xml, nameWithNS) @@> + ), + ProvidedParameter(NameUtils.niceCamelName name, result.ConvertedType) + + // For options and arrays, we need to generate call to ConvertArray or ConvertOption + // (because the child may be represented as primitive type - so we cannot just + // return array of XmlElement - it might be for example int[]) + | InferedMultiplicity.Multiple -> + let convFunc = ReflectionHelpers.makeDelegate result.Converter typeof + + let isCollectionName = + names.[0].EndsWith "List" + || names.[0].EndsWith "Array" + || names.[0].EndsWith "Collection" + + let name = + makeUnique ( + if isCollectionName then + names.[0] + else + NameUtils.pluralize names.[0] + ) + + let typ = result.ConvertedType.MakeArrayType() + + nameWithNS, + ProvidedProperty( + name, + typ, + getterCode = + fun (Singleton xml) -> + let xmlRuntime = typeof + + xmlRuntime?ConvertArray + (result.ConvertedType) + (xml, nameWithNS, convFunc) + ), + ProvidedParameter(NameUtils.niceCamelName name, typ) + + | InferedMultiplicity.OptionalSingle -> + let convFunc = ReflectionHelpers.makeDelegate result.Converter typeof + let name = makeUnique names.[names.Length - 1] + + if result.ConvertedType.Name.StartsWith "FSharpOption`1" then + nameWithNS, + ProvidedProperty( + name, + result.ConvertedType, + getterCode = + fun (Singleton xml) -> + let xmlRuntime = typeof + + xmlRuntime?ConvertOptional2 + (result.ConvertedType.GenericTypeArguments.[0]) + (xml, nameWithNS, convFunc) + ), + ProvidedParameter(NameUtils.niceCamelName name, result.ConvertedType) + else + let typ = ctx.MakeOptionType result.ConvertedType + + nameWithNS, + ProvidedProperty( + name, + typ, + getterCode = + fun (Singleton xml) -> + let xmlRuntime = typeof + + xmlRuntime?ConvertOptional + (result.ConvertedType) + (xml, nameWithNS, convFunc) + ), + ProvidedParameter(NameUtils.niceCamelName name, typ) + + | _ -> + failwithf "generateXmlType: Child elements should be named record types, got %A" child ] primitiveResults, childResults - | [_] -> failwithf "generateXmlType: Children should be collection or heterogeneous: %A" content - | _::_ -> failwithf "generateXmlType: Only one child collection expected: %A" content + | [ _ ] -> failwithf "generateXmlType: Children should be collection or heterogeneous: %A" content + | _ :: _ -> failwithf "generateXmlType: Only one child collection expected: %A" content | [] -> [], [] - + let attrNames, attrProperties, attrParameters = List.unzip3 attributeResults let primitiveElemProperties, primitiveElemParameters = List.unzip primitiveResults - let childElemNames, childElemProperties, childElemParameters = List.unzip3 childResults - - objectTy.AddMembers (attrProperties @ primitiveElemProperties @ childElemProperties) - - let createConstrutor primitiveParam = - let parameters = match primitiveParam with - | Some primitiveParam -> attrParameters @ [primitiveParam] @ childElemParameters - | None -> attrParameters @ childElemParameters + + let childElemNames, childElemProperties, childElemParameters = + List.unzip3 childResults + + objectTy.AddMembers( + attrProperties + @ primitiveElemProperties @ childElemProperties + ) + + let createConstrutor primitiveParam = + let parameters = + match primitiveParam with + | Some primitiveParam -> + attrParameters + @ [ primitiveParam ] @ childElemParameters + | None -> attrParameters @ childElemParameters + let ctorCode (args: Expr list) = - let attributes = - Expr.NewArray(typeof, - args - |> Seq.take attrParameters.Length - |> Seq.toList - |> List.mapi (fun i a -> Expr.NewTuple [ Expr.Value attrNames.[i] - Expr.Coerce(a, typeof) ])) - let elements = - args - |> Seq.skip (attrParameters.Length + (match primitiveParam with Some _ -> 1 | None -> 0)) + let attributes = + Expr.NewArray( + typeof, + args + |> Seq.take attrParameters.Length |> Seq.toList - |> List.mapi (fun i a -> Expr.NewTuple [ Expr.Value childElemNames.[i] - Expr.Coerce(a, typeof) ]) - let elements = - match primitiveParam with - | Some _ -> - Expr.NewTuple [ Expr.Value "" - Expr.Coerce (args.[attrParameters.Length], typeof) ] :: elements - | None -> elements - - let elements = Expr.NewArray(typeof, elements) - - let cultureStr = ctx.CultureStr - <@@ XmlRuntime.CreateRecord(nameWithNS, %%attributes, %%elements, cultureStr) @@> + |> List.mapi (fun i a -> + Expr.NewTuple + [ Expr.Value attrNames.[i] + Expr.Coerce(a, typeof) ]) + ) + + let elements = + args + |> Seq.skip ( + attrParameters.Length + + (match primitiveParam with + | Some _ -> 1 + | None -> 0) + ) + |> Seq.toList + |> List.mapi (fun i a -> + Expr.NewTuple + [ Expr.Value childElemNames.[i] + Expr.Coerce(a, typeof) ]) + + let elements = + match primitiveParam with + | Some _ -> + Expr.NewTuple + [ Expr.Value "" + Expr.Coerce(args.[attrParameters.Length], typeof) ] + :: elements + | None -> elements + + let elements = Expr.NewArray(typeof, elements) + + 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 else @@ -436,13 +615,13 @@ module internal XmlTypeBuilder = createConstrutor (Some primitiveParam) let ctorCode (Singleton arg: Expr list) = - <@@ XmlElement.Create(%%arg:XElement) @@> - let ctorParams = [ProvidedParameter("xElement", typeof)] - let ctor = - ProvidedConstructor(ctorParams, ctorCode) + <@@ XmlElement.Create(%%arg: XElement) @@> + + let ctorParams = [ ProvidedParameter("xElement", typeof) ] + let ctor = ProvidedConstructor(ctorParams, ctorCode) objectTy.AddMember ctor - { ConvertedType = objectTy + { ConvertedType = objectTy Converter = id } - + | _ -> failwithf "generateXmlType: Infered type should be record type: %A" inferedType diff --git a/src/Xml/XmlInference.fs b/src/Xml/XmlInference.fs index cc56c7d46..1d278fa1f 100644 --- a/src/Xml/XmlInference.fs +++ b/src/Xml/XmlInference.fs @@ -13,36 +13,48 @@ open FSharp.Data.Runtime.StructuralInference open FSharp.Data.Runtime.StructuralTypes // The type of XML element is always a non-optional record with a field -// for every attribute. If it has some content, then it also +// for every attribute. If it has some content, then it also // contains a special field named "" which is either a collection // (of other records etc.) or a primitive with the type of the content /// Generates record fields for all attributes -let private getAttributes inferTypesFromValues 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) - } ] - -let getInferedTypeFromValue inferTypesFromValues cultureInfo (element:XElement) = +let private getAttributes inferTypesFromValues 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) } ] + +let getInferedTypeFromValue inferTypesFromValues cultureInfo (element: XElement) = if inferTypesFromValues then let value = element.Value let typ = getInferedTypeFromString cultureInfo value None + match typ with - | InferedType.Primitive(t, _, optional) when t = typeof && let v = value.TrimStart() in v.StartsWith "{" || v.StartsWith "[" -> + | InferedType.Primitive (t, _, optional) when + t = typeof + && let v = value.TrimStart() in + v.StartsWith "{" || v.StartsWith "[" + -> try match JsonValue.Parse value with - | (JsonValue.Record _ | JsonValue.Array _) as json -> - let jsonType = json |> JsonInference.inferType true cultureInfo element.Name.LocalName + | (JsonValue.Record _ + | JsonValue.Array _) as json -> + let jsonType = + json + |> JsonInference.inferType true cultureInfo element.Name.LocalName + InferedType.Json(jsonType, optional) | _ -> typ - with _ -> typ + with _ -> + typ | _ -> typ else InferedType.Primitive(typeof, None, false) @@ -50,87 +62,109 @@ let getInferedTypeFromValue inferTypesFromValues cultureInfo (element:XElement) /// Infers type for the element, unifying nodes of the same name /// accross the entire document (we first get information based /// on just attributes and then use a fixed point) -let inferGlobalType inferTypesFromValues cultureInfo allowEmptyValues (elements:XElement[]) = - - // Initial state contains types with attributes but all - // children are ignored (bodies are based on just body values) - let document = - elements - |> Seq.map (fun e -> e.Document) - |> Seq.reduce (fun d1 d2 -> - if d1 <> d2 then failwith "inferGlobalType: Elements from multiple documents!" else d1) - let initialTypes = - document.Descendants() - |> Seq.groupBy (fun el -> el.Name) - |> Seq.map (fun (name, elements) -> - // Get attributes for all `name` named elements - let attributes = - elements - |> Seq.map (getAttributes inferTypesFromValues cultureInfo) - |> Seq.reduce (unionRecordTypes allowEmptyValues) - - // Get type of body based on primitive values only - let bodyType = - [| for e in elements do - if not e.HasElements && not (String.IsNullOrEmpty(e.Value)) then - yield getInferedTypeFromValue inferTypesFromValues cultureInfo e |] - |> Array.fold (subtypeInfered allowEmptyValues) InferedType.Top - let body = { Name = "" - Type = bodyType } - - let record = InferedType.Record(Some(name.ToString()), body::attributes, false) - name.ToString(), (elements, record) ) - |> Map.ofSeq - - /// Updates the types representing body in a given assignment - /// (This is done repeatedly until we reach a fixed point) - let assignment = initialTypes - let mutable changed = true - while changed do - changed <- false - for KeyValue(_, value) in assignment do - match value with - | elements, InferedType.Record(Some _name, body::_attributes, false) -> - if body.Name <> "" then failwith "inferGlobalType: Assumed body element first" - let childrenType = [ for e in elements -> - inferCollectionType allowEmptyValues [ for e in e.Elements() -> assignment.[e.Name.ToString()] |> snd ] ] - |> List.fold (subtypeInfered allowEmptyValues) InferedType.Top - let bodyType = - match childrenType with - | InferedType.Collection (_, EmptyMap () _) -> body.Type - | childrenType -> subtypeInfered allowEmptyValues childrenType body.Type - changed <- changed || body.Type <> bodyType - body.Type <- bodyType - | _ -> failwith "inferGlobalType: Expected record type with a name" - - elements |> Array.map (fun element -> - assignment.[element.Name.ToString()] |> snd) +let inferGlobalType inferTypesFromValues cultureInfo allowEmptyValues (elements: XElement[]) = + + // Initial state contains types with attributes but all + // children are ignored (bodies are based on just body values) + let document = + elements + |> Seq.map (fun e -> e.Document) + |> Seq.reduce (fun d1 d2 -> + if d1 <> d2 then + failwith "inferGlobalType: Elements from multiple documents!" + else + d1) + + let initialTypes = + document.Descendants() + |> Seq.groupBy (fun el -> el.Name) + |> Seq.map (fun (name, elements) -> + // Get attributes for all `name` named elements + let attributes = + elements + |> Seq.map (getAttributes inferTypesFromValues cultureInfo) + |> Seq.reduce (unionRecordTypes allowEmptyValues) + + // Get type of body based on primitive values only + let bodyType = + [| for e in elements do + if + not e.HasElements + && not (String.IsNullOrEmpty(e.Value)) + then + yield getInferedTypeFromValue inferTypesFromValues cultureInfo e |] + |> Array.fold (subtypeInfered allowEmptyValues) InferedType.Top + + let body = { Name = ""; Type = bodyType } + + let record = InferedType.Record(Some(name.ToString()), body :: attributes, false) + name.ToString(), (elements, record)) + |> Map.ofSeq + + /// Updates the types representing body in a given assignment + /// (This is done repeatedly until we reach a fixed point) + let assignment = initialTypes + + let mutable changed = true + + while changed do + changed <- false + + for KeyValue (_, value) in assignment do + match value with + | elements, InferedType.Record (Some _name, body :: _attributes, false) -> + if body.Name <> "" then + failwith "inferGlobalType: Assumed body element first" + + let childrenType = + [ for e in elements -> + inferCollectionType + allowEmptyValues + [ for e in e.Elements() -> assignment.[e.Name.ToString()] |> snd ] ] + |> List.fold (subtypeInfered allowEmptyValues) InferedType.Top + + let bodyType = + match childrenType with + | InferedType.Collection (_, EmptyMap () _) -> body.Type + | childrenType -> subtypeInfered allowEmptyValues childrenType body.Type + + changed <- changed || body.Type <> bodyType + body.Type <- bodyType + | _ -> failwith "inferGlobalType: Expected record type with a name" + + elements + |> Array.map (fun element -> assignment.[element.Name.ToString()] |> snd) /// 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 props = - [ // Generate record fields for attributes - yield! getAttributes inferTypesFromValues cultureInfo element - - // If it has children, add collection content - let children = element.Elements() - if Seq.length children > 0 then - let collection = inferCollectionType allowEmptyValues (Seq.map (inferLocalType inferTypesFromValues 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 - yield { Name = "" - Type = primitive } ] - - InferedType.Record(Some(element.Name.ToString()), props, false) +let rec inferLocalType inferTypesFromValues cultureInfo allowEmptyValues (element: XElement) = + let props = + [ // Generate record fields for attributes + yield! getAttributes inferTypesFromValues cultureInfo element + + // If it has children, add collection content + let children = element.Elements() + + if Seq.length children > 0 then + let collection = + inferCollectionType + allowEmptyValues + (Seq.map (inferLocalType inferTypesFromValues 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 + yield { Name = ""; Type = primitive } ] + + InferedType.Record(Some(element.Name.ToString()), props, false) /// 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[]) = - if globalInference then inferGlobalType inferTypesFromValues cultureInfo allowEmptyValues elements - else Array.map (inferLocalType inferTypesFromValues cultureInfo allowEmptyValues) elements +let inferType inferTypesFromValues cultureInfo allowEmptyValues globalInference (elements: XElement[]) = + if globalInference then + inferGlobalType inferTypesFromValues cultureInfo allowEmptyValues elements + else + Array.map (inferLocalType inferTypesFromValues cultureInfo allowEmptyValues) elements diff --git a/src/Xml/XmlProvider.fs b/src/Xml/XmlProvider.fs index 42fcc63c7..95cac5b02 100644 --- a/src/Xml/XmlProvider.fs +++ b/src/Xml/XmlProvider.fs @@ -16,20 +16,27 @@ open FSharp.Data.Runtime.StructuralTypes #nowarn "10001" [] -type public XmlProvider(cfg:TypeProviderConfig) as this = - inherit DisposableTypeProviderForNamespaces(cfg, assemblyReplacementMap=[ "FSharp.Data.DesignTime", "FSharp.Data" ]) - +type public XmlProvider(cfg: TypeProviderConfig) as this = + inherit DisposableTypeProviderForNamespaces + ( + cfg, + assemblyReplacementMap = [ "FSharp.Data.DesignTime", "FSharp.Data" ] + ) + // Generate namespace and type 'FSharp.Data.XmlProvider' do AssemblyResolver.init () let asm = System.Reflection.Assembly.GetExecutingAssembly() let ns = "FSharp.Data" - let xmlProvTy = ProvidedTypeDefinition(asm, ns, "XmlProvider", None, hideObjectMethods=true, nonNullable=true) - - let buildTypes (typeName:string) (args:obj[]) = - + + let xmlProvTy = + ProvidedTypeDefinition(asm, ns, "XmlProvider", None, hideObjectMethods = true, nonNullable = true) + + let buildTypes (typeName: string) (args: obj[]) = + // Generate the required type - let tpType = ProvidedTypeDefinition(asm, ns, typeName, None, hideObjectMethods=true, nonNullable=true) - + let tpType = + ProvidedTypeDefinition(asm, ns, typeName, None, hideObjectMethods = true, nonNullable = true) + let sample = args.[0] :?> string let sampleIsList = args.[1] :?> bool let globalInference = args.[2] :?> bool @@ -39,98 +46,114 @@ type public XmlProvider(cfg:TypeProviderConfig) as this = let resource = args.[6] :?> string let inferTypesFromValues = args.[7] :?> bool let schema = args.[8] :?> string - + if schema <> "" then if sample <> "" then failwith "When the Schema parameter is used, the Sample parameter cannot be used" + if sampleIsList then failwith "When the Schema parameter is used, the SampleIsList parameter must be set to false" let getSpec _ value = - + if schema <> "" then - + let schemaSet = use _holder = IO.logTime "Parsing" sample XmlSchema.parseSchema resolutionFolder value - let inferedType = + let inferedType = use _holder = IO.logTime "Inference" sample + schemaSet - |> XsdParsing.getElements + |> XsdParsing.getElements |> List.ofSeq |> XsdInference.inferElements use _holder = IO.logTime "TypeGeneration" sample - - let ctx = XmlGenerationContext.Create(cultureStr, tpType, globalInference || schema <> "") + + 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) @@> + 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 - } + CreateFromTextReaderForSampleList = + fun reader -> // hack: this will actually parse the schema + <@@ XmlSchema.parseSchemaFromTextReader resolutionFolder %reader @@> + CreateFromValue = None } else - - let samples = - 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 = - use _holder = IO.logTime "Inference" sample - samples - |> XmlInference.inferType inferTypesFromValues (TextRuntime.GetCulture cultureStr) false globalInference - |> Array.fold (StructuralInference.subtypeInfered false) InferedType.Top - - 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 samples = + 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 = + use _holder = IO.logTime "Inference" sample + + samples + |> XmlInference.inferType + inferTypesFromValues + (TextRuntime.GetCulture cultureStr) + false + globalInference + |> Array.fold (StructuralInference.subtypeInfered false) InferedType.Top + + 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 source = - if schema <> "" then - Schema schema - elif sampleIsList then - SampleList sample - else - Sample sample - - generateType (if schema <> "" then "XSD" else "XML") source getSpec this cfg encodingStr resolutionFolder resource typeName None - - // Add static parameter that specifies the API we want to get (compile-time) - let parameters = + if schema <> "" then Schema schema + elif sampleIsList then SampleList sample + else Sample sample + + generateType + (if schema <> "" then "XSD" else "XML") + source + getSpec + this + cfg + encodingStr + resolutionFolder + resource + typeName + None + + // Add static parameter that specifies the API we want to get (compile-time) + let parameters = [ ProvidedStaticParameter("Sample", typeof, parameterDefaultValue = "") ProvidedStaticParameter("SampleIsList", typeof, parameterDefaultValue = false) ProvidedStaticParameter("Global", typeof, parameterDefaultValue = false) - ProvidedStaticParameter("Culture", typeof, parameterDefaultValue = "") - ProvidedStaticParameter("Encoding", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("Culture", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("Encoding", typeof, parameterDefaultValue = "") ProvidedStaticParameter("ResolutionFolder", typeof, parameterDefaultValue = "") ProvidedStaticParameter("EmbeddedResource", typeof, parameterDefaultValue = "") - ProvidedStaticParameter("InferTypesFromValues", typeof, parameterDefaultValue = true) + ProvidedStaticParameter("InferTypesFromValues", typeof, parameterDefaultValue = true) ProvidedStaticParameter("Schema", typeof, parameterDefaultValue = "") ] - - let helpText = + + let helpText = """Typed representation of a XML file. Location of a XML sample file or a string containing a sample XML document. If true, the children of the root in the sample document represent individual samples for the inference. @@ -143,10 +166,10 @@ type public XmlProvider(cfg:TypeProviderConfig) as this = 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.""" - - + + do xmlProvTy.AddXmlDoc helpText do xmlProvTy.DefineStaticParameters(parameters, buildTypes) - + // Register the main type with F# compiler do this.AddNamespace(ns, [ xmlProvTy ]) diff --git a/src/Xml/XmlRuntime.fs b/src/Xml/XmlRuntime.fs index 0b419ea2f..3e26cb746 100644 --- a/src/Xml/XmlRuntime.fs +++ b/src/Xml/XmlRuntime.fs @@ -11,39 +11,61 @@ open System.Runtime.InteropServices // any of the XML parts [] /// Extension methods for XElement -module XElementExtensions = +module XElementExtensions = type XElement with - /// Sends the XML to the specified uri. Defaults to a POST request. - member x.Request(uri:string, [] ?httpMethod, [] ?headers:seq<_>) = - let httpMethod = defaultArg httpMethod HttpMethod.Post - let headers = defaultArg (Option.map List.ofSeq headers) [] - let headers = - if headers |> List.exists (fst >> (=) (fst (HttpRequestHeaders.UserAgent ""))) - then headers - else HttpRequestHeaders.UserAgent "FSharp.Data XML Type Provider" :: headers - let headers = HttpRequestHeaders.ContentType HttpContentTypes.Xml :: headers - Http.Request( - uri, - body = TextRequest (x.ToString(SaveOptions.DisableFormatting)), - headers = headers, - httpMethod = httpMethod) - - /// Sends the XML to the specified uri. Defaults to a POST request. - member x.RequestAsync(uri:string, [] ?httpMethod, [] ?headers:seq<_>) = - let httpMethod = defaultArg httpMethod HttpMethod.Post - let headers = defaultArg (Option.map List.ofSeq headers) [] - let headers = - if headers |> List.exists (fst >> (=) (fst (HttpRequestHeaders.UserAgent ""))) - then headers - else HttpRequestHeaders.UserAgent "FSharp.Data XML Type Provider" :: headers - let headers = HttpRequestHeaders.ContentType HttpContentTypes.Xml :: headers - Http.AsyncRequest( - uri, - body = TextRequest (x.ToString(SaveOptions.DisableFormatting)), - headers = headers, - httpMethod = httpMethod) + /// Sends the XML to the specified uri. Defaults to a POST request. + member x.Request(uri: string, [] ?httpMethod, [] ?headers: seq<_>) = + let httpMethod = defaultArg httpMethod HttpMethod.Post + let headers = defaultArg (Option.map List.ofSeq headers) [] + + let headers = + if + headers + |> List.exists (fst >> (=) (fst (HttpRequestHeaders.UserAgent ""))) + then + headers + else + HttpRequestHeaders.UserAgent "FSharp.Data XML Type Provider" + :: headers + + let headers = + HttpRequestHeaders.ContentType HttpContentTypes.Xml + :: headers + + Http.Request( + uri, + body = TextRequest(x.ToString(SaveOptions.DisableFormatting)), + headers = headers, + httpMethod = httpMethod + ) + + /// Sends the XML to the specified uri. Defaults to a POST request. + member x.RequestAsync(uri: string, [] ?httpMethod, [] ?headers: seq<_>) = + let httpMethod = defaultArg httpMethod HttpMethod.Post + let headers = defaultArg (Option.map List.ofSeq headers) [] + + let headers = + if + headers + |> List.exists (fst >> (=) (fst (HttpRequestHeaders.UserAgent ""))) + then + headers + else + HttpRequestHeaders.UserAgent "FSharp.Data XML Type Provider" + :: headers + + let headers = + HttpRequestHeaders.ContentType HttpContentTypes.Xml + :: headers + + Http.AsyncRequest( + uri, + body = TextRequest(x.ToString(SaveOptions.DisableFormatting)), + headers = headers, + httpMethod = httpMethod + ) // -------------------------------------------------------------------------------------- @@ -58,54 +80,74 @@ open System.Xml.Linq /// Underlying representation of types generated by XmlProvider [] -type XmlElement = - - // NOTE: Using a record here to hide the ToString, GetHashCode & Equals - // (but since this is used across multiple files, we have explicit Create method) - { XElement : XElement } - - /// - [] - [] - member x._Print = - let str = x.ToString() - if str.Length > 512 then str.Substring(0, 509) + "..." - else str - - /// - [] - [] - override x.ToString() = x.XElement.ToString() - - /// - [] - [] - static member Create(element) = - { XElement = element } - - /// - [] - [] - static member Create(reader:TextReader) = - use reader = reader - let text = reader.ReadToEnd() - let element = XDocument.Parse(text, LoadOptions.PreserveWhitespace).Root - { XElement = element } - - /// - [] - [] - static member CreateList(reader:TextReader) = - use reader = reader - let text = reader.ReadToEnd() - try - XDocument.Parse(text, LoadOptions.PreserveWhitespace).Root.Elements() - |> Seq.map (fun value -> { XElement = value }) - |> Seq.toArray - with _ when text.TrimStart().StartsWith "<" -> - XDocument.Parse("" + text + "", LoadOptions.PreserveWhitespace).Root.Elements() - |> Seq.map (fun value -> { XElement = value }) - |> Seq.toArray +type XmlElement = + + // NOTE: Using a record here to hide the ToString, GetHashCode & Equals + // (but since this is used across multiple files, we have explicit Create method) + { XElement: XElement } + + /// + [] + [] + member x._Print = + let str = x.ToString() + + if str.Length > 512 then + str.Substring(0, 509) + "..." + else + str + + /// + [] + [] + override x.ToString() = x.XElement.ToString() + + /// + [] + [] + static member Create(element) = { XElement = element } + + /// + [] + [] + static member Create(reader: TextReader) = + use reader = reader + let text = reader.ReadToEnd() + let element = XDocument.Parse(text, LoadOptions.PreserveWhitespace).Root + { XElement = element } + + /// + [] + [] + static member CreateList(reader: TextReader) = + use reader = reader + let text = reader.ReadToEnd() + + try + XDocument.Parse(text, LoadOptions.PreserveWhitespace).Root.Elements() + |> Seq.map (fun value -> { XElement = value }) + |> Seq.toArray + with _ when text.TrimStart().StartsWith "<" -> + XDocument + .Parse("" + text + "", LoadOptions.PreserveWhitespace) + .Root.Elements() + |> Seq.map (fun value -> { XElement = value }) + |> Seq.toArray // -------------------------------------------------------------------------------------- @@ -117,237 +159,289 @@ open System.Xml.Linq open FSharp.Data.Runtime.BaseTypes /// Static helper methods called from the generated code for working with XML -type XmlRuntime = - - // Operations for getting node values and values of attributes - - static member TryGetValue(xml:XmlElement) = - if String.IsNullOrEmpty(xml.XElement.Value) then None else Some xml.XElement.Value - - static member TryGetAttribute(xml:XmlElement, nameWithNS) = - let attr = xml.XElement.Attribute(XName.Get(nameWithNS)) - if attr = null then None else Some attr.Value - - // Operations that obtain children - depending on the inference, we may - // want to get an array, option (if it may or may not be there) or - // just the value (if we think it is always there) - - static member private GetChildrenArray(value:XmlElement, nameWithNS:string) = - let namesWithNS = nameWithNS.Split '|' - let mutable current = value.XElement - for i = 0 to namesWithNS.Length - 2 do - if current <> null then - current <- current.Element(XName.Get namesWithNS.[i]) - let value = current - if value = null then [| |] - else [| for c in value.Elements(XName.Get namesWithNS.[namesWithNS.Length - 1]) -> { XElement = c } |] - - static member private GetChildOption(value:XmlElement, nameWithNS) = - match XmlRuntime.GetChildrenArray(value, nameWithNS) with - | [| it |] -> Some it - | [| |] -> None - | array -> failwithf "XML mismatch: Expected zero or one '%s' child, got %d" nameWithNS array.Length - - static member GetChild(value:XmlElement, nameWithNS) = - match XmlRuntime.GetChildrenArray(value, nameWithNS) with - | [| it |] -> it - | array -> failwithf "XML mismatch: Expected exactly one '%s' child, got %d" nameWithNS array.Length - - // Functions that transform specified chidlrens using a transformation - // function - we need a version for array and option - // (This is used e.g. when transforming `12` to `int[]`) - - static member ConvertArray<'R>(xml:XmlElement, nameWithNS, f:Func) : 'R[] = - XmlRuntime.GetChildrenArray(xml, nameWithNS) |> Array.map f.Invoke - - static member ConvertOptional<'R>(xml:XmlElement, nameWithNS, f:Func) = - XmlRuntime.GetChildOption(xml, nameWithNS) |> Option.map f.Invoke - - static member ConvertOptional2<'R>(xml:XmlElement, nameWithNS, f:Func) = - XmlRuntime.GetChildOption(xml, nameWithNS) |> Option.bind f.Invoke - - /// Returns Some if the specified XmlElement has the specified name - /// (otherwise None is returned). This is used when the current element - /// can be one of multiple elements. - static member ConvertAsName<'R>(xml:XmlElement, nameWithNS, f:Func) = - if xml.XElement.Name = XName.Get(nameWithNS) then Some(f.Invoke xml) - else None - - /// Returns the contents of the element as a JsonValue - static member GetJsonValue(xml) = - match XmlRuntime.TryGetValue(xml) with - | Some jsonStr -> JsonDocument.Create(new StringReader(jsonStr)) - | None -> failwithf "XML mismatch: Element doesn't contain value: %A" xml - - /// Tries to return the contents of the element as a JsonValue - static member TryGetJsonValue(xml) = - match XmlRuntime.TryGetValue(xml) with - | Some jsonStr -> - try - JsonDocument.Create(new StringReader(jsonStr)) |> Some - with _ -> None - | None -> None - - /// Creates a XElement with a scalar value and wraps it in a XmlElement - static member CreateValue(nameWithNS, value:obj, cultureStr) = - XmlRuntime.CreateRecord(nameWithNS, [| |], [| "", value |], cultureStr) - - // Creates a XElement with the given attributes and elements and wraps it in a XmlElement - static member CreateRecord(nameWithNS, attributes:_[], elements:_[], cultureStr) = - let cultureInfo = TextRuntime.GetCulture cultureStr - let toXmlContent (v:obj) = - let inline strWithCulture v = - (^a : (member ToString : IFormatProvider -> string) (v, cultureInfo)) - let serialize (v:obj) = - match v with - | :? XmlElement as v -> - let xElement = - if v.XElement.Parent = null then - v.XElement - else - // clone, as element is connected to previous parent - XElement(v.XElement) - box xElement - | _ -> - match v with - | :? string as v -> v - | :? DateTime as v -> - if v.TimeOfDay = TimeSpan.Zero - then v.ToString("yyyy-MM-dd") - else v.ToString("O", cultureInfo) - | :? DateTimeOffset as v -> v.ToString("O", cultureInfo) - | :? TimeSpan as v -> v.ToString("g", cultureInfo) - | :? int as v -> strWithCulture v - | :? int64 as v -> strWithCulture v - | :? float as v -> strWithCulture v - | :? decimal as v -> strWithCulture v - | :? bool as v -> if v then "true" else "false" - | :? Guid as v -> v.ToString() - | :? IJsonDocument as v -> v.JsonValue.ToString() - | _ -> failwithf "Unexpected value: %A" v - |> box - let inline optionToArray f = function Some x -> [| f x |] | None -> [| |] - match v with - | :? Array as v -> [| for elem in v -> serialize elem |] - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | :? option as v -> optionToArray serialize v - | v -> [| box (serialize v) |] - let createElement (parent:XElement) (nameWithNS:string) = +type XmlRuntime = + + // Operations for getting node values and values of attributes + + static member TryGetValue(xml: XmlElement) = + if String.IsNullOrEmpty(xml.XElement.Value) then + None + else + Some xml.XElement.Value + + static member TryGetAttribute(xml: XmlElement, nameWithNS) = + let attr = xml.XElement.Attribute(XName.Get(nameWithNS)) + if attr = null then None else Some attr.Value + + // Operations that obtain children - depending on the inference, we may + // want to get an array, option (if it may or may not be there) or + // just the value (if we think it is always there) + + static member private GetChildrenArray(value: XmlElement, nameWithNS: string) = let namesWithNS = nameWithNS.Split '|' - (parent, namesWithNS) - ||> Array.fold (fun parent nameWithNS -> - let xname = XName.Get nameWithNS - if parent = null then - XElement xname - else - let element = if nameWithNS = Seq.last namesWithNS - then null - else parent.Element(xname) - if element = null then - let element = XElement xname - parent.Add element - element + let mutable current = value.XElement + + for i = 0 to namesWithNS.Length - 2 do + if current <> null then + current <- current.Element(XName.Get namesWithNS.[i]) + + let value = current + + if value = null then + [||] + else + [| for c in value.Elements(XName.Get namesWithNS.[namesWithNS.Length - 1]) -> { XElement = c } |] + + static member private GetChildOption(value: XmlElement, nameWithNS) = + match XmlRuntime.GetChildrenArray(value, nameWithNS) with + | [| it |] -> Some it + | [||] -> None + | array -> failwithf "XML mismatch: Expected zero or one '%s' child, got %d" nameWithNS array.Length + + static member GetChild(value: XmlElement, nameWithNS) = + match XmlRuntime.GetChildrenArray(value, nameWithNS) with + | [| it |] -> it + | array -> failwithf "XML mismatch: Expected exactly one '%s' child, got %d" nameWithNS array.Length + + // Functions that transform specified chidlrens using a transformation + // function - we need a version for array and option + // (This is used e.g. when transforming `12` to `int[]`) + + static member ConvertArray<'R>(xml: XmlElement, nameWithNS, f: Func) : 'R[] = + XmlRuntime.GetChildrenArray(xml, nameWithNS) + |> Array.map f.Invoke + + static member ConvertOptional<'R>(xml: XmlElement, nameWithNS, f: Func) = + XmlRuntime.GetChildOption(xml, nameWithNS) + |> Option.map f.Invoke + + static member ConvertOptional2<'R>(xml: XmlElement, nameWithNS, f: Func) = + XmlRuntime.GetChildOption(xml, nameWithNS) + |> Option.bind f.Invoke + + /// Returns Some if the specified XmlElement has the specified name + /// (otherwise None is returned). This is used when the current element + /// can be one of multiple elements. + static member ConvertAsName<'R>(xml: XmlElement, nameWithNS, f: Func) = + if xml.XElement.Name = XName.Get(nameWithNS) then + Some(f.Invoke xml) + else + None + + /// Returns the contents of the element as a JsonValue + static member GetJsonValue(xml) = + match XmlRuntime.TryGetValue(xml) with + | Some jsonStr -> JsonDocument.Create(new StringReader(jsonStr)) + | None -> failwithf "XML mismatch: Element doesn't contain value: %A" xml + + /// Tries to return the contents of the element as a JsonValue + static member TryGetJsonValue(xml) = + match XmlRuntime.TryGetValue(xml) with + | Some jsonStr -> + try + JsonDocument.Create(new StringReader(jsonStr)) + |> Some + with _ -> + None + | None -> None + + /// Creates a XElement with a scalar value and wraps it in a XmlElement + static member CreateValue(nameWithNS, value: obj, cultureStr) = + XmlRuntime.CreateRecord(nameWithNS, [||], [| "", value |], cultureStr) + + // Creates a XElement with the given attributes and elements and wraps it in a XmlElement + static member CreateRecord(nameWithNS, attributes: _[], elements: _[], cultureStr) = + let cultureInfo = TextRuntime.GetCulture cultureStr + + let toXmlContent (v: obj) = + let inline strWithCulture v = + (^a: (member ToString: IFormatProvider -> string) (v, cultureInfo)) + + let serialize (v: obj) = + match v with + | :? XmlElement as v -> + let xElement = + if v.XElement.Parent = null then + v.XElement + else + // clone, as element is connected to previous parent + XElement(v.XElement) + + box xElement + | _ -> + match v with + | :? string as v -> v + | :? DateTime as v -> + if v.TimeOfDay = TimeSpan.Zero then + v.ToString("yyyy-MM-dd") + else + v.ToString("O", cultureInfo) + | :? DateTimeOffset as v -> v.ToString("O", cultureInfo) + | :? TimeSpan as v -> v.ToString("g", cultureInfo) + | :? int as v -> strWithCulture v + | :? int64 as v -> strWithCulture v + | :? float as v -> strWithCulture v + | :? decimal as v -> strWithCulture v + | :? bool as v -> if v then "true" else "false" + | :? Guid as v -> v.ToString() + | :? IJsonDocument as v -> v.JsonValue.ToString() + | _ -> failwithf "Unexpected value: %A" v + |> box + + let inline optionToArray f = + function + | Some x -> [| f x |] + | None -> [||] + + match v with + | :? Array as v -> [| for elem in v -> serialize elem |] + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | :? option as v -> optionToArray serialize v + | v -> [| box (serialize v) |] + + let createElement (parent: XElement) (nameWithNS: string) = + let namesWithNS = nameWithNS.Split '|' + + (parent, namesWithNS) + ||> Array.fold (fun parent nameWithNS -> + let xname = XName.Get nameWithNS + + if parent = null then + XElement xname else - element) - let element = createElement null nameWithNS - for nameWithNS, value in attributes do - let xname = XName.Get nameWithNS - match toXmlContent value with - | [| |] -> () - | [| v |] when v :? string && element.Attribute(xname) = null -> element.SetAttributeValue(xname, v) - | _ -> failwithf "Unexpected attribute value: %A" value - let parents = System.Collections.Generic.Dictionary() - for nameWithNS, value in elements do - if nameWithNS = "" then // it's the value + let element = + if nameWithNS = Seq.last namesWithNS then + null + else + parent.Element(xname) + + if element = null then + let element = XElement xname + parent.Add element + element + else + element) + + let element = createElement null nameWithNS + + for nameWithNS, value in attributes do + let xname = XName.Get nameWithNS + match toXmlContent value with - | [| |] -> () - | [| v |] when v :? string && element.Value = "" -> element.Add v - | _ -> failwithf "Unexpected content value: %A" value - else - for value in toXmlContent value do - match value with - | :? XElement as v -> - let parentNames = nameWithNS.Split('|') |> Array.rev - if v.Name.ToString() <> parentNames.[0] then - failwithf "Unexpected element: %O" v - let v = - (v, Seq.skip 1 parentNames |> Seq.mapi (fun x i -> x, i)) - ||> Seq.fold (fun element ((_, nameWithNS) as key) -> - if element.Parent = null then - let parent = - match parents.TryGetValue key with - | true, parent -> parent - | false, _ -> - let parent = createElement null nameWithNS - parents.Add(key, parent) - parent - parent.Add element - parent - else - if element.Parent.Name.ToString() <> nameWithNS then - failwithf "Unexpected element: %O" v - element.Parent) - if v.Parent = null then - element.Add v - | :? string as v -> - let child = createElement element nameWithNS - child.Value <- v - | _ -> failwithf "Unexpected content for child %s: %A" nameWithNS value - XmlElement.Create element + | [||] -> () + | [| v |] when v :? string && element.Attribute(xname) = null -> element.SetAttributeValue(xname, v) + | _ -> failwithf "Unexpected attribute value: %A" value + + let parents = System.Collections.Generic.Dictionary() + + for nameWithNS, value in elements do + if nameWithNS = "" then // it's the value + match toXmlContent value with + | [||] -> () + | [| v |] when v :? string && element.Value = "" -> element.Add v + | _ -> failwithf "Unexpected content value: %A" value + else + for value in toXmlContent value do + match value with + | :? XElement as v -> + let parentNames = nameWithNS.Split('|') |> Array.rev + + if v.Name.ToString() <> parentNames.[0] then + failwithf "Unexpected element: %O" v + + let v = + (v, + Seq.skip 1 parentNames + |> Seq.mapi (fun x i -> x, i)) + ||> Seq.fold (fun element ((_, nameWithNS) as key) -> + if element.Parent = null then + let parent = + match parents.TryGetValue key with + | true, parent -> parent + | false, _ -> + let parent = createElement null nameWithNS + parents.Add(key, parent) + parent + + parent.Add element + parent + else + if element.Parent.Name.ToString() <> nameWithNS then + failwithf "Unexpected element: %O" v + + element.Parent) + + if v.Parent = null then element.Add v + | :? string as v -> + let child = createElement element nameWithNS + child.Value <- v + | _ -> failwithf "Unexpected content for child %s: %A" nameWithNS value + + XmlElement.Create element module XmlSchema = open System.Xml open System.Xml.Schema + /// A custom XmlResolver is needed for included files because we get the contents of the main file /// directly as a string from the FSharp.Data infrastructure. Hence the default XmlResolver is not /// able to find the location of included schema files. type ResolutionFolderResolver(resolutionFolder: string) = inherit XmlUrlResolver() - let cache = Caching.createInternetFileCache "XmlSchema" (System.TimeSpan.FromMinutes 30.0) + let cache = + Caching.createInternetFileCache "XmlSchema" (System.TimeSpan.FromMinutes 30.0) let uri = // Uri must end with separator (maybe there's a better way) - if resolutionFolder = "" then "" - elif resolutionFolder.EndsWith "/" || resolutionFolder.EndsWith "\\" - then resolutionFolder - else resolutionFolder + "/" + if resolutionFolder = "" then + "" + elif resolutionFolder.EndsWith "/" + || resolutionFolder.EndsWith "\\" then + resolutionFolder + else + resolutionFolder + "/" let useResolutionFolder (baseUri: System.Uri) = - resolutionFolder <> "" && (baseUri = null || baseUri.OriginalString = "") + resolutionFolder <> "" + && (baseUri = null || baseUri.OriginalString = "") let getEncoding xmlText = // peek encoding definition let settings = XmlReaderSettings(ConformanceLevel = ConformanceLevel.Fragment) use reader = XmlReader.Create(new System.IO.StringReader(xmlText), settings) - if reader.Read() && reader.NodeType = XmlNodeType.XmlDeclaration - then + + if reader.Read() + && reader.NodeType = XmlNodeType.XmlDeclaration then match reader.GetAttribute "encoding" with | null -> System.Text.Encoding.UTF8 | attr -> System.Text.Encoding.GetEncoding attr - else System.Text.Encoding.UTF8 + else + System.Text.Encoding.UTF8 override _this.ResolveUri(baseUri, relativeUri) = let u = System.Uri(relativeUri, System.UriKind.RelativeOrAbsolute) - if u.IsAbsoluteUri && (not <| u.IsFile) - then base.ResolveUri(baseUri, relativeUri) - elif useResolutionFolder baseUri - then base.ResolveUri(System.Uri uri, relativeUri) - else base.ResolveUri(baseUri, relativeUri) + + if u.IsAbsoluteUri && (not <| u.IsFile) then + base.ResolveUri(baseUri, relativeUri) + elif useResolutionFolder baseUri then + base.ResolveUri(System.Uri uri, relativeUri) + else + base.ResolveUri(baseUri, relativeUri) override _this.GetEntity(absoluteUri, role, ofObjectToReturn) = - if IO.isWeb absoluteUri - then + if IO.isWeb absoluteUri then let uri = absoluteUri.OriginalString + match cache.TryRetrieve(uri) with | Some value -> value | None -> @@ -359,12 +453,17 @@ module XmlSchema = // instead of going back and forth from bytes to text let bytes = getEncoding(value).GetBytes value new System.IO.MemoryStream(bytes) :> obj - else base.GetEntity(absoluteUri, role, ofObjectToReturn) + else + base.GetEntity(absoluteUri, role, ofObjectToReturn) + + + let parseSchemaFromTextReader resolutionFolder (textReader: TextReader) = + let schemaSet = + XmlSchemaSet(XmlResolver = ResolutionFolderResolver resolutionFolder) + let readerSettings = + XmlReaderSettings(CloseInput = true, DtdProcessing = DtdProcessing.Ignore) - let parseSchemaFromTextReader resolutionFolder (textReader:TextReader) = - let schemaSet = XmlSchemaSet(XmlResolver = ResolutionFolderResolver resolutionFolder) - let readerSettings = XmlReaderSettings(CloseInput = true, DtdProcessing = DtdProcessing.Ignore) use reader = XmlReader.Create(textReader, readerSettings) schemaSet.Add(null, reader) |> ignore schemaSet.Compile() diff --git a/src/Xml/XsdInference.fs b/src/Xml/XsdInference.fs index 44c955b88..5126b1e42 100644 --- a/src/Xml/XsdInference.fs +++ b/src/Xml/XsdInference.fs @@ -28,26 +28,31 @@ module XsdModel = // reference equality and mutable type allow for cycles [] - type XsdElement = { Name: XmlQualifiedName - mutable Type: XsdType - SubstitutionGroup: XsdElement list - IsAbstract: bool - IsNillable: bool } + type XsdElement = + { Name: XmlQualifiedName + mutable Type: XsdType + SubstitutionGroup: XsdElement list + IsAbstract: bool + IsNillable: bool } - and XsdType = SimpleType of XmlTypeCode | ComplexType of XsdComplexType + and XsdType = + | SimpleType of XmlTypeCode + | ComplexType of XsdComplexType and [] XsdComplexType = { Attributes: (XmlQualifiedName * XmlTypeCode * IsOptional) list Contents: XsdContent } - and XsdContent = SimpleContent of XmlTypeCode | ComplexContent of XsdParticle + and XsdContent = + | SimpleContent of XmlTypeCode + | ComplexContent of XsdParticle and XsdParticle = | Empty - | Any of Occurs - | Element of Occurs * XsdElement - | All of Occurs * XsdParticle list - | Choice of Occurs * XsdParticle list + | Any of Occurs + | Element of Occurs * XsdElement + | All of Occurs * XsdParticle list + | Choice of Occurs * XsdParticle list | Sequence of Occurs * XsdParticle list /// A simplified schema model is built from xsd. @@ -79,10 +84,12 @@ module XsdParsing = // http://docstore.mik.ua/orelly/xml/schema/ch12_01.htm#xmlschema-CHP-12-SECT-1 let collectSubst elm = let items = System.Collections.Generic.HashSet() + let rec collect elm = if subst.ContainsKey elm then for x in subst.Item elm do if items.Add x then collect x + collect elm items |> List.ofSeq @@ -94,7 +101,8 @@ module XsdParsing = fun elm -> if subst'.ContainsKey elm then subst'.Item elm else [] - let elements = System.Collections.Generic.Dictionary() + let elements = + System.Collections.Generic.Dictionary() member x.GetElement name = getElm name member x.GetSubstitutions elm = getSubst elm @@ -104,36 +112,39 @@ module XsdParsing = open XsdModel let getTypeCode (xmlSchemaDatatype: XmlSchemaDatatype) = - if xmlSchemaDatatype.Variety = XmlSchemaDatatypeVariety.Atomic - then xmlSchemaDatatype.TypeCode - else XmlTypeCode.None // list and union not supported + if xmlSchemaDatatype.Variety = XmlSchemaDatatypeVariety.Atomic then + xmlSchemaDatatype.TypeCode + else + XmlTypeCode.None // list and union not supported let rec parseElement (ctx: ParsingContext) elm = match ctx.Elements.TryGetValue elm with | true, x -> x | _ -> - let substitutionGroup = - ctx.GetSubstitutions elm - |> List.filter (fun x -> x <> elm) - |> List.map (parseElement ctx) - // another attempt in case the element is put while parsing substitution groups - match ctx.Elements.TryGetValue elm with - | true, x -> x - | _ -> - let result = - { Name = elm.QualifiedName - Type = XsdType.SimpleType XmlTypeCode.None // temporary dummy value - SubstitutionGroup = substitutionGroup - IsAbstract = elm.IsAbstract - IsNillable = elm.IsNillable } - ctx.Elements.Add(elm, result) - // computing the real type after filling the dictionary allows for cycles - result.Type <- - match elm.ElementSchemaType with - | :? XmlSchemaSimpleType as x -> SimpleType (getTypeCode x.Datatype) - | :? XmlSchemaComplexType as x -> ComplexType (parseComplexType ctx x) - | x -> failwithf "unknown ElementSchemaType: %A" x - result + let substitutionGroup = + ctx.GetSubstitutions elm + |> List.filter (fun x -> x <> elm) + |> List.map (parseElement ctx) + // another attempt in case the element is put while parsing substitution groups + match ctx.Elements.TryGetValue elm with + | true, x -> x + | _ -> + let result = + { Name = elm.QualifiedName + Type = XsdType.SimpleType XmlTypeCode.None // temporary dummy value + SubstitutionGroup = substitutionGroup + IsAbstract = elm.IsAbstract + IsNillable = elm.IsNillable } + + ctx.Elements.Add(elm, result) + // computing the real type after filling the dictionary allows for cycles + result.Type <- + match elm.ElementSchemaType with + | :? XmlSchemaSimpleType as x -> SimpleType(getTypeCode x.Datatype) + | :? XmlSchemaComplexType as x -> ComplexType(parseComplexType ctx x) + | x -> failwithf "unknown ElementSchemaType: %A" x + + result and parseComplexType ctx (x: XmlSchemaComplexType) = { Attributes = @@ -141,17 +152,17 @@ module XsdParsing = |> ofType |> Seq.filter (fun a -> a.Use <> XmlSchemaUse.Prohibited) |> Seq.map (fun a -> - a.QualifiedName, - getTypeCode a.AttributeSchemaType.Datatype, - a.Use <> XmlSchemaUse.Required) + a.QualifiedName, getTypeCode a.AttributeSchemaType.Datatype, a.Use <> XmlSchemaUse.Required) |> List.ofSeq Contents = match x.ContentType with - | XmlSchemaContentType.TextOnly -> SimpleContent (getTypeCode x.Datatype) + | XmlSchemaContentType.TextOnly -> SimpleContent(getTypeCode x.Datatype) | XmlSchemaContentType.Mixed | XmlSchemaContentType.Empty | XmlSchemaContentType.ElementOnly -> - x.ContentTypeParticle |> parseParticle ctx |> ComplexContent + x.ContentTypeParticle + |> parseParticle ctx + |> ComplexContent | _ -> failwithf "Unknown content type: %A." x.ContentType } @@ -165,10 +176,11 @@ module XsdParsing = |> ofType |> Seq.map (parseParticle ctx) |> List.ofSeq + match group with - | :? XmlSchemaAll -> All (occurs, particles) - | :? XmlSchemaChoice -> Choice (occurs, particles) - | :? XmlSchemaSequence -> Sequence (occurs, particles) + | :? XmlSchemaAll -> All(occurs, particles) + | :? XmlSchemaChoice -> Choice(occurs, particles) + | :? XmlSchemaSequence -> Sequence(occurs, particles) | _ -> failwithf "unknown group base: %A" group match par with @@ -176,16 +188,22 @@ module XsdParsing = | :? XmlSchemaGroupBase as grp -> parseParticles grp | :? XmlSchemaGroupRef as grpRef -> parseParticle ctx grpRef.Particle | :? XmlSchemaElement as elm -> - let e = if elm.RefName.IsEmpty then elm else ctx.GetElement elm.RefName - Element (occurs, parseElement ctx e) + let e = + if elm.RefName.IsEmpty then + elm + else + ctx.GetElement elm.RefName + + Element(occurs, parseElement ctx e) | _ -> Empty // XmlSchemaParticle.EmptyParticle let getElements schema = let ctx = ParsingContext schema + schema.GlobalElements.Values |> ofType - |> Seq.filter (fun x -> x.ElementSchemaType :? XmlSchemaComplexType ) + |> Seq.filter (fun x -> x.ElementSchemaType :? XmlSchemaComplexType) |> Seq.map (parseElement ctx) @@ -195,7 +213,8 @@ module XsdInference = open FSharp.Data.Runtime.StructuralTypes // for now we map only the types supported - let getType = function + let getType = + function | XmlTypeCode.Int -> typeof | XmlTypeCode.Long -> typeof | XmlTypeCode.Date -> typeof @@ -206,52 +225,65 @@ module XsdInference = // fallback to string | _ -> typeof - let getMultiplicity = function + let getMultiplicity = + function | 1M, 1M -> Single | 0M, 1M -> OptionalSingle | _ -> Multiple // how multiplicity is affected when nesting particles - let combineMultiplicity = function + let combineMultiplicity = + function | Single, x -> x | Multiple, _ -> Multiple | _, Multiple -> Multiple | OptionalSingle, _ -> OptionalSingle // the effect of a choice is to make mandatory items optional - let makeOptional = function Single -> OptionalSingle | x -> x + let makeOptional = + function + | Single -> OptionalSingle + | x -> x let formatName (qName: XmlQualifiedName) = - if qName.Namespace = "" then qName.Name else - sprintf "{%s}%s" qName.Namespace qName.Name + if qName.Namespace = "" then + qName.Name + else + sprintf "{%s}%s" qName.Namespace qName.Name - let getElementName (elm: XsdElement) = Some (formatName elm.Name) + let getElementName (elm: XsdElement) = Some(formatName elm.Name) - let nil = { InferedProperty.Name = "{http://www.w3.org/2001/XMLSchema-instance}nil" - Type = InferedType.Primitive(typeof, None, true) } + let nil = + { InferedProperty.Name = "{http://www.w3.org/2001/XMLSchema-instance}nil" + Type = InferedType.Primitive(typeof, None, true) } type InferenceContext = System.Collections.Generic.Dictionary // derives an InferedType for an element definition let rec inferElementType ctx elm = let name = getElementName elm - if elm.IsAbstract - then InferedType.Record(name, [], optional = false) + + if elm.IsAbstract then + InferedType.Record(name, [], optional = false) 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) let prop = { InferedProperty.Name = ""; Type = ty } - let props = if elm.IsNillable then [prop; nil] else [prop] + let props = if elm.IsNillable then [ prop; nil ] else [ prop ] InferedType.Record(name, props, optional = false) | ComplexType cty -> let props = inferProperties ctx cty + let props = if elm.IsNillable then for prop in props do prop.Type <- prop.Type.EnsuresHandlesMissingValues false - nil::props - else props + + nil :: props + else + props + InferedType.Record(name, props, optional = false) @@ -260,49 +292,68 @@ 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) }) match cty.Contents with | SimpleContent typeCode -> - let body = { InferedProperty.Name = "" - Type = InferedType.Primitive (getType typeCode, None, false)} - body::attrs + let body = + { InferedProperty.Name = "" + Type = InferedType.Primitive(getType typeCode, None, false) } + + body :: attrs | ComplexContent xsdParticle -> let body = - if ctx.ContainsKey cty then ctx.Item cty else - let result = { InferedProperty.Name = ""; Type = InferedType.Top } - ctx.Add(cty, result) - let getRecordTag (e:XsdElement) = InferedTypeTag.Record(getElementName e) - result.Type <- - match getElements ctx Single xsdParticle with - | [] -> InferedType.Null - | items -> - let tags = items |> List.map (fst >> getRecordTag) - let types = - items - |> List.map (fun (e, m) -> m, inferElementType ctx e) - |> Seq.zip tags - |> Map.ofSeq - InferedType.Collection(tags, types) - result - if body.Type = InferedType.Null then attrs else body::attrs + if ctx.ContainsKey cty then + ctx.Item cty + else + let result = + { InferedProperty.Name = "" + Type = InferedType.Top } + + ctx.Add(cty, result) + let getRecordTag (e: XsdElement) = InferedTypeTag.Record(getElementName e) + + result.Type <- + match getElements ctx Single xsdParticle with + | [] -> InferedType.Null + | items -> + let tags = items |> List.map (fst >> getRecordTag) + + let types = + items + |> List.map (fun (e, m) -> m, inferElementType ctx e) + |> Seq.zip tags + |> Map.ofSeq + + InferedType.Collection(tags, types) + + result + + if body.Type = InferedType.Null then + attrs + else + body :: attrs // collects element definitions in a particle - and getElements ctx parentMultiplicity = function - | XsdParticle.Element(occ, elm) -> - let mult = combineMultiplicity(parentMultiplicity, getMultiplicity occ) + and getElements ctx parentMultiplicity = + function + | XsdParticle.Element (occ, elm) -> + let mult = combineMultiplicity (parentMultiplicity, getMultiplicity occ) + match elm.IsAbstract, elm.SubstitutionGroup with | _, [] -> [ (elm, mult) ] - | true, [x] -> [ (x, mult) ] - | true, x -> x |> List.map (fun e -> e, makeOptional mult) - | false, x -> elm::x |> List.map (fun e -> e, makeOptional mult) + | true, [ x ] -> [ (x, mult) ] + | true, x -> x |> List.map (fun e -> e, makeOptional mult) + | false, x -> + elm :: x + |> List.map (fun e -> e, makeOptional mult) | XsdParticle.Sequence (occ, particles) | XsdParticle.All (occ, particles) -> - let mult = combineMultiplicity(parentMultiplicity, getMultiplicity occ) + let mult = combineMultiplicity (parentMultiplicity, getMultiplicity occ) particles |> List.collect (getElements ctx mult) | XsdParticle.Choice (occ, particles) -> let mult = makeOptional (getMultiplicity occ) - let mult' = combineMultiplicity(parentMultiplicity, mult) + let mult' = combineMultiplicity (parentMultiplicity, mult) particles |> List.collect (getElements ctx mult') | XsdParticle.Empty -> [] | XsdParticle.Any _ -> [] @@ -310,12 +361,14 @@ module XsdInference = let inferElements elms = let ctx = InferenceContext() - match elms |> List.filter (fun elm -> not elm.IsAbstract) with + + match elms + |> List.filter (fun elm -> not elm.IsAbstract) + with | [] -> failwith "No suitable element definition found in the schema." - | [elm] -> inferElementType ctx elm + | [ elm ] -> inferElementType ctx elm | elms -> elms - |> List.map (fun elm -> - InferedTypeTag.Record (getElementName elm), inferElementType ctx elm) + |> List.map (fun elm -> InferedTypeTag.Record(getElementName elm), inferElementType ctx elm) |> Map.ofList |> InferedType.Heterogeneous