diff --git a/FSharp.Data.sln b/FSharp.Data.sln index 292580c60..d01699fc3 100755 --- a/FSharp.Data.sln +++ b/FSharp.Data.sln @@ -52,6 +52,10 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Data.Csv.Core", "src EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Data.WorldBank.Core", "src\FSharp.Data.WorldBank.Core\FSharp.Data.WorldBank.Core.fsproj", "{A69D007B-EAF0-4866-A8B4-A2EDF2614E56}" EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Data.Toml.Core", "src\FSharp.Data.Toml.Core\FSharp.Data.Toml.Core.fsproj", "{B1C2D3E4-F5A6-7890-BCDE-F01234567890}" +EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Data.Toml.Core.Tests", "tests\FSharp.Data.Toml.Core.Tests\FSharp.Data.Toml.Core.Tests.fsproj", "{A74DA8FF-2162-46D1-ACDA-AA3A51546685}" +EndProject Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "docs", "docs", "{8C038DD5-FB03-4E6D-B8F2-D66AE2E6DCC9}" ProjectSection(SolutionItems) = preProject docs\index.md = docs\index.md @@ -156,6 +160,14 @@ Global {A69D007B-EAF0-4866-A8B4-A2EDF2614E56}.Debug|Any CPU.Build.0 = Debug|Any CPU {A69D007B-EAF0-4866-A8B4-A2EDF2614E56}.Release|Any CPU.ActiveCfg = Release|Any CPU {A69D007B-EAF0-4866-A8B4-A2EDF2614E56}.Release|Any CPU.Build.0 = Release|Any CPU + {B1C2D3E4-F5A6-7890-BCDE-F01234567890}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {B1C2D3E4-F5A6-7890-BCDE-F01234567890}.Debug|Any CPU.Build.0 = Debug|Any CPU + {B1C2D3E4-F5A6-7890-BCDE-F01234567890}.Release|Any CPU.ActiveCfg = Release|Any CPU + {B1C2D3E4-F5A6-7890-BCDE-F01234567890}.Release|Any CPU.Build.0 = Release|Any CPU + {A74DA8FF-2162-46D1-ACDA-AA3A51546685}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {A74DA8FF-2162-46D1-ACDA-AA3A51546685}.Debug|Any CPU.Build.0 = Debug|Any CPU + {A74DA8FF-2162-46D1-ACDA-AA3A51546685}.Release|Any CPU.ActiveCfg = Release|Any CPU + {A74DA8FF-2162-46D1-ACDA-AA3A51546685}.Release|Any CPU.Build.0 = Release|Any CPU {D04AFA70-4A59-4E1C-AC41-BA0EA70140FF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {D04AFA70-4A59-4E1C-AC41-BA0EA70140FF}.Debug|Any CPU.Build.0 = Debug|Any CPU {D04AFA70-4A59-4E1C-AC41-BA0EA70140FF}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -174,6 +186,7 @@ Global {A5B31ACC-56FB-4EC2-917F-BEB3754EF9AC} = {1F33D53A-C007-408C-AF6C-B7D62288F941} {290FED0C-D7C8-486F-AACF-3D7A1304C863} = {1F33D53A-C007-408C-AF6C-B7D62288F941} {750148EC-6A05-421D-96A4-E5AC9D18AF58} = {1F33D53A-C007-408C-AF6C-B7D62288F941} + {A74DA8FF-2162-46D1-ACDA-AA3A51546685} = {1F33D53A-C007-408C-AF6C-B7D62288F941} {660DBCC8-F7F2-4301-A611-A2F2C97E369D} = {8C038DD5-FB03-4E6D-B8F2-D66AE2E6DCC9} {E399369F-268F-4411-84CD-B868F9FE52EF} = {8C038DD5-FB03-4E6D-B8F2-D66AE2E6DCC9} {0203D290-11AA-48DB-B1E6-156DFDCEEF80} = {8C038DD5-FB03-4E6D-B8F2-D66AE2E6DCC9} diff --git a/paket.lock b/paket.lock index c28241431..24ceeb14e 100644 --- a/paket.lock +++ b/paket.lock @@ -24,9 +24,9 @@ NUGET NETStandard.Library.NETFramework (2.0.0-preview2-25405-01) GITHUB remote: fsprojects/FSharp.TypeProviders.SDK - src/ProvidedTypes.fs (ce34c1cc71096857b8342f1dedf93391addc9df6) - src/ProvidedTypes.fsi (ce34c1cc71096857b8342f1dedf93391addc9df6) - tests/ProvidedTypesTesting.fs (ce34c1cc71096857b8342f1dedf93391addc9df6) + src/ProvidedTypes.fs (ec4d4522cf4a2a7cd4f4d166ff053e6617dcf1c6) + src/ProvidedTypes.fsi (ec4d4522cf4a2a7cd4f4d166ff053e6617dcf1c6) + tests/ProvidedTypesTesting.fs (ec4d4522cf4a2a7cd4f4d166ff053e6617dcf1c6) GROUP Benchmarks RESTRICTION: == net8.0 NUGET diff --git a/src/AssemblyInfo.Toml.Core.fs b/src/AssemblyInfo.Toml.Core.fs new file mode 100644 index 000000000..db65083dd --- /dev/null +++ b/src/AssemblyInfo.Toml.Core.fs @@ -0,0 +1,27 @@ +// Auto-Generated by FAKE; do not edit +namespace System + +open System.Reflection + +[] +[] +[] +[] +[] +do () + +module internal AssemblyVersionInformation = + [] + let AssemblyTitle = "FSharp.Data.Toml.Core" + + [] + let AssemblyProduct = "FSharp.Data" + + [] + let AssemblyDescription = "Library of F# type providers and data access tools" + + [] + let AssemblyVersion = "6.6.0.0" + + [] + let AssemblyFileVersion = "6.6.0.0" diff --git a/src/FSharp.Data.DesignTime/FSharp.Data.DesignTime.fsproj b/src/FSharp.Data.DesignTime/FSharp.Data.DesignTime.fsproj index 0d698e53f..2c2e66f5b 100755 --- a/src/FSharp.Data.DesignTime/FSharp.Data.DesignTime.fsproj +++ b/src/FSharp.Data.DesignTime/FSharp.Data.DesignTime.fsproj @@ -32,6 +32,7 @@ + @@ -42,6 +43,7 @@ + diff --git a/src/FSharp.Data.DesignTime/Toml/TomlProvider.fs b/src/FSharp.Data.DesignTime/Toml/TomlProvider.fs new file mode 100644 index 000000000..922a40885 --- /dev/null +++ b/src/FSharp.Data.DesignTime/Toml/TomlProvider.fs @@ -0,0 +1,143 @@ +namespace ProviderImplementation + +open System +open System.IO +open FSharp.Core.CompilerServices +open ProviderImplementation +open ProviderImplementation.ProvidedTypes +open ProviderImplementation.ProviderHelpers +open FSharp.Data +open FSharp.Data.Runtime +open FSharp.Data.Runtime.BaseTypes +open FSharp.Data.Runtime.StructuralTypes +open FSharp.Data.Runtime.StructuralInference +open System.Net + +// ---------------------------------------------------------------------------------------------- + +#nowarn "10001" + +[] +type public TomlProvider(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 tomlProvTy = + ProvidedTypeDefinition(asm, ns, "TomlProvider", None, hideObjectMethods = true, nonNullable = true) + + let buildTypes (typeName: string) (args: obj[]) = + + // Enable TLS 1.2 for samples requested through https. + ServicePointManager.SecurityProtocol <- ServicePointManager.SecurityProtocol ||| SecurityProtocolType.Tls12 + + let tpType = + ProvidedTypeDefinition(asm, ns, typeName, None, hideObjectMethods = true, nonNullable = true) + + let sample = args.[0] :?> string + let rootName = args.[1] :?> string + + let rootName = + if String.IsNullOrWhiteSpace rootName then + "Root" + else + NameUtils.singularize rootName + + let cultureStr = args.[2] :?> string + let encodingStr = args.[3] :?> string + let resolutionFolder = args.[4] :?> string + let resource = args.[5] :?> string + let inferenceMode = args.[6] :?> InferenceMode + let preferDateOnly = args.[7] :?> bool + let useOriginalNames = args.[8] :?> bool + + let inferenceMode' = InferenceMode'.FromPublicApi(inferenceMode, true) + let cultureInfo = TextRuntime.GetCulture cultureStr + let unitsOfMeasureProvider = ProviderHelpers.unitsOfMeasureProvider + + let getSpec _ value = + + let tomlValue = + use _holder = IO.logTime "Parsing" sample + TomlValue.Parse(value) + + let sampleJson = tomlValue.ToJsonValue() + + let inferedType = + use _holder = IO.logTime "Inference" sample + + let rawInfered = + JsonInference.inferType unitsOfMeasureProvider inferenceMode' cultureInfo true "" sampleJson + +#if NET6_0_OR_GREATER + if preferDateOnly && ProviderHelpers.runtimeSupportsNet6Types cfg.RuntimeAssembly then + rawInfered + else + StructuralInference.downgradeNet6Types rawInfered +#else + rawInfered +#endif + + use _holder = IO.logTime "TypeGeneration" sample + + let ctx = + JsonGenerationContext.Create( + cultureStr, + tpType, + unitsOfMeasureProvider, + inferenceMode', + ?useOriginalNames = Some useOriginalNames + ) + + let result = JsonTypeBuilder.generateJsonType ctx false false rootName inferedType + + { GeneratedType = tpType + RepresentationType = result.ConvertedType + CreateFromTextReader = fun reader -> result.Convert <@@ TomlDocument.Create(%reader) @@> + CreateListFromTextReader = None + CreateFromTextReaderForSampleList = fun reader -> result.Convert <@@ TomlDocument.Create(%reader) @@> + CreateFromValue = + Some(typeof, (fun value -> result.Convert <@@ JsonDocument.Create(%value, "") @@>)) } + + generateType "TOML" (Sample sample) getSpec this cfg encodingStr resolutionFolder resource typeName None + + let parameters = + [ ProvidedStaticParameter("Sample", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("RootName", typeof, parameterDefaultValue = "Root") + ProvidedStaticParameter("Culture", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("Encoding", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("ResolutionFolder", typeof, parameterDefaultValue = "") + ProvidedStaticParameter("EmbeddedResource", typeof, parameterDefaultValue = "") + ProvidedStaticParameter( + "InferenceMode", + typeof, + parameterDefaultValue = InferenceMode.BackwardCompatible + ) + ProvidedStaticParameter("PreferDateOnly", typeof, parameterDefaultValue = false) + ProvidedStaticParameter("UseOriginalNames", typeof, parameterDefaultValue = false) ] + + let helpText = + """Typed representation of a TOML document. + Location of a TOML sample file or a string containing a sample TOML document. + The name to be used for the root type. Defaults to Root. + The culture used for parsing numbers and dates. Defaults to the invariant culture. + The encoding used to read the sample. Defaults to UTF8 for files. + 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.toml'). This is useful when exposing types generated by the type provider. + Possible values: + | NoInference -> Inference is disabled. All values are inferred as the most basic type. + | ValuesOnly -> Types of values are inferred from the Sample (default). + | ValuesAndInlineSchemasHints -> Types are inferred from both values and inline schema hints. + | ValuesAndInlineSchemasOverrides -> Same as ValuesAndInlineSchemasHints, but value inferred types are ignored when an inline schema is present. + + When true on .NET 6+, date-only strings are inferred as DateOnly and time-only strings as TimeOnly. Defaults to false. + When true, TOML key names are used as-is for generated property names instead of being normalized to PascalCase. Defaults to false.""" + + do tomlProvTy.AddXmlDoc helpText + do tomlProvTy.DefineStaticParameters(parameters, buildTypes) + + do this.AddNamespace(ns, [ tomlProvTy ]) diff --git a/src/FSharp.Data.Toml.Core/FSharp.Data.Toml.Core.fsproj b/src/FSharp.Data.Toml.Core/FSharp.Data.Toml.Core.fsproj new file mode 100644 index 000000000..233eb72d5 --- /dev/null +++ b/src/FSharp.Data.Toml.Core/FSharp.Data.Toml.Core.fsproj @@ -0,0 +1,26 @@ + + + + Library + netstandard2.0;net8.0 + $(OtherFlags) --warnon:1182 --nowarn:10001 --nowarn:44 + true + false + logo.png + + true + + + + + + + + + + + + + + + diff --git a/src/FSharp.Data.Toml.Core/TomlDocument.fs b/src/FSharp.Data.Toml.Core/TomlDocument.fs new file mode 100644 index 000000000..a34276976 --- /dev/null +++ b/src/FSharp.Data.Toml.Core/TomlDocument.fs @@ -0,0 +1,67 @@ +// -------------------------------------------------------------------------------------- +// TOML type provider - runtime document type +// -------------------------------------------------------------------------------------- + +namespace FSharp.Data.Runtime.BaseTypes + +open System.ComponentModel +open System.IO +open FSharp.Data +open FSharp.Data.Runtime.BaseTypes + +#nowarn "10001" + +/// Underlying representation of types generated by TomlProvider +[] +type TomlDocument = + + private + { Toml: TomlValue + BackingJson: IJsonDocument } + + interface IJsonDocument with + member x.JsonValue = x.BackingJson.JsonValue + member x.Path() = x.BackingJson.Path() + + member x.CreateNew(value, pathIncrement) = + { Toml = x.Toml + BackingJson = x.BackingJson.CreateNew(value, pathIncrement) } + + /// The underlying TOML value + member x.TomlValue = x.Toml + + /// The JSON value backing this document (used by the type provider runtime) + member x.JsonValue = x.BackingJson.JsonValue + + /// + [] + [] + override x.ToString() = x.TomlValue.ToString() + + /// + [] + [] + static member Create(tomlValue: TomlValue, path: string) : IJsonDocument = + let jsonValue = tomlValue.ToJsonValue() + let backing = JsonDocument.Create(jsonValue, path) + + { Toml = tomlValue + BackingJson = backing } + + /// + [] + [] + static member Create(reader: TextReader) : IJsonDocument = + use reader = reader + let text = reader.ReadToEnd() + let tomlValue = TomlValue.Parse(text) + TomlDocument.Create(tomlValue, "") diff --git a/src/FSharp.Data.Toml.Core/TomlValue.fs b/src/FSharp.Data.Toml.Core/TomlValue.fs new file mode 100644 index 000000000..c87938ffb --- /dev/null +++ b/src/FSharp.Data.Toml.Core/TomlValue.fs @@ -0,0 +1,876 @@ +// -------------------------------------------------------------------------------------- +// TOML type provider - TOML value representation and parser +// -------------------------------------------------------------------------------------- + +namespace FSharp.Data + +open System +open System.IO +open System.Text +open System.Collections.Generic +open System.Globalization +open System.ComponentModel + +// -------------------------------------------------------------------------------------- +// TOML value type +// -------------------------------------------------------------------------------------- + +/// Represents a TOML value +[] +[] +type TomlValue = + | String of string + | Integer of int64 + | Float of float + | Boolean of bool + | OffsetDateTime of DateTimeOffset + | LocalDateTime of DateTime + | LocalDate of DateTime + | LocalTime of TimeSpan + | Array of TomlValue[] + | Table of (string * TomlValue)[] + + /// + [] + [] + member x._Print = + match x with + | String s -> sprintf "%A" s + | Integer i -> sprintf "%d" i + | Float f -> sprintf "%g" f + | Boolean b -> if b then "true" else "false" + | OffsetDateTime dt -> dt.ToString("o", CultureInfo.InvariantCulture) + | LocalDateTime dt -> dt.ToString("yyyy-MM-ddTHH:mm:ss", CultureInfo.InvariantCulture) + | LocalDate d -> d.ToString("yyyy-MM-dd", CultureInfo.InvariantCulture) + | LocalTime t -> sprintf "%02d:%02d:%02d" t.Hours t.Minutes t.Seconds + | Array arr -> sprintf "[%d items]" arr.Length + | Table props -> sprintf "{%d properties}" props.Length + + /// Convert this TOML value to a JSON value for type inference and runtime use. + /// TOML date/time values are serialized to ISO 8601 strings so that the + /// existing JSON inference can detect them as date types. + member x.ToJsonValue() : JsonValue = + match x with + | String s -> JsonValue.String s + | Integer i -> JsonValue.Number(decimal i) + | Float f -> JsonValue.Float f + | Boolean b -> JsonValue.Boolean b + | OffsetDateTime dt -> JsonValue.String(dt.ToString("o", CultureInfo.InvariantCulture)) + | LocalDateTime dt -> JsonValue.String(dt.ToString("yyyy-MM-ddTHH:mm:ss", CultureInfo.InvariantCulture)) + | LocalDate d -> JsonValue.String(d.ToString("yyyy-MM-dd", CultureInfo.InvariantCulture)) + | LocalTime t -> JsonValue.String(sprintf "%02d:%02d:%02d" t.Hours t.Minutes t.Seconds) + | Array arr -> JsonValue.Array(arr |> Array.map (fun v -> v.ToJsonValue())) + | Table props -> JsonValue.Record(props |> Array.map (fun (k, v) -> k, v.ToJsonValue())) + +// -------------------------------------------------------------------------------------- +// TOML parser (internal mutable representation during parsing) +// -------------------------------------------------------------------------------------- + +/// Mutable node used during parsing; converted to TomlValue at end +[] +type private MutableNode = + | Prim of TomlValue + | Tbl of OrderedTable * bool // bool = explicitly defined with [header] + | TblArray of ResizeArray + +and private OrderedTable() = + let keys = ResizeArray() + let dict = Dictionary() + + member _.TryGet(key: string) = + match dict.TryGetValue(key) with + | true, v -> Some v + | _ -> None + + member _.Set(key: string, value: MutableNode) = + if not (dict.ContainsKey(key)) then + keys.Add(key) + + dict.[key] <- value + + member _.ContainsKey(key: string) = dict.ContainsKey(key) + + member _.Keys = keys :> seq + + member x.ToTomlValue() : TomlValue = + let rec nodeToTomlValue (node: MutableNode) : TomlValue = + match node with + | Prim v -> v + | Tbl(t, _) -> t.ToTomlValue() + | TblArray arr -> TomlValue.Array [| for t in arr -> t.ToTomlValue() |] + + let props = [| for k in keys -> k, nodeToTomlValue dict.[k] |] + TomlValue.Table props + +// -------------------------------------------------------------------------------------- +// TOML Parser +// -------------------------------------------------------------------------------------- + +type private TomlParser(text: string) = + + let mutable pos = 0 + let len = text.Length + + let isAtEnd () = pos >= len + + let current () = + if pos < len then text.[pos] else '\000' + + let peek n = + if pos + n < len then text.[pos + n] else '\000' + + let advance () = pos <- pos + 1 + + let error msg = + let snippet = text.[(max 0 (pos - 15)) .. (min (len - 1) (pos + 15))] + + failwithf "TOML parse error at position %d: %s\n near: ...%s..." pos msg snippet + + // Skip horizontal whitespace (space, tab) + let skipHws () = + while pos < len && (text.[pos] = ' ' || text.[pos] = '\t') do + advance () + + // Skip a comment (# to end of line) + let skipComment () = + if pos < len && text.[pos] = '#' then + while pos < len && text.[pos] <> '\n' do + advance () + + // Skip a single newline sequence (\r\n or \n) + let skipNewline () = + if pos < len && text.[pos] = '\r' then + advance () + + if pos < len && text.[pos] = '\n' then + advance () + + // Skip whitespace + comments + empty lines + let skipWsAndNewlines () = + let mutable cont = true + + while cont && not (isAtEnd ()) do + skipHws () + + if pos < len && text.[pos] = '#' then + skipComment () + skipNewline () + elif pos < len && (text.[pos] = '\n' || text.[pos] = '\r') then + skipNewline () + else + cont <- false + + // Parse a basic string (between double quotes), assumes pos is on opening " + let parseBasicString () = + advance () // skip opening " + let buf = StringBuilder() + + while pos < len && text.[pos] <> '"' do + if text.[pos] = '\\' then + advance () + + if pos < len then + match text.[pos] with + | 'b' -> + buf.Append('\b') |> ignore + advance () + | 't' -> + buf.Append('\t') |> ignore + advance () + | 'n' -> + buf.Append('\n') |> ignore + advance () + | 'f' -> + buf.Append('\f') |> ignore + advance () + | 'r' -> + buf.Append('\r') |> ignore + advance () + | '"' -> + buf.Append('"') |> ignore + advance () + | '\\' -> + buf.Append('\\') |> ignore + advance () + | 'u' -> + if pos + 4 < len then + let hex = text.[pos + 1 .. pos + 4] + + try + buf.Append(char (Convert.ToInt32(hex, 16))) |> ignore + with _ -> + error (sprintf "Invalid unicode escape \\u%s" hex) + + pos <- pos + 5 + else + error "Incomplete \\u escape" + | 'U' -> + if pos + 8 < len then + let hex = text.[pos + 1 .. pos + 8] + + try + let cp = Convert.ToInt32(hex, 16) + buf.Append(Char.ConvertFromUtf32(cp)) |> ignore + with _ -> + error (sprintf "Invalid unicode escape \\U%s" hex) + + pos <- pos + 9 + else + error "Incomplete \\U escape" + | c -> error (sprintf "Invalid escape \\%c" c) + elif text.[pos] = '\n' then + error "Newline in basic string" + else + buf.Append(text.[pos]) |> ignore + advance () + + if pos >= len then + error "Unterminated basic string" + + advance () // skip closing " + buf.ToString() + + // Parse a multiline basic string ("""), assumes pos is on first " + let parseMultilineBasicString () = + pos <- pos + 3 // skip """ + // Skip optional immediate newline + if pos < len && text.[pos] = '\n' then + advance () + elif pos < len && text.[pos] = '\r' && pos + 1 < len && text.[pos + 1] = '\n' then + pos <- pos + 2 + + let buf = StringBuilder() + let mutable found = false + + while not found do + if + pos + 2 < len + && text.[pos] = '"' + && text.[pos + 1] = '"' + && text.[pos + 2] = '"' + then + // May be followed by 1 or 2 extra quotes that are part of the string + let extra1 = + pos + 3 < len + && text.[pos + 3] = '"' + && not (pos + 4 < len && text.[pos + 4] = '"') + + let extra2 = pos + 4 < len && text.[pos + 3] = '"' && text.[pos + 4] = '"' + + if extra2 then + buf.Append("\"\"") |> ignore + pos <- pos + 5 + elif extra1 then + buf.Append('"') |> ignore + pos <- pos + 4 + else + pos <- pos + 3 + + found <- true + elif pos >= len then + error "Unterminated multiline basic string" + elif text.[pos] = '\\' then + advance () + + if pos < len then + match text.[pos] with + | '\n' -> + advance () + + while pos < len + && (text.[pos] = ' ' || text.[pos] = '\t' || text.[pos] = '\n' || text.[pos] = '\r') do + advance () + | '\r' when pos + 1 < len && text.[pos + 1] = '\n' -> + pos <- pos + 2 + + while pos < len + && (text.[pos] = ' ' || text.[pos] = '\t' || text.[pos] = '\n' || text.[pos] = '\r') do + advance () + | 'b' -> + buf.Append('\b') |> ignore + advance () + | 't' -> + buf.Append('\t') |> ignore + advance () + | 'n' -> + buf.Append('\n') |> ignore + advance () + | 'f' -> + buf.Append('\f') |> ignore + advance () + | 'r' -> + buf.Append('\r') |> ignore + advance () + | '"' -> + buf.Append('"') |> ignore + advance () + | '\\' -> + buf.Append('\\') |> ignore + advance () + | c -> error (sprintf "Invalid escape \\%c in multiline string" c) + else + buf.Append(text.[pos]) |> ignore + advance () + + buf.ToString() + + // Parse a literal string (single quotes), assumes pos is on opening ' + let parseLiteralString () = + advance () // skip opening ' + let buf = StringBuilder() + + while pos < len && text.[pos] <> '\'' do + if text.[pos] = '\n' then + error "Newline in literal string" + + buf.Append(text.[pos]) |> ignore + advance () + + if pos >= len then + error "Unterminated literal string" + + advance () // skip closing ' + buf.ToString() + + // Parse a multiline literal string ('''), assumes pos is on first ' + let parseMultilineLiteralString () = + pos <- pos + 3 // skip ''' + // Skip optional immediate newline + if pos < len && text.[pos] = '\n' then + advance () + elif pos < len && text.[pos] = '\r' && pos + 1 < len && text.[pos + 1] = '\n' then + pos <- pos + 2 + + let buf = StringBuilder() + let mutable found = false + + while not found do + if + pos + 2 < len + && text.[pos] = '\'' + && text.[pos + 1] = '\'' + && text.[pos + 2] = '\'' + then + let extra1 = + pos + 3 < len + && text.[pos + 3] = '\'' + && not (pos + 4 < len && text.[pos + 4] = '\'') + + let extra2 = pos + 4 < len && text.[pos + 3] = '\'' && text.[pos + 4] = '\'' + + if extra2 then + buf.Append("''") |> ignore + pos <- pos + 5 + elif extra1 then + buf.Append('\'') |> ignore + pos <- pos + 4 + else + pos <- pos + 3 + + found <- true + elif pos >= len then + error "Unterminated multiline literal string" + else + buf.Append(text.[pos]) |> ignore + advance () + + buf.ToString() + + // Parse a string value (basic or literal) + let parseStringValue () = + if + pos + 2 < len + && text.[pos] = '"' + && text.[pos + 1] = '"' + && text.[pos + 2] = '"' + then + parseMultilineBasicString () + elif + pos + 2 < len + && text.[pos] = '\'' + && text.[pos + 1] = '\'' + && text.[pos + 2] = '\'' + then + parseMultilineLiteralString () + elif pos < len && text.[pos] = '"' then + parseBasicString () + elif pos < len && text.[pos] = '\'' then + parseLiteralString () + else + error "Expected string" + + // Parse a bare key (letters, digits, -, _) + let parseBareKey () = + let start = pos + + while pos < len + && (Char.IsLetterOrDigit(text.[pos]) || text.[pos] = '_' || text.[pos] = '-') do + advance () + + if pos = start then + error "Expected key" + + text.[start .. pos - 1] + + // Parse a key component (bare, basic-string, or literal-string) + let parseKeyComponent () = + if pos < len && text.[pos] = '"' then + parseBasicString () + elif pos < len && text.[pos] = '\'' then + parseLiteralString () + else + parseBareKey () + + // Parse a potentially dotted key, returning a list of key parts + let parseKey () = + let first = parseKeyComponent () + let keys = ResizeArray([| first |]) + skipHws () + + while pos < len && text.[pos] = '.' do + advance () // skip '.' + skipHws () + keys.Add(parseKeyComponent ()) + skipHws () + + List.ofSeq keys + + // Try to parse a TOML date/time from string + let tryParseDateTime (s: string) = + let odtFormats = + [| "yyyy-MM-dd'T'HH:mm:sszzz" + "yyyy-MM-dd'T'HH:mm:ss.fffffffzzz" + "yyyy-MM-dd'T'HH:mm:ss.ffffffzzz" + "yyyy-MM-dd'T'HH:mm:ss.fffffzzz" + "yyyy-MM-dd'T'HH:mm:ss.ffffzzz" + "yyyy-MM-dd'T'HH:mm:ss.fffzzz" + "yyyy-MM-dd'T'HH:mm:ss.ffzzz" + "yyyy-MM-dd'T'HH:mm:ss.fzzz" + "yyyy-MM-dd HH:mm:sszzz" + "yyyy-MM-dd HH:mm:ss.fffffffzzz" |] + + let ldtFormats = + [| "yyyy-MM-dd'T'HH:mm:ss" + "yyyy-MM-dd'T'HH:mm:ss.fffffff" + "yyyy-MM-dd'T'HH:mm:ss.ffffff" + "yyyy-MM-dd'T'HH:mm:ss.fffff" + "yyyy-MM-dd'T'HH:mm:ss.ffff" + "yyyy-MM-dd'T'HH:mm:ss.fff" + "yyyy-MM-dd'T'HH:mm:ss.ff" + "yyyy-MM-dd'T'HH:mm:ss.f" + "yyyy-MM-dd HH:mm:ss" + "yyyy-MM-dd HH:mm:ss.fffffff" |] + + let dateFormats = [| "yyyy-MM-dd" |] + + let timeFormats = + [| @"hh\:mm\:ss" + @"hh\:mm\:ss\.fffffff" + @"hh\:mm\:ss\.ffffff" + @"hh\:mm\:ss\.fffff" + @"hh\:mm\:ss\.ffff" + @"hh\:mm\:ss\.fff" + @"hh\:mm\:ss\.ff" + @"hh\:mm\:ss\.f" |] + + // Normalize Z to +00:00 for DateTimeOffset parsing + let sNorm = + if s.EndsWith("Z", StringComparison.OrdinalIgnoreCase) then + s.[0 .. s.Length - 2] + "+00:00" + else + s + + match DateTimeOffset.TryParseExact(sNorm, odtFormats, CultureInfo.InvariantCulture, DateTimeStyles.None) with + | true, dt -> Some(TomlValue.OffsetDateTime dt) + | _ -> + match DateTime.TryParseExact(s, ldtFormats, CultureInfo.InvariantCulture, DateTimeStyles.None) with + | true, dt -> Some(TomlValue.LocalDateTime dt) + | _ -> + match DateTime.TryParseExact(s, dateFormats, CultureInfo.InvariantCulture, DateTimeStyles.None) with + | true, d -> Some(TomlValue.LocalDate d) + | _ -> + match TimeSpan.TryParseExact(s, timeFormats, CultureInfo.InvariantCulture) with + | true, ts -> Some(TomlValue.LocalTime ts) + | _ -> None + + // Parse a TOML value + let rec parseValue () : TomlValue = + skipHws () + + match current () with + | '"' -> TomlValue.String(parseStringValue ()) + | '\'' -> TomlValue.String(parseStringValue ()) + | '[' -> parseArray () + | '{' -> parseInlineTable () + | 't' when pos + 3 < len && text.[pos .. pos + 3] = "true" -> + pos <- pos + 4 + TomlValue.Boolean true + | 'f' when pos + 4 < len && text.[pos .. pos + 4] = "false" -> + pos <- pos + 5 + TomlValue.Boolean false + | 'i' + | '+' + | 'n' when + (pos + 2 < len + && (text.[pos .. pos + 2] = "inf" + || text.[pos .. pos + 2] = "nan" + || (pos + 3 < len + && (text.[pos .. pos + 3] = "+inf" || text.[pos .. pos + 3] = "+nan")))) + -> + parseNumOrDate () + | '-' when + pos + 3 < len + && (text.[pos .. pos + 3] = "-inf" || text.[pos .. pos + 3] = "-nan") + -> + parseNumOrDate () + | c when c = '-' || c = '+' || Char.IsDigit(c) -> parseNumOrDate () + | c -> error (sprintf "Unexpected character '%c' in value" c) + + and parseNumOrDate () = + let start = pos + + // Check for special float values + let special3 = if pos + 2 < len then text.[pos .. pos + 2] else "" + + let special4 = if pos + 3 < len then text.[pos .. pos + 3] else "" + + match special3, special4 with + | "nan", _ -> + pos <- pos + 3 + TomlValue.Float Double.NaN + | "inf", _ -> + pos <- pos + 3 + TomlValue.Float Double.PositiveInfinity + | _ when special4 = "+inf" -> + pos <- pos + 4 + TomlValue.Float Double.PositiveInfinity + | _ when special4 = "-inf" -> + pos <- pos + 4 + TomlValue.Float Double.NegativeInfinity + | _ when special4 = "+nan" -> + pos <- pos + 4 + TomlValue.Float Double.NaN + | _ when special4 = "-nan" -> + pos <- pos + 4 + TomlValue.Float Double.NaN + | _ -> + + let mutable hasDecimalOrExp = false + let mutable hasDash = false + let mutable hasColon = false + let mutable hasTorSpace = false + + // Collect the full token + while pos < len + && (let c = text.[pos] + + Char.IsDigit(c) + || c = '.' + || c = 'e' + || c = 'E' + || c = '+' + || c = '-' + || c = '_' + || c = ':' + || c = 'T' + || c = 't' + || c = 'Z' + || c = 'z' + || c = 'x' + || c = 'o' + || c = 'b' + || c = 'a' + || c = 'A' + || c = 'B' + || c = 'c' + || c = 'C' + || c = 'd' + || c = 'D' + || c = 'f' + || c = 'F' + || (c = ' ' && hasDash && pos + 1 < len && Char.IsDigit(text.[pos + 1]))) do + let c = text.[pos] + + match c with + | '.' + | 'e' + | 'E' -> hasDecimalOrExp <- true + | '-' when pos > start -> hasDash <- true + | ':' -> hasColon <- true + | 'T' + | 't' -> hasTorSpace <- true + | ' ' -> hasTorSpace <- true + | _ -> () + + advance () + + let token = text.[start .. pos - 1].Replace("_", "") + + // Date-only: has dashes but no colons, T, or decimal (distinguishes from negative-exponent floats) + let isDateOnly = hasDash && not hasColon && not hasTorSpace && not hasDecimalOrExp + // DateTime: has dashes with colons or T separator + let isDateTime = hasDash && (hasColon || hasTorSpace) + // Time-only: has colons but no dashes + let isTime = not hasDash && hasColon + let isDateLike = isDateOnly || isDateTime || isTime + + if isDateLike then + match tryParseDateTime token with + | Some v -> v + | None -> error (sprintf "Invalid date/time value: '%s'" token) + elif hasDecimalOrExp then + match + Double.TryParse( + token, + NumberStyles.Float ||| NumberStyles.AllowLeadingSign, + CultureInfo.InvariantCulture + ) + with + | true, v -> TomlValue.Float v + | _ -> error (sprintf "Invalid float: '%s'" token) + else + // Integer (decimal, hex 0x, octal 0o, binary 0b) + let tokenTrimmed = token.TrimStart('+') + + if tokenTrimmed.StartsWith("0x", StringComparison.OrdinalIgnoreCase) then + try + TomlValue.Integer(Convert.ToInt64(tokenTrimmed.[2..], 16)) + with _ -> + error (sprintf "Invalid hex integer: '%s'" token) + elif tokenTrimmed.StartsWith("0o", StringComparison.OrdinalIgnoreCase) then + try + TomlValue.Integer(Convert.ToInt64(tokenTrimmed.[2..], 8)) + with _ -> + error (sprintf "Invalid octal integer: '%s'" token) + elif tokenTrimmed.StartsWith("0b", StringComparison.OrdinalIgnoreCase) then + try + TomlValue.Integer(Convert.ToInt64(tokenTrimmed.[2..], 2)) + with _ -> + error (sprintf "Invalid binary integer: '%s'" token) + else + match + Int64.TryParse( + token, + NumberStyles.Integer ||| NumberStyles.AllowLeadingSign, + CultureInfo.InvariantCulture + ) + with + | true, v -> TomlValue.Integer v + | _ -> error (sprintf "Invalid integer: '%s'" token) + + and parseArray () = + advance () // skip '[' + let items = ResizeArray() + skipWsAndNewlines () + + while pos < len && text.[pos] <> ']' do + items.Add(parseValue ()) + skipHws () + skipComment () + skipWsAndNewlines () + + if pos < len && text.[pos] = ',' then + advance () + skipWsAndNewlines () + + if pos >= len then + error "Unterminated array" + + advance () // skip ']' + TomlValue.Array(items.ToArray()) + + and parseInlineTable () = + advance () // skip '{' + skipHws () + let tbl = OrderedTable() + + if pos < len && text.[pos] <> '}' then + parseInlineKeyValue tbl + skipHws () + + while pos < len && text.[pos] = ',' do + advance () + skipHws () + parseInlineKeyValue tbl + skipHws () + + if pos >= len || text.[pos] <> '}' then + error "Unterminated inline table" + + advance () // skip '}' + tbl.ToTomlValue() + + and parseInlineKeyValue (tbl: OrderedTable) = + let keys = parseKey () + skipHws () + + if pos >= len || text.[pos] <> '=' then + error "Expected '=' in inline table" + + advance () + skipHws () + let value = parseValue () + setInTable tbl keys (Prim value) + + and setInTable (tbl: OrderedTable) (keys: string list) (value: MutableNode) = + match keys with + | [] -> () + | [ k ] -> + if tbl.ContainsKey(k) then + error (sprintf "Duplicate key '%s'" k) + + tbl.Set(k, value) + | k :: rest -> + let sub = + match tbl.TryGet(k) with + | Some(Tbl(t, _)) -> t + | None -> + let t = OrderedTable() + tbl.Set(k, Tbl(t, false)) + t + | _ -> error (sprintf "Key '%s' already has a non-table value" k) + + setInTable sub rest value + + // Navigate to the table identified by the given path, creating intermediate tables as needed + and navigateToTable (root: OrderedTable) (path: string list) (isArrayTable: bool) : OrderedTable = + match path with + | [] -> root + | [ k ] -> + if isArrayTable then + match root.TryGet(k) with + | Some(TblArray arr) -> + let newTbl = OrderedTable() + arr.Add(newTbl) + newTbl + | None -> + let arr = ResizeArray() + let newTbl = OrderedTable() + arr.Add(newTbl) + root.Set(k, TblArray arr) + newTbl + | _ -> error (sprintf "Key '%s' conflicts with an existing non-array-of-tables value" k) + else + match root.TryGet(k) with + | Some(Tbl(t, false)) -> + // Intermediate table created implicitly; now we're defining it explicitly + root.Set(k, Tbl(t, true)) + t + | Some(Tbl(_, true)) -> error (sprintf "Table '[%s]' defined more than once" k) + | Some(TblArray arr) -> + // Navigate into last element of array-of-tables + arr.[arr.Count - 1] + | None -> + let t = OrderedTable() + root.Set(k, Tbl(t, true)) + t + | _ -> error (sprintf "Key '%s' conflicts with an existing value" k) + | k :: rest -> + let sub = + match root.TryGet(k) with + | Some(Tbl(t, _)) -> t + | Some(TblArray arr) -> + // Navigate into last element of array-of-tables + arr.[arr.Count - 1] + | None -> + let t = OrderedTable() + root.Set(k, Tbl(t, false)) + t + | _ -> error (sprintf "Key '%s' conflicts with an existing non-table value" k) + + navigateToTable sub rest isArrayTable + + member _.Parse() : TomlValue = + let root = OrderedTable() + let mutable currentTable = root + + skipWsAndNewlines () + + while not (isAtEnd ()) do + skipHws () + + if isAtEnd () then + () + elif current () = '#' then + skipComment () + skipNewline () + skipWsAndNewlines () + elif current () = '\n' || current () = '\r' then + skipNewline () + skipWsAndNewlines () + elif current () = '[' && peek 1 = '[' then + // Array-of-tables header [[key]] + pos <- pos + 2 + skipHws () + let keys = parseKey () + skipHws () + + if not (pos + 1 < len && text.[pos] = ']' && text.[pos + 1] = ']') then + error "Expected ']]' to close array-of-tables header" + + pos <- pos + 2 + skipHws () + skipComment () + skipNewline () + skipWsAndNewlines () + currentTable <- navigateToTable root keys true + elif current () = '[' then + // Table header [key] + advance () + skipHws () + let keys = parseKey () + skipHws () + + if pos >= len || text.[pos] <> ']' then + error "Expected ']' to close table header" + + advance () + skipHws () + skipComment () + skipNewline () + skipWsAndNewlines () + currentTable <- navigateToTable root keys false + else + // Key-value pair + let keys = parseKey () + skipHws () + + if pos >= len || text.[pos] <> '=' then + error (sprintf "Expected '=' after key, got '%c'" (current ())) + + advance () + skipHws () + let value = parseValue () + skipHws () + skipComment () + skipNewline () + skipWsAndNewlines () + setInTable currentTable keys (Prim value) + + root.ToTomlValue() + +type TomlValue with + + /// Parse a TOML document from a string + static member Parse(text: string) : TomlValue = TomlParser(text).Parse() + + /// Attempt to parse a TOML document; returns None on failure + static member TryParse(text: string) : TomlValue option = + try + Some(TomlParser(text).Parse()) + with _ -> + None + + /// Load a TOML document from a stream + static member Load(stream: Stream) : TomlValue = + use reader = new StreamReader(stream) + let text = reader.ReadToEnd() + TomlParser(text).Parse() + + /// Load a TOML document from a text reader + static member Load(reader: TextReader) : TomlValue = + let text = reader.ReadToEnd() + TomlParser(text).Parse() diff --git a/src/FSharp.Data.Toml.Core/paket.references b/src/FSharp.Data.Toml.Core/paket.references new file mode 100644 index 000000000..c89b441a0 --- /dev/null +++ b/src/FSharp.Data.Toml.Core/paket.references @@ -0,0 +1,2 @@ +Microsoft.SourceLink.GitHub +FSharp.Core diff --git a/src/FSharp.Data/FSharp.Data.fsproj b/src/FSharp.Data/FSharp.Data.fsproj index 597933cfb..d984408cd 100755 --- a/src/FSharp.Data/FSharp.Data.fsproj +++ b/src/FSharp.Data/FSharp.Data.fsproj @@ -29,6 +29,7 @@ + diff --git a/tests/FSharp.Data.DesignTime.Tests/SignatureTestCases.config b/tests/FSharp.Data.DesignTime.Tests/SignatureTestCases.config index 1bc1ca96c..c94fd7197 100644 --- a/tests/FSharp.Data.DesignTime.Tests/SignatureTestCases.config +++ b/tests/FSharp.Data.DesignTime.Tests/SignatureTestCases.config @@ -217,3 +217,4 @@ Html,SimpleHtmlLists.html,false,false, Html,EmptyDefinitionLists.html,false,false, Html,zoopla.html,false,false, Html,zoopla2.html,false,false, +Toml,example.toml,,, diff --git a/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs b/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs index 2e004b464..f2d05b1d2 100644 --- a/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs +++ b/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs @@ -79,12 +79,24 @@ type internal WorldBankProviderArgs = { Sources : string Asynchronous : bool } +type internal TomlProviderArgs = + { Sample : string + RootName : string + Culture : string + Encoding : string + ResolutionFolder : string + EmbeddedResource : string + InferenceMode : InferenceMode + PreferDateOnly : bool + UseOriginalNames : bool } + type internal TypeProviderInstantiation = | Csv of CsvProviderArgs | Xml of XmlProviderArgs | Json of JsonProviderArgs | Html of HtmlProviderArgs | WorldBank of WorldBankProviderArgs + | Toml of TomlProviderArgs member x.GenerateType resolutionFolder runtimeAssembly runtimeAssemblyRefs = let f, args = @@ -159,6 +171,17 @@ type internal TypeProviderInstantiation = (fun cfg -> new WorldBankProvider(cfg) :> TypeProviderForNamespaces), [| box x.Sources box x.Asynchronous |] + | Toml x -> + (fun cfg -> new TomlProvider(cfg) :> TypeProviderForNamespaces), + [| box x.Sample + box x.RootName + box x.Culture + box x.Encoding + box x.ResolutionFolder + box x.EmbeddedResource + box x.InferenceMode + box x.PreferDateOnly + box x.UseOriginalNames |] Testing.GenerateProvidedTypeInstantiation(resolutionFolder, runtimeAssembly, runtimeAssemblyRefs, f, args) @@ -204,6 +227,12 @@ type internal TypeProviderInstantiation = ["WorldBank" x.Sources x.Asynchronous.ToString() ] + | Toml x -> + ["Toml" + x.Sample + x.RootName + x.Culture + x.InferenceMode.ToString() ] |> String.concat "," member x.ExpectedPath outputFolder = @@ -317,6 +346,16 @@ type internal TypeProviderInstantiation = | "WorldBank" -> WorldBank { Sources = args.[1] Asynchronous = args.[2] |> bool.Parse } + | "Toml" -> + Toml { Sample = args.[1] + RootName = if args.Length > 2 && args.[2] <> "" then args.[2] else "Root" + Culture = if args.Length > 3 then args.[3] else "" + Encoding = "" + ResolutionFolder = "" + EmbeddedResource = "" + InferenceMode = if args.Length > 4 && args.[4] <> "" then InferenceMode.Parse args.[4] else InferenceMode.BackwardCompatible + PreferDateOnly = false + UseOriginalNames = false } | _ -> failwithf "Unknown: %s" args.[0] static member GetRuntimeAssemblyRefs () = @@ -334,7 +373,8 @@ type internal TypeProviderInstantiation = "FSharp.Data.Html.Core" "FSharp.Data.Xml.Core" "FSharp.Data.Json.Core" - "FSharp.Data.WorldBank.Core" ] + "FSharp.Data.WorldBank.Core" + "FSharp.Data.Toml.Core" ] let extraRefs = [ for j in extraDlls do __SOURCE_DIRECTORY__ ++ ".." ++ ".." ++ "src" ++ "FSharp.Data" ++ "bin" ++ build ++ "netstandard2.0" ++ (j + ".dll") ] diff --git a/tests/FSharp.Data.DesignTime.Tests/expected/Toml,example.toml,Root,,BackwardCompatible.expected b/tests/FSharp.Data.DesignTime.Tests/expected/Toml,example.toml,Root,,BackwardCompatible.expected new file mode 100644 index 000000000..d84991dc0 --- /dev/null +++ b/tests/FSharp.Data.DesignTime.Tests/expected/Toml,example.toml,Root,,BackwardCompatible.expected @@ -0,0 +1,224 @@ +class TomlProvider : obj + static member AsyncGetSample: () -> TomlProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> TomlDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "TOML" "" "example.toml"), f) + + static member AsyncLoad: uri:string -> TomlProvider+Root async + let f = new Func<_,_>(fun (t:TextReader) -> TomlDocument.Create(t)) + TextRuntime.AsyncMap((IO.asyncReadTextAtRuntime false "" "" "TOML" "" uri), f) + + static member GetSample: () -> TomlProvider+Root + TomlDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntimeWithDesignTimeRules "" "" "TOML" "" "example.toml"))) + + static member Load: stream:System.IO.Stream -> TomlProvider+Root + TomlDocument.Create(((new StreamReader(stream)) :> TextReader)) + + static member Load: reader:System.IO.TextReader -> TomlProvider+Root + TomlDocument.Create(reader) + + static member Load: uri:string -> TomlProvider+Root + TomlDocument.Create(FSharpAsync.RunSynchronously((IO.asyncReadTextAtRuntime false "" "" "TOML" "" uri))) + + static member Load: value:JsonValue -> TomlProvider+Root + JsonDocument.Create(value, "") + + static member Parse: text:string -> TomlProvider+Root + TomlDocument.Create(((new StringReader(text)) :> TextReader)) + + +class TomlProvider+Root : FDR.BaseTypes.IJsonDocument + new : title:string -> version:int -> owner:TomlProvider+Owner -> database:TomlProvider+Database -> servers:TomlProvider+Servers -> products:TomlProvider+TomlProvider+Product[] -> TomlProvider+Root + JsonRuntime.CreateRecord([| ("title", + (title :> obj)) + ("version", + (version :> obj)) + ("owner", + (owner :> obj)) + ("database", + (database :> obj)) + ("servers", + (servers :> obj)) + ("products", + (products :> obj)) |], "") + + new : jsonValue:JsonValue -> TomlProvider+Root + JsonDocument.Create(jsonValue, "") + + member Database: TomlProvider+Database with get + JsonRuntime.GetPropertyPacked(this, "database") + + member Owner: TomlProvider+Owner with get + JsonRuntime.GetPropertyPacked(this, "owner") + + member Products: TomlProvider+TomlProvider+Product[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "products"), new Func<_,_>(id))) + + member Servers: TomlProvider+Servers with get + JsonRuntime.GetPropertyPacked(this, "servers") + + member Title: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "title") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Version: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "version") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member WithDatabase: database:TomlProvider+Database -> TomlProvider+Root + JsonRuntime.WithRecordProperty(this, "database", (database :> obj), "") + + member WithOwner: owner:TomlProvider+Owner -> TomlProvider+Root + JsonRuntime.WithRecordProperty(this, "owner", (owner :> obj), "") + + member WithProducts: products:TomlProvider+TomlProvider+Product[] -> TomlProvider+Root + JsonRuntime.WithRecordProperty(this, "products", (products :> obj), "") + + member WithServers: servers:TomlProvider+Servers -> TomlProvider+Root + JsonRuntime.WithRecordProperty(this, "servers", (servers :> obj), "") + + member WithTitle: title:string -> TomlProvider+Root + JsonRuntime.WithRecordProperty(this, "title", (title :> obj), "") + + member WithVersion: version:int -> TomlProvider+Root + JsonRuntime.WithRecordProperty(this, "version", (version :> obj), "") + + +class TomlProvider+Database : FDR.BaseTypes.IJsonDocument + new : server:string -> ports:int[] -> enabled:bool -> TomlProvider+Database + JsonRuntime.CreateRecord([| ("server", + (server :> obj)) + ("ports", + (ports :> obj)) + ("enabled", + (enabled :> obj)) |], "") + + new : jsonValue:JsonValue -> TomlProvider+Database + JsonDocument.Create(jsonValue, "") + + member Enabled: bool with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "enabled") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertBoolean(value.JsonOpt), value.JsonOpt) + + member Ports: int[] with get + JsonRuntime.ConvertArray(JsonRuntime.GetPropertyPackedOrNull(this, "ports"), new Func<_,_>(fun (t:IJsonDocument) -> JsonRuntime.GetNonOptionalValue(t.Path(), JsonRuntime.ConvertInteger("", Some t.JsonValue), Some t.JsonValue))) + + member Server: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "server") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member WithEnabled: enabled:bool -> TomlProvider+Database + JsonRuntime.WithRecordProperty(this, "enabled", (enabled :> obj), "") + + member WithPorts: ports:int[] -> TomlProvider+Database + JsonRuntime.WithRecordProperty(this, "ports", (ports :> obj), "") + + member WithServer: server:string -> TomlProvider+Database + JsonRuntime.WithRecordProperty(this, "server", (server :> obj), "") + + +class TomlProvider+Owner : FDR.BaseTypes.IJsonDocument + new : name:string -> dob:System.DateTimeOffset -> TomlProvider+Owner + JsonRuntime.CreateRecord([| ("name", + (name :> obj)) + ("dob", + (dob :> obj)) |], "") + + new : jsonValue:JsonValue -> TomlProvider+Owner + JsonDocument.Create(jsonValue, "") + + member Dob: System.DateTimeOffset with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "dob") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertDateTimeOffset("", value.JsonOpt), value.JsonOpt) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member WithDob: dob:System.DateTimeOffset -> TomlProvider+Owner + JsonRuntime.WithRecordProperty(this, "dob", (dob :> obj), "") + + member WithName: name:string -> TomlProvider+Owner + JsonRuntime.WithRecordProperty(this, "name", (name :> obj), "") + + +class TomlProvider+Product : FDR.BaseTypes.IJsonDocument + new : name:string -> sku:int -> color:string option -> TomlProvider+Product + JsonRuntime.CreateRecord([| ("name", + (name :> obj)) + ("sku", + (sku :> obj)) + ("color", + (color :> obj)) |], "") + + new : jsonValue:JsonValue -> TomlProvider+Product + JsonDocument.Create(jsonValue, "") + + member Color: string option with get + JsonRuntime.ConvertString("", JsonRuntime.TryGetPropertyUnpacked(this, "color")) + + member Name: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "name") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Sku: int with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "sku") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertInteger("", value.JsonOpt), value.JsonOpt) + + member WithColor: color:string option -> TomlProvider+Product + JsonRuntime.WithRecordProperty(this, "color", (color :> obj), "") + + member WithName: name:string -> TomlProvider+Product + JsonRuntime.WithRecordProperty(this, "name", (name :> obj), "") + + member WithSku: sku:int -> TomlProvider+Product + JsonRuntime.WithRecordProperty(this, "sku", (sku :> obj), "") + + +class TomlProvider+Servers : FDR.BaseTypes.IJsonDocument + new : alpha:TomlProvider+Alpha -> beta:TomlProvider+Alpha -> TomlProvider+Servers + JsonRuntime.CreateRecord([| ("alpha", + (alpha :> obj)) + ("beta", + (beta :> obj)) |], "") + + new : jsonValue:JsonValue -> TomlProvider+Servers + JsonDocument.Create(jsonValue, "") + + member Alpha: TomlProvider+Alpha with get + JsonRuntime.GetPropertyPacked(this, "alpha") + + member Beta: TomlProvider+Alpha with get + JsonRuntime.GetPropertyPacked(this, "beta") + + member WithAlpha: alpha:TomlProvider+Alpha -> TomlProvider+Servers + JsonRuntime.WithRecordProperty(this, "alpha", (alpha :> obj), "") + + member WithBeta: beta:TomlProvider+Alpha -> TomlProvider+Servers + JsonRuntime.WithRecordProperty(this, "beta", (beta :> obj), "") + + +class TomlProvider+Alpha : FDR.BaseTypes.IJsonDocument + new : ip:string -> role:string -> TomlProvider+Alpha + JsonRuntime.CreateRecord([| ("ip", + (ip :> obj)) + ("role", + (role :> obj)) |], "") + + new : jsonValue:JsonValue -> TomlProvider+Alpha + JsonDocument.Create(jsonValue, "") + + member Ip: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "ip") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member Role: string with get + let value = JsonRuntime.TryGetPropertyUnpackedWithPath(this, "role") + JsonRuntime.GetNonOptionalValue(value.Path, JsonRuntime.ConvertString("", value.JsonOpt), value.JsonOpt) + + member WithIp: ip:string -> TomlProvider+Alpha + JsonRuntime.WithRecordProperty(this, "ip", (ip :> obj), "") + + member WithRole: role:string -> TomlProvider+Alpha + JsonRuntime.WithRecordProperty(this, "role", (role :> obj), "") + + diff --git a/tests/FSharp.Data.Tests/Data/example.toml b/tests/FSharp.Data.Tests/Data/example.toml new file mode 100644 index 000000000..75e17c6fb --- /dev/null +++ b/tests/FSharp.Data.Tests/Data/example.toml @@ -0,0 +1,32 @@ +# Example TOML file used by FSharp.Data tests + +title = "Example TOML document" +version = 1 + +[owner] +name = "Jane Doe" +dob = 1979-05-27T07:32:00Z + +[database] +server = "192.168.1.1" +ports = [8001, 8001, 8002] +enabled = true + +[servers] + + [servers.alpha] + ip = "10.0.0.1" + role = "frontend" + + [servers.beta] + ip = "10.0.0.2" + role = "backend" + +[[products]] +name = "Hammer" +sku = 738594937 + +[[products]] +name = "Nail" +sku = 284758393 +color = "gray" diff --git a/tests/FSharp.Data.Toml.Core.Tests/FSharp.Data.Toml.Core.Tests.fsproj b/tests/FSharp.Data.Toml.Core.Tests/FSharp.Data.Toml.Core.Tests.fsproj new file mode 100644 index 000000000..4aa48f78b --- /dev/null +++ b/tests/FSharp.Data.Toml.Core.Tests/FSharp.Data.Toml.Core.Tests.fsproj @@ -0,0 +1,38 @@ + + + + net8.0 + false + + true + true + false + $(OtherFlags) --warnon:1182 --nowarn:44 --nowarn:10001 + + true + + + + + + + + + + + + + + + + + runtime; build; native; contentfiles; analyzers; buildtransitive + all + + + runtime; build; native; contentfiles; analyzers; buildtransitive + all + + + + diff --git a/tests/FSharp.Data.Toml.Core.Tests/Program.fs b/tests/FSharp.Data.Toml.Core.Tests/Program.fs new file mode 100644 index 000000000..fbbbb8695 --- /dev/null +++ b/tests/FSharp.Data.Toml.Core.Tests/Program.fs @@ -0,0 +1,6 @@ +module Program + +[] +let main _argv = + printfn "FSharp.Data.Toml.Core.Tests..." + 0 diff --git a/tests/FSharp.Data.Toml.Core.Tests/TomlValue.fs b/tests/FSharp.Data.Toml.Core.Tests/TomlValue.fs new file mode 100644 index 000000000..605f06307 --- /dev/null +++ b/tests/FSharp.Data.Toml.Core.Tests/TomlValue.fs @@ -0,0 +1,960 @@ +module FSharp.Data.Tests.TomlValue + +open System +open NUnit.Framework +open FsUnit +open FSharp.Data + +// -------------------------------------------------------------------------------------- +// TomlValue union cases +// -------------------------------------------------------------------------------------- + +[] +let ``TomlValue String has correct value`` () = + let v = TomlValue.String "hello" + match v with + | TomlValue.String s -> s |> should equal "hello" + | _ -> failwith "Expected String" + +[] +let ``TomlValue Integer has correct value`` () = + let v = TomlValue.Integer 42L + match v with + | TomlValue.Integer i -> i |> should equal 42L + | _ -> failwith "Expected Integer" + +[] +let ``TomlValue Float has correct value`` () = + let v = TomlValue.Float 3.14 + match v with + | TomlValue.Float f -> f |> should (equalWithin 1e-10) 3.14 + | _ -> failwith "Expected Float" + +[] +let ``TomlValue Boolean true`` () = + let v = TomlValue.Boolean true + match v with + | TomlValue.Boolean b -> b |> should equal true + | _ -> failwith "Expected Boolean" + +[] +let ``TomlValue Boolean false`` () = + let v = TomlValue.Boolean false + match v with + | TomlValue.Boolean b -> b |> should equal false + | _ -> failwith "Expected Boolean" + +[] +let ``TomlValue Array has correct elements`` () = + let v = TomlValue.Array [| TomlValue.Integer 1L; TomlValue.Integer 2L |] + match v with + | TomlValue.Array arr -> arr.Length |> should equal 2 + | _ -> failwith "Expected Array" + +[] +let ``TomlValue Table has correct properties`` () = + let v = TomlValue.Table [| "a", TomlValue.String "x" |] + match v with + | TomlValue.Table props -> props.Length |> should equal 1 + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// TomlValue.ToJsonValue conversion +// -------------------------------------------------------------------------------------- + +[] +let ``ToJsonValue converts String`` () = + let json = (TomlValue.String "hi").ToJsonValue() + json |> should equal (JsonValue.String "hi") + +[] +let ``ToJsonValue converts Integer`` () = + let json = (TomlValue.Integer 99L).ToJsonValue() + json |> should equal (JsonValue.Number 99m) + +[] +let ``ToJsonValue converts Float`` () = + let json = (TomlValue.Float 1.5).ToJsonValue() + json |> should equal (JsonValue.Float 1.5) + +[] +let ``ToJsonValue converts Boolean true`` () = + let json = (TomlValue.Boolean true).ToJsonValue() + json |> should equal (JsonValue.Boolean true) + +[] +let ``ToJsonValue converts Array`` () = + let v = TomlValue.Array [| TomlValue.Integer 1L; TomlValue.Integer 2L |] + let json = v.ToJsonValue() + match json with + | JsonValue.Array arr -> arr.Length |> should equal 2 + | _ -> failwith "Expected JSON array" + +[] +let ``ToJsonValue converts Table`` () = + let v = TomlValue.Table [| "key", TomlValue.String "val" |] + let json = v.ToJsonValue() + match json with + | JsonValue.Record props -> props.Length |> should equal 1 + | _ -> failwith "Expected JSON record" + +[] +let ``ToJsonValue converts OffsetDateTime to ISO 8601 string`` () = + let dt = DateTimeOffset(2023, 11, 1, 10, 30, 0, TimeSpan.Zero) + let json = (TomlValue.OffsetDateTime dt).ToJsonValue() + match json with + | JsonValue.String s -> s |> should startWith "2023-11-01T10:30:00" + | _ -> failwith "Expected JSON string" + +[] +let ``ToJsonValue converts LocalDateTime to ISO 8601 string`` () = + let dt = DateTime(2023, 6, 15, 8, 0, 0) + let json = (TomlValue.LocalDateTime dt).ToJsonValue() + match json with + | JsonValue.String s -> s |> should equal "2023-06-15T08:00:00" + | _ -> failwith "Expected JSON string" + +[] +let ``ToJsonValue converts LocalDate to date string`` () = + let d = DateTime(2024, 1, 31) + let json = (TomlValue.LocalDate d).ToJsonValue() + match json with + | JsonValue.String s -> s |> should equal "2024-01-31" + | _ -> failwith "Expected JSON string" + +[] +let ``ToJsonValue converts LocalTime to time string`` () = + let t = TimeSpan(14, 30, 59) + let json = (TomlValue.LocalTime t).ToJsonValue() + match json with + | JsonValue.String s -> s |> should equal "14:30:59" + | _ -> failwith "Expected JSON string" + +// -------------------------------------------------------------------------------------- +// Parsing: basic scalars +// -------------------------------------------------------------------------------------- + +[] +let ``Parse empty document returns empty table`` () = + let v = TomlValue.Parse "" + match v with + | TomlValue.Table props -> props.Length |> should equal 0 + | _ -> failwith "Expected Table" + +[] +let ``Parse document with comment only`` () = + let v = TomlValue.Parse "# this is a comment" + match v with + | TomlValue.Table props -> props.Length |> should equal 0 + | _ -> failwith "Expected empty table" + +[] +let ``Parse basic string value`` () = + let v = TomlValue.Parse """title = "hello world" """ + match v with + | TomlValue.Table props -> + props |> should haveLength 1 + snd props.[0] |> should equal (TomlValue.String "hello world") + | _ -> failwith "Expected Table" + +[] +let ``Parse literal string value`` () = + let v = TomlValue.Parse "path = 'C:\\Users\\test'" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.String "C:\\Users\\test") + | _ -> failwith "Expected Table" + +[] +let ``Parse integer value`` () = + let v = TomlValue.Parse "count = 42" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Integer 42L) + | _ -> failwith "Expected Table" + +[] +let ``Parse negative integer`` () = + let v = TomlValue.Parse "count = -7" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Integer -7L) + | _ -> failwith "Expected Table" + +[] +let ``Parse positive integer with + prefix`` () = + let v = TomlValue.Parse "n = +99" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Integer 99L) + | _ -> failwith "Expected Table" + +[] +let ``Parse integer with underscores`` () = + let v = TomlValue.Parse "n = 1_000_000" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Integer 1000000L) + | _ -> failwith "Expected Table" + +[] +let ``Parse hex integer`` () = + let v = TomlValue.Parse "n = 0xFF" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Integer 255L) + | _ -> failwith "Expected Table" + +[] +let ``Parse octal integer`` () = + let v = TomlValue.Parse "n = 0o17" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Integer 15L) + | _ -> failwith "Expected Table" + +[] +let ``Parse binary integer`` () = + let v = TomlValue.Parse "n = 0b1010" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Integer 10L) + | _ -> failwith "Expected Table" + +[] +let ``Parse float value`` () = + let v = TomlValue.Parse "pi = 3.14" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Float f -> f |> should (equalWithin 1e-10) 3.14 + | _ -> failwith "Expected Float" + | _ -> failwith "Expected Table" + +[] +let ``Parse float with exponent`` () = + let v = TomlValue.Parse "x = 6.626e-34" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Float f -> f |> should (equalWithin 1e-40) 6.626e-34 + | _ -> failwith "Expected Float" + | _ -> failwith "Expected Table" + +[] +let ``Parse float with underscores`` () = + let v = TomlValue.Parse "x = 1_000.5" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Float f -> f |> should (equalWithin 1e-10) 1000.5 + | _ -> failwith "Expected Float" + | _ -> failwith "Expected Table" + +[] +let ``Parse inf float`` () = + let v = TomlValue.Parse "x = inf" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Float f -> f |> should equal Double.PositiveInfinity + | _ -> failwith "Expected Float" + | _ -> failwith "Expected Table" + +[] +let ``Parse positive inf float`` () = + let v = TomlValue.Parse "x = +inf" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Float f -> f |> should equal Double.PositiveInfinity + | _ -> failwith "Expected Float" + | _ -> failwith "Expected Table" + +[] +let ``Parse negative inf float`` () = + let v = TomlValue.Parse "x = -inf" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Float f -> f |> should equal Double.NegativeInfinity + | _ -> failwith "Expected Float" + | _ -> failwith "Expected Table" + +[] +let ``Parse nan float`` () = + let v = TomlValue.Parse "x = nan" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Float f -> Double.IsNaN(f) |> should equal true + | _ -> failwith "Expected Float" + | _ -> failwith "Expected Table" + +[] +let ``Parse boolean true`` () = + let v = TomlValue.Parse "flag = true" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Boolean true) + | _ -> failwith "Expected Table" + +[] +let ``Parse boolean false`` () = + let v = TomlValue.Parse "flag = false" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Boolean false) + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// Parsing: string escape sequences +// -------------------------------------------------------------------------------------- + +[] +let ``Parse basic string with escape sequences`` () = + let v = TomlValue.Parse """s = "tab:\there\nnewline" """ + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.String "tab:\there\nnewline") + | _ -> failwith "Expected Table" + +[] +let ``Parse basic string with unicode escape`` () = + let v = TomlValue.Parse """s = "\u0041" """ // 'A' + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.String "A") + | _ -> failwith "Expected Table" + +[] +let ``Parse basic string with backslash escape`` () = + let v = TomlValue.Parse """s = "path\\to\\file" """ + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.String "path\\to\\file") + | _ -> failwith "Expected Table" + +[] +let ``Parse basic string with quote escape`` () = + let v = TomlValue.Parse """s = "say \"hi\"" """ + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.String "say \"hi\"") + | _ -> failwith "Expected Table" + +[] +let ``Parse multiline basic string`` () = + let toml = "s = \"\"\"\nline1\nline2\"\"\"" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.String s -> + s |> should contain "line1" + s |> should contain "line2" + | _ -> failwith "Expected String" + | _ -> failwith "Expected Table" + +[] +let ``Parse multiline basic string with line continuation`` () = + let toml = "s = \"\"\"\nfoo \\\n bar\"\"\"" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.String "foo bar") + | _ -> failwith "Expected Table" + +[] +let ``Parse multiline literal string`` () = + let toml = "s = '''\nno \\escapes\nhere'''" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.String "no \\escapes\nhere") + | _ -> failwith "Expected Table" + +[] +let ``Parse literal string preserves backslash`` () = + let v = TomlValue.Parse "p = 'C:\\Users\\test'" + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.String "C:\\Users\\test") + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// Parsing: date/time values +// -------------------------------------------------------------------------------------- + +[] +let ``Parse offset date-time`` () = + let v = TomlValue.Parse "dt = 1979-05-27T07:32:00+00:00" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.OffsetDateTime dt -> + dt.Year |> should equal 1979 + dt.Month |> should equal 5 + dt.Day |> should equal 27 + | _ -> failwith "Expected OffsetDateTime" + | _ -> failwith "Expected Table" + +[] +let ``Parse offset date-time with Z suffix`` () = + let v = TomlValue.Parse "dt = 2023-01-01T12:00:00Z" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.OffsetDateTime dt -> + dt.Year |> should equal 2023 + dt.Offset |> should equal TimeSpan.Zero + | _ -> failwith "Expected OffsetDateTime" + | _ -> failwith "Expected Table" + +[] +let ``Parse offset date-time with fractional seconds`` () = + let v = TomlValue.Parse "dt = 1979-05-27T00:32:00.999999+00:00" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.OffsetDateTime _ -> () // just check it parses + | _ -> failwith "Expected OffsetDateTime" + | _ -> failwith "Expected Table" + +[] +let ``Parse local date-time`` () = + let v = TomlValue.Parse "dt = 1979-05-27T07:32:00" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.LocalDateTime dt -> + dt.Year |> should equal 1979 + dt.Hour |> should equal 7 + | _ -> failwith "Expected LocalDateTime" + | _ -> failwith "Expected Table" + +[] +let ``Parse local date`` () = + let v = TomlValue.Parse "d = 1979-05-27" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.LocalDate d -> + d.Year |> should equal 1979 + d.Month |> should equal 5 + d.Day |> should equal 27 + | _ -> failwith "Expected LocalDate" + | _ -> failwith "Expected Table" + +[] +let ``Parse local time`` () = + let v = TomlValue.Parse "t = 07:32:00" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.LocalTime ts -> + ts.Hours |> should equal 7 + ts.Minutes |> should equal 32 + ts.Seconds |> should equal 0 + | _ -> failwith "Expected LocalTime" + | _ -> failwith "Expected Table" + +[] +let ``Parse local time with fractional seconds`` () = + let v = TomlValue.Parse "t = 07:32:00.999999" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.LocalTime ts -> ts.Hours |> should equal 7 + | _ -> failwith "Expected LocalTime" + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// Parsing: arrays +// -------------------------------------------------------------------------------------- + +[] +let ``Parse empty array`` () = + let v = TomlValue.Parse "a = []" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Array arr -> arr.Length |> should equal 0 + | _ -> failwith "Expected Array" + | _ -> failwith "Expected Table" + +[] +let ``Parse array of integers`` () = + let v = TomlValue.Parse "a = [1, 2, 3]" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Array arr -> + arr.Length |> should equal 3 + arr.[0] |> should equal (TomlValue.Integer 1L) + arr.[2] |> should equal (TomlValue.Integer 3L) + | _ -> failwith "Expected Array" + | _ -> failwith "Expected Table" + +[] +let ``Parse array of strings`` () = + let v = TomlValue.Parse """a = ["cat", "dog"]""" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Array arr -> + arr.[0] |> should equal (TomlValue.String "cat") + arr.[1] |> should equal (TomlValue.String "dog") + | _ -> failwith "Expected Array" + | _ -> failwith "Expected Table" + +[] +let ``Parse array with trailing comma`` () = + let v = TomlValue.Parse "a = [1, 2, 3,]" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Array arr -> arr.Length |> should equal 3 + | _ -> failwith "Expected Array" + | _ -> failwith "Expected Table" + +[] +let ``Parse multiline array`` () = + let toml = "a = [\n 1,\n 2,\n 3\n]" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Array arr -> arr.Length |> should equal 3 + | _ -> failwith "Expected Array" + | _ -> failwith "Expected Table" + +[] +let ``Parse nested array`` () = + let v = TomlValue.Parse "a = [[1, 2], [3, 4]]" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Array arr -> + arr.Length |> should equal 2 + match arr.[0] with + | TomlValue.Array inner -> inner.Length |> should equal 2 + | _ -> failwith "Expected inner Array" + | _ -> failwith "Expected Array" + | _ -> failwith "Expected Table" + +[] +let ``Parse array with comment`` () = + let toml = "a = [1, # comment\n2]" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Array arr -> arr.Length |> should equal 2 + | _ -> failwith "Expected Array" + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// Parsing: inline tables +// -------------------------------------------------------------------------------------- + +[] +let ``Parse inline table`` () = + let v = TomlValue.Parse """person = {name = "Alice", age = 30}""" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Table inner -> + inner.Length |> should equal 2 + snd inner.[0] |> should equal (TomlValue.String "Alice") + snd inner.[1] |> should equal (TomlValue.Integer 30L) + | _ -> failwith "Expected Table" + | _ -> failwith "Expected Table" + +[] +let ``Parse empty inline table`` () = + let v = TomlValue.Parse "x = {}" + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Table inner -> inner.Length |> should equal 0 + | _ -> failwith "Expected Table" + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// Parsing: table headers +// -------------------------------------------------------------------------------------- + +[] +let ``Parse table header`` () = + let toml = "[owner]\nname = \"Alice\"" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + props.Length |> should equal 1 + fst props.[0] |> should equal "owner" + match snd props.[0] with + | TomlValue.Table inner -> + inner.Length |> should equal 1 + fst inner.[0] |> should equal "name" + | _ -> failwith "Expected nested Table" + | _ -> failwith "Expected Table" + +[] +let ``Parse multiple table headers`` () = + let toml = "[a]\nx = 1\n\n[b]\ny = 2" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + props.Length |> should equal 2 + fst props.[0] |> should equal "a" + fst props.[1] |> should equal "b" + | _ -> failwith "Expected Table" + +[] +let ``Parse dotted table header`` () = + let toml = "[a.b.c]\nkey = 1" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + props.Length |> should equal 1 + fst props.[0] |> should equal "a" + match snd props.[0] with + | TomlValue.Table a -> + match snd a.[0] with + | TomlValue.Table b -> + match snd b.[0] with + | TomlValue.Table c -> + fst c.[0] |> should equal "key" + | _ -> failwith "Expected Table c" + | _ -> failwith "Expected Table b" + | _ -> failwith "Expected Table a" + | _ -> failwith "Expected Table" + +[] +let ``Parse array-of-tables`` () = + let toml = "[[products]]\nname = \"Hammer\"\n\n[[products]]\nname = \"Nail\"" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + props.Length |> should equal 1 + fst props.[0] |> should equal "products" + match snd props.[0] with + | TomlValue.Array arr -> + arr.Length |> should equal 2 + match arr.[0] with + | TomlValue.Table inner -> + snd inner.[0] |> should equal (TomlValue.String "Hammer") + | _ -> failwith "Expected Table in array" + | _ -> failwith "Expected Array" + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// Parsing: dotted keys +// -------------------------------------------------------------------------------------- + +[] +let ``Parse dotted key`` () = + let toml = "a.b = 1" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + fst props.[0] |> should equal "a" + match snd props.[0] with + | TomlValue.Table inner -> + fst inner.[0] |> should equal "b" + snd inner.[0] |> should equal (TomlValue.Integer 1L) + | _ -> failwith "Expected nested Table" + | _ -> failwith "Expected Table" + +[] +let ``Parse multi-level dotted key`` () = + let toml = "a.b.c = \"deep\"" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Table a -> + match snd a.[0] with + | TomlValue.Table b -> + snd b.[0] |> should equal (TomlValue.String "deep") + | _ -> failwith "Expected Table b" + | _ -> failwith "Expected Table a" + | _ -> failwith "Expected Table" + +[] +let ``Parse quoted key`` () = + let toml = """" key with spaces" = 1""" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + fst props.[0] |> should equal " key with spaces" + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// Parsing: complex real-world documents +// -------------------------------------------------------------------------------------- + +[] +let ``Parse TOML spec example`` () = + let toml = """ +# This is a TOML document + +title = "TOML Example" + +[owner] +name = "Tom Preston-Werner" +dob = 1979-05-27T07:32:00+00:00 + +[database] +enabled = true +ports = [ 8000, 8001, 8002 ] +data = [ ["delta", "phi"], [3.14] ] +temp_targets = { cpu = 79.5, case = 72.0 } + +[servers] + +[servers.alpha] +ip = "10.0.0.1" +role = "frontend" + +[servers.beta] +ip = "10.0.0.2" +role = "backend" +""" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + props |> Array.map fst |> should contain "title" + props |> Array.map fst |> should contain "owner" + props |> Array.map fst |> should contain "database" + props |> Array.map fst |> should contain "servers" + | _ -> failwith "Expected Table" + +[] +let ``Parse owner dob as OffsetDateTime`` () = + let toml = """ +[owner] +name = "Tom" +dob = 1979-05-27T07:32:00+00:00 +""" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Table owner -> + match snd owner.[1] with + | TomlValue.OffsetDateTime dt -> + dt.Year |> should equal 1979 + | _ -> failwith "Expected OffsetDateTime" + | _ -> failwith "Expected owner Table" + | _ -> failwith "Expected Table" + +[] +let ``Parse array of tables with sub-properties`` () = + let toml = """ +[[fruits]] +name = "apple" + +[fruits.physical] +color = "red" +shape = "round" + +[[fruits]] +name = "banana" +""" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + match snd props.[0] with + | TomlValue.Array arr -> + arr.Length |> should equal 2 + match arr.[0] with + | TomlValue.Table t -> + t |> Array.map fst |> should contain "name" + t |> Array.map fst |> should contain "physical" + | _ -> failwith "Expected Table" + | _ -> failwith "Expected Array" + | _ -> failwith "Expected Table" + +[] +let ``Parse document with mixed types`` () = + let toml = """ +str = "hello" +num = 42 +flt = 3.14 +flag = true +arr = [1, 2, 3] +""" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + props.Length |> should equal 5 + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// Parsing: error cases +// -------------------------------------------------------------------------------------- + +[] +let ``Parse duplicate key raises error`` () = + let toml = "a = 1\na = 2" + (fun () -> TomlValue.Parse toml |> ignore) + |> should throw typeof + +[] +let ``Parse duplicate table header raises error`` () = + let toml = "[a]\n[a]" + (fun () -> TomlValue.Parse toml |> ignore) + |> should throw typeof + +[] +let ``Parse unterminated basic string raises error`` () = + let toml = """s = "unterminated""" + (fun () -> TomlValue.Parse toml |> ignore) + |> should throw typeof + +[] +let ``Parse unterminated array raises error`` () = + let toml = "a = [1, 2" + (fun () -> TomlValue.Parse toml |> ignore) + |> should throw typeof + +[] +let ``Parse invalid escape in basic string raises error`` () = + let toml = "s = \"\\z\"" + (fun () -> TomlValue.Parse toml |> ignore) + |> should throw typeof + +[] +let ``TryParse returns Some on valid input`` () = + let result = TomlValue.TryParse "x = 1" + result |> should not' (equal None) + +[] +let ``TryParse returns None on invalid input`` () = + let result = TomlValue.TryParse "= invalid" + result |> should equal None + +// -------------------------------------------------------------------------------------- +// Parsing: key formats +// -------------------------------------------------------------------------------------- + +[] +let ``Parse key with dash`` () = + let v = TomlValue.Parse "my-key = 1" + match v with + | TomlValue.Table props -> fst props.[0] |> should equal "my-key" + | _ -> failwith "Expected Table" + +[] +let ``Parse key with underscore`` () = + let v = TomlValue.Parse "my_key = 1" + match v with + | TomlValue.Table props -> fst props.[0] |> should equal "my_key" + | _ -> failwith "Expected Table" + +[] +let ``Parse multiple key-value pairs`` () = + let toml = "a = 1\nb = 2\nc = 3" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + props.Length |> should equal 3 + | _ -> failwith "Expected Table" + +[] +let ``Parse key-value pairs with inline comments`` () = + let toml = "a = 1 # comment\nb = 2 # another comment" + let v = TomlValue.Parse toml + match v with + | TomlValue.Table props -> + props.Length |> should equal 2 + snd props.[0] |> should equal (TomlValue.Integer 1L) + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// Parsing: Load from stream / reader +// -------------------------------------------------------------------------------------- + +[] +let ``Load from TextReader`` () = + use reader = new System.IO.StringReader("x = 42") + let v = TomlValue.Load(reader) + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Integer 42L) + | _ -> failwith "Expected Table" + +[] +let ``Load from Stream`` () = + let bytes = System.Text.Encoding.UTF8.GetBytes("x = 42") + use stream = new System.IO.MemoryStream(bytes) + let v = TomlValue.Load(stream) + match v with + | TomlValue.Table props -> + snd props.[0] |> should equal (TomlValue.Integer 42L) + | _ -> failwith "Expected Table" + +// -------------------------------------------------------------------------------------- +// TomlDocument +// -------------------------------------------------------------------------------------- + +[] +let ``TomlDocument Create from TomlValue`` () = + let toml = TomlValue.Parse "x = 1" + let doc = FSharp.Data.Runtime.BaseTypes.TomlDocument.Create(toml, "") + doc |> should not' (equal null) + +[] +let ``TomlDocument Create from TextReader`` () = + use reader = new System.IO.StringReader("x = 42") + let doc = FSharp.Data.Runtime.BaseTypes.TomlDocument.Create(reader) + doc |> should not' (equal null) + +[] +let ``TomlDocument JsonValue is valid JSON record`` () = + let toml = TomlValue.Parse "x = 1\ny = 2" + let doc = FSharp.Data.Runtime.BaseTypes.TomlDocument.Create(toml, "") + match doc.JsonValue with + | JsonValue.Record props -> props.Length |> should equal 2 + | _ -> failwith "Expected JSON record" + +// -------------------------------------------------------------------------------------- +// _Print formatting +// -------------------------------------------------------------------------------------- + +[] +let ``_Print formats String`` () = + let v = TomlValue.String "hello" + v._Print |> should contain "hello" + +[] +let ``_Print formats Integer`` () = + let v = TomlValue.Integer 42L + v._Print |> should equal "42" + +[] +let ``_Print formats Float`` () = + let v = TomlValue.Float 3.14 + v._Print |> should contain "3.14" + +[] +let ``_Print formats Boolean`` () = + (TomlValue.Boolean true)._Print |> should equal "true" + (TomlValue.Boolean false)._Print |> should equal "false" + +[] +let ``_Print formats Array`` () = + let v = TomlValue.Array [| TomlValue.Integer 1L; TomlValue.Integer 2L |] + v._Print |> should contain "2 items" + +[] +let ``_Print formats Table`` () = + let v = TomlValue.Table [| "k", TomlValue.Integer 1L |] + v._Print |> should contain "1 properties" + +[] +let ``_Print formats LocalTime`` () = + let v = TomlValue.LocalTime(TimeSpan(9, 5, 7)) + v._Print |> should equal "09:05:07" diff --git a/tests/FSharp.Data.Toml.Core.Tests/paket.references b/tests/FSharp.Data.Toml.Core.Tests/paket.references new file mode 100644 index 000000000..aaa9d970b --- /dev/null +++ b/tests/FSharp.Data.Toml.Core.Tests/paket.references @@ -0,0 +1,8 @@ +group Test + + Microsoft.NET.Test.Sdk + NUnit + NUnit3TestAdapter + FsUnit + FsCheck + GitHubActionsTestLogger