├── tests ├── fail │ ├── f12.toml │ ├── f11.toml │ ├── f1.toml │ ├── f8.toml │ ├── f9.toml │ ├── f15.toml │ ├── f13.toml │ ├── f14.toml │ ├── f5.toml │ ├── f6.toml │ ├── f10.toml │ ├── f17.toml │ ├── f7.toml │ ├── f16.toml │ ├── f3.toml │ ├── f2.toml │ └── f4.toml ├── pass │ ├── t15.toml │ ├── t3.toml │ ├── t6.toml │ ├── t5.toml │ ├── t4.toml │ ├── t7.toml │ ├── t14.toml │ ├── t0.toml │ ├── t1.toml │ ├── t9.toml │ ├── t11.toml │ ├── t2.toml │ ├── t10.toml │ ├── t12.toml │ ├── t13.toml │ └── t8.toml ├── Makefile └── Tests.pas ├── readme.md └── sources ├── TOML.pas ├── Scanner.pas ├── TOMLTypes.pas └── TOMLParser.pas /tests/fail/f12.toml: -------------------------------------------------------------------------------- 1 | 2 | # incomplete binary 3 | bin1 = 0b -------------------------------------------------------------------------------- /tests/fail/f11.toml: -------------------------------------------------------------------------------- 1 | 2 | # incomplete octal 3 | oct1 = 0o 4 | -------------------------------------------------------------------------------- /tests/fail/f1.toml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # incomplete hex 5 | hex1 = 0x 6 | -------------------------------------------------------------------------------- /tests/fail/f8.toml: -------------------------------------------------------------------------------- 1 | 2 | 3 | # incomplete date 4 | odt1 = 1979- 5 | -------------------------------------------------------------------------------- /tests/fail/f9.toml: -------------------------------------------------------------------------------- 1 | 2 | 3 | # incomplete time 4 | odt1 = 12: 5 | -------------------------------------------------------------------------------- /tests/fail/f15.toml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # trailing exponent 5 | flt4 = 5e 6 | -------------------------------------------------------------------------------- /tests/fail/f13.toml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # exponent offset missing 5 | flt4 = 5e+ 6 | -------------------------------------------------------------------------------- /tests/fail/f14.toml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # trailing dot in key name 5 | a.b. = 100 6 | -------------------------------------------------------------------------------- /tests/fail/f5.toml: -------------------------------------------------------------------------------- 1 | 2 | # exponent must be preceded by number 3 | exp = E-22 4 | -------------------------------------------------------------------------------- /tests/fail/f6.toml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # decimal must be preceded by dot 5 | dec = .626 6 | 7 | -------------------------------------------------------------------------------- /tests/fail/f10.toml: -------------------------------------------------------------------------------- 1 | [fruit] 2 | apple = "red" 3 | 4 | [fruit.apple] 5 | texture = "smooth" 6 | -------------------------------------------------------------------------------- /tests/fail/f17.toml: -------------------------------------------------------------------------------- 1 | 2 | # inline tables do not allow trailing commas 3 | table = { A = 1, } 4 | -------------------------------------------------------------------------------- /tests/fail/f7.toml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # underscore in number must be preceded by number 5 | int = _000 6 | -------------------------------------------------------------------------------- /tests/fail/f16.toml: -------------------------------------------------------------------------------- 1 | 2 | # new lines are not allowed in tables 3 | table = { A = 1,B = 2,C = 3 4 | } 5 | -------------------------------------------------------------------------------- /tests/pass/t15.toml: -------------------------------------------------------------------------------- 1 | # Test inline tables in arrays 2 | 3 | list = [ 4 | { from = 100, to = 200 }, 5 | { from = 100, to = 200 }, 6 | ] -------------------------------------------------------------------------------- /tests/pass/t3.toml: -------------------------------------------------------------------------------- 1 | 2 | # Boolean 3 | # Booleans are just the tokens you're used to. Always lowercase. 4 | 5 | bool1 = true 6 | bool2 = false -------------------------------------------------------------------------------- /tests/fail/f3.toml: -------------------------------------------------------------------------------- 1 | # Similarly, inline tables can not be used to add keys or sub-tables to an already-defined table. 2 | 3 | [product] 4 | type.name = "Nail" 5 | type = { edible = false } # INVALID -------------------------------------------------------------------------------- /tests/pass/t6.toml: -------------------------------------------------------------------------------- 1 | # Local Date 2 | # If you include only the date portion of an RFC 3339 formatted date-time, it will represent that entire day without any relation to an offset or timezone. 3 | 4 | ld1 = 1979-05-27 -------------------------------------------------------------------------------- /tests/fail/f2.toml: -------------------------------------------------------------------------------- 1 | # Inline tables fully define the keys and sub-tables within them. New keys and sub-tables cannot be added to them. 2 | 3 | [product] 4 | type = { name = "Nail" } 5 | type.edible = false # INVALID 6 | -------------------------------------------------------------------------------- /tests/Makefile: -------------------------------------------------------------------------------- 1 | COMPILER = fpc 2 | OUTPUT = output 3 | PROGRAM = Tests.pas 4 | OPTIONS = -Fu../sources -vm6058 -gw -godwarfcpp -Sa 5 | 6 | all: 7 | mkdir -p ${OUTPUT} 8 | ${COMPILER} ${OPTIONS} -FU${OUTPUT} ${PROGRAM} 9 | ./Tests -------------------------------------------------------------------------------- /tests/pass/t5.toml: -------------------------------------------------------------------------------- 1 | # Local Date-Time 2 | # If you omit the offset from an RFC 3339 formatted date-time, it will represent the given date-time without any relation to an offset or timezone. It cannot be converted to an instant in time without additional information. Conversion to an instant, if required, is implementation specific. 3 | 4 | ldt1 = 1979-05-27T07:32:00 5 | ldt2 = 1979-05-27T00:32:00.999999 -------------------------------------------------------------------------------- /tests/pass/t4.toml: -------------------------------------------------------------------------------- 1 | # Offset Date-Time 2 | # To unambiguously represent a specific instant in time, you may use an RFC 3339 formatted date-time with offset. 3 | 4 | odt1 = 1979-05-27T07:32:00Z 5 | odt2 = 1979-05-27T00:32:00-07:00 6 | odt3 = 1979-05-27T00:32:00.999999-07:00 7 | 8 | # For the sake of readability, you may replace the T delimiter between date and time with a space (as permitted by RFC 3339 section 5.6). 9 | 10 | odt4 = 1979-05-27 07:32:00Z -------------------------------------------------------------------------------- /tests/pass/t7.toml: -------------------------------------------------------------------------------- 1 | # Local Time 2 | # If you include only the time portion of an RFC 3339 formatted date-time, it will represent that time of day without any relation to a specific day or any offset or timezone. 3 | 4 | lt1 = 07:32:00 5 | lt2 = 00:32:00.999999 6 | 7 | # The precision of fractional seconds is implementation specific, but at least millisecond precision is expected. If the value contains greater precision than the implementation can support, the additional precision must be truncated, not rounded. 8 | 9 | -------------------------------------------------------------------------------- /tests/fail/f4.toml: -------------------------------------------------------------------------------- 1 | 2 | # Dotted keys define everything to the left of each dot as a table. Since tables cannot be defined more than once, redefining such tables using a [table] header is not allowed. Likewise, using dotted keys to redefine tables already defined in [table] form is not allowed. 3 | 4 | # The [table] form can, however, be used to define sub-tables within tables defined via dotted keys. 5 | 6 | [fruit] 7 | apple.color = "red" 8 | apple.taste.sweet = true 9 | 10 | [fruit.apple] # INVALID 11 | [fruit.apple.taste] # INVALID 12 | -------------------------------------------------------------------------------- /tests/pass/t14.toml: -------------------------------------------------------------------------------- 1 | 2 | # Dotted keys define everything to the left of each dot as a table. Since tables cannot be defined more than once, redefining such tables using a [table] header is not allowed. Likewise, using dotted keys to redefine tables already defined in [table] form is not allowed. 3 | 4 | # The [table] form can, however, be used to define sub-tables within tables defined via dotted keys. 5 | 6 | 7 | [fruit] 8 | apple.color = "red" 9 | apple.taste.sweet = true 10 | 11 | # [fruit.apple] # INVALID 12 | # [fruit.apple.taste] # INVALID 13 | 14 | [fruit.apple.texture] # you can add sub-tables 15 | smooth = true 16 | -------------------------------------------------------------------------------- /tests/pass/t0.toml: -------------------------------------------------------------------------------- 1 | # This is a TOML document. 2 | 3 | title = "TOML Example" 4 | 5 | [owner] 6 | name = "Tom Preston-Werner" 7 | dob = 1979-05-27T07:32:00-08:00 # First class dates 8 | 9 | [database] 10 | server = "192.168.1.1" 11 | ports = [ 8001, 8001, 8002 ] 12 | connection_max = 5000 13 | enabled = true 14 | 15 | [servers] 16 | 17 | # Indentation (tabs and/or spaces) is allowed but not required 18 | [servers.alpha] 19 | ip = "10.0.0.1" 20 | dc = "eqdc10" 21 | 22 | [servers.beta] 23 | ip = "10.0.0.2" 24 | dc = "eqdc10" 25 | 26 | [clients] 27 | data = [ ["gamma", "delta"], [1, 2] ] 28 | 29 | # Line breaks are OK when inside arrays 30 | hosts = [ 31 | "alpha", 32 | "omega" 33 | ] -------------------------------------------------------------------------------- /tests/pass/t1.toml: -------------------------------------------------------------------------------- 1 | # Integers are whole numbers. Positive numbers may be prefixed with a plus sign. 2 | # Negative numbers are prefixed with a minus sign. 3 | 4 | int1 = +99 5 | int2 = 42 6 | int3 = 0 7 | int4 = -17 8 | 9 | # For large numbers, you may use underscores between digits to enhance readability. 10 | # Each underscore must be surrounded by at least one digit on each side. 11 | 12 | int5 = 1_000 13 | int6 = 5_349_221 14 | int7 = 1_2_3_4_5 # VALID but discouraged 15 | 16 | # hexadecimal with prefix `0x` 17 | hex1 = 0xDEADBEEF 18 | hex2 = 0xdeadbeef 19 | hex3 = 0xdead_beef 20 | 21 | # octal with prefix `0o` 22 | oct1 = 0o01234567 23 | oct2 = 0o755 # useful for Unix file permissions 24 | 25 | # binary with prefix `0b` 26 | bin1 = 0b11010110 -------------------------------------------------------------------------------- /tests/pass/t9.toml: -------------------------------------------------------------------------------- 1 | # Array 2 | # Arrays are square brackets with values inside. Whitespace is ignored. Elements are separated by commas. 3 | # Arrays can contain values of the same data types as allowed in key/value pairs. Values of different types may be mixed. 4 | 5 | integers = [ 1, 2, 3 ] 6 | colors = [ "red", "yellow", "green" ] 7 | nested_array_of_int = [ [ 1, 2 ], [3, 4, 5] ] 8 | nested_mixed_array = [ [ 1, 2 ], ["a", "b", "c"] ] 9 | # string_array = [ "all", 'strings', """are the same""", '''type''' ] 10 | 11 | 12 | # Mixed-type arrays are allowed 13 | numbers = [ 0.1, 0.2, 0.5, 1, 2, 5 ] 14 | contributors = [ 15 | "Foo Bar ", 16 | { name = "Baz Qux", email = "bazqux@example.com", url = "https://example.com/bazqux" } 17 | ] 18 | 19 | 20 | # Arrays can span multiple lines. A terminating comma (also called trailing comma) is ok after the last value of the array. There can be an arbitrary number of newlines and comments before a value and before the closing bracket. 21 | 22 | integers2 = [ 23 | 1, 2, 3 24 | ] 25 | 26 | integers3 = [ 27 | 1, 28 | 2, # this is ok 29 | ] -------------------------------------------------------------------------------- /tests/pass/t11.toml: -------------------------------------------------------------------------------- 1 | # Keys 2 | # A key may be either bare, quoted or dotted. 3 | 4 | # Bare keys may only contain ASCII letters, ASCII digits, underscores, and dashes (A-Za-z0-9_-). Note that bare keys are allowed to be composed of only ASCII digits, e.g. 1234, but are always interpreted as strings. 5 | 6 | key = "value" 7 | bare_key = "value" 8 | bare-key = "value" 9 | 1234 = "value" 10 | 11 | 12 | # Quoted keys follow the exact same rules as either basic strings or literal strings and allow you to use a much broader set of key names. Best practice is to use bare keys except when absolutely necessary. 13 | 14 | "127.0.0.1" = "value" 15 | "character encoding" = "value" 16 | "ʎǝʞ" = "value" 17 | 'key2' = "value" 18 | 'quoted "value"' = "value" 19 | 20 | 21 | # # A bare key must be non-empty, but an empty quoted key is allowed (though discouraged). 22 | 23 | # # = "no key name" # INVALID 24 | # "" = "blank" # VALID but discouraged 25 | # '' = 'blank' # VALID but discouraged 26 | 27 | 28 | # # Dotted keys are a sequence of bare or quoted keys joined with a dot. This allows for grouping similar properties together: 29 | 30 | name = "Orange" 31 | physical.color = "orange" 32 | physical.shape = "round" 33 | site."google.com" = true 34 | -------------------------------------------------------------------------------- /tests/pass/t2.toml: -------------------------------------------------------------------------------- 1 | # Floats should be implemented as IEEE 754 binary64 values. 2 | 3 | # A float consists of an integer part (which follows the same rules as decimal integer values) 4 | # followed by a fractional part and/or an exponent part. If both a fractional part and exponent 5 | # part are present, the fractional part must precede the exponent part. 6 | 7 | 8 | # fractional 9 | flt1 = +1.0 10 | flt2 = 3.1415 11 | flt3 = -0.01 12 | 13 | # exponent 14 | flt4 = 5e+22 15 | flt5 = 1e06 16 | flt6 = -2E-2 17 | 18 | # both 19 | flt7 = 6.626e-34 20 | 21 | 22 | # A fractional part is a decimal point followed by one or more digits. 23 | 24 | # An exponent part is an E (upper or lower case) followed by an integer part (which follows the same rules as decimal integer values but may include leading zeros). 25 | 26 | # Similar to integers, you may use underscores to enhance readability. Each underscore must be surrounded by at least one digit. 27 | 28 | flt8 = 224_617.445_991_228 29 | 30 | # infinity 31 | sf1 = inf # positive infinity 32 | sf2 = +inf # positive infinity 33 | sf3 = -inf # negative infinity 34 | 35 | # not a number 36 | sf4 = nan # actual sNaN/qNaN encoding is implementation specific 37 | sf5 = +nan # same as `nan` 38 | sf6 = -nan # valid, actual encoding is implementation specific -------------------------------------------------------------------------------- /tests/pass/t10.toml: -------------------------------------------------------------------------------- 1 | 2 | # Table 3 | # Tables (also known as hash tables or dictionaries) are collections of key/value pairs. They appear in square brackets on a line by themselves. You can tell them apart from arrays because arrays are only ever values. 4 | 5 | [table-0] 6 | 7 | # Under that, and until the next table or EOF are the key/values of that table. Key/value pairs within tables are not guaranteed to be in any specific order. 8 | 9 | [table-1] 10 | key1 = "some string" 11 | key2 = 123 12 | 13 | [table-2] 14 | key1 = "another string" 15 | key2 = 456 16 | 17 | # Naming rules for tables are the same as for keys (see definition of Keys above). 18 | 19 | [dog."tater.man"] 20 | type.name = "pug" 21 | 22 | # In JSON land, that would give you the following structure: 23 | 24 | # { "dog": { "tater.man": { "type": { "name": "pug" } } } } 25 | 26 | # You don't need to specify all the super-tables if you don't want to. TOML knows how to do it for you. 27 | 28 | # [x] you 29 | # [x.y] don't 30 | # [x.y.z] need these 31 | [x.y.z.w] # for this to work 32 | 33 | # TODO: not sure about this yet? 34 | [x] # defining a super-table afterwards is ok 35 | 36 | # Like keys, you cannot define any table more than once. Doing so is invalid. 37 | 38 | # DO NOT DO THIS 39 | 40 | # [fruit] 41 | # apple = "red" 42 | 43 | # [fruit] 44 | # orange = "orange" -------------------------------------------------------------------------------- /tests/pass/t12.toml: -------------------------------------------------------------------------------- 1 | 2 | # Inline Table 3 | # Inline tables provide a more compact syntax for expressing tables. They are especially useful for grouped data that can otherwise quickly become verbose. Inline tables are enclosed in curly braces { and }. Within the braces, zero or more comma separated key/value pairs may appear. Key/value pairs take the same form as key/value pairs in standard tables. All value types are allowed, including inline tables. 4 | 5 | # Inline tables are intended to appear on a single line. A terminating comma (also called trailing comma) is not permitted after the last key/value pair in an inline table. No newlines are allowed between the curly braces unless they are valid within a value. Even so, it is strongly discouraged to break an inline table onto multiples lines. If you find yourself gripped with this desire, it means you should be using standard tables. 6 | 7 | name = { first = "Tom", last = "Preston-Werner" } 8 | point = { x = 1, y = 2 } 9 | animal = { type.name = "pug" } 10 | 11 | # Inline tables fully define the keys and sub-tables within them. New keys and sub-tables cannot be added to them. 12 | 13 | # [product] 14 | # type = { name = "Nail" } 15 | # type.edible = false # INVALID 16 | 17 | 18 | # Similarly, inline tables can not be used to add keys or sub-tables to an already-defined table. 19 | 20 | # [product] 21 | # type.name = "Nail" 22 | # type = { edible = false } # INVALID -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # fpTOML Parser 2 | 3 | TOML parser for Free Pascal Compiler. Learn more about Tom's Obvious, Minimal Language at https://toml.io/. 4 | 5 | ```toml 6 | # This is a TOML document. 7 | 8 | # TOML aims to be a minimal configuration file format that's easy to read due to obvious semantics. 9 | # TOML is designed to map unambiguously to a hash table. TOML should be easy to parse into 10 | # data structures in a wide variety of languages. 11 | 12 | title = "TOML Example" 13 | 14 | [owner] 15 | name = "Tom Preston-Werner" 16 | dob = 1979-05-27T07:32:00-08:00 # First class dates 17 | 18 | [database] 19 | server = "192.168.1.1" 20 | ports = [ 8001, 8001, 8002 ] 21 | connection_max = 5000 22 | enabled = true 23 | 24 | [servers] 25 | 26 | # Indentation (tabs and/or spaces) is allowed but not required 27 | [servers.alpha] 28 | ip = "10.0.0.1" 29 | dc = "eqdc10" 30 | 31 | [servers.beta] 32 | ip = "10.0.0.2" 33 | dc = "eqdc10" 34 | 35 | [clients] 36 | data = [ ["gamma", "delta"], [1, 2] ] 37 | 38 | # Line breaks are OK when inside arrays 39 | hosts = [ 40 | "alpha", 41 | "omega" 42 | ] 43 | ``` 44 | 45 | [TOML v1.0.0-rc.1](https://toml.io/en/v1.0.0-rc.1) compliant. 46 | 47 | ### 👌 Features: 48 | 49 | - Fast. Single stream tokenizer and lexer which doesn't use regex. 50 | - Convert TOML data to TJSONData (see fpJSON in RTL). 51 | 52 | ### 🛠 TODO: 53 | 54 | - Line endings/white space rules are not 100% correct 55 | - Output TOML data structures as TOML text. 56 | - Better support for building TOML data programmatically. 57 | -------------------------------------------------------------------------------- /tests/pass/t13.toml: -------------------------------------------------------------------------------- 1 | # Array of Tables 2 | # The last type that has not yet been expressed is an array of tables. 3 | # These can be expressed by using a table name in double brackets. Under that, 4 | # and until the next table or EOF are the key/values of that table. Each table 5 | # with the same double bracketed name will be an element in the array of tables. 6 | # The tables are inserted in the order encountered. A double bracketed table 7 | # without any key/value pairs will be considered an empty table. 8 | 9 | [[products]] 10 | name = "Hammer" 11 | sku = 738594937 12 | 13 | [[products]] 14 | 15 | [[products]] 16 | name = "Nail" 17 | sku = 284758393 18 | color = "gray" 19 | 20 | # In JSON land, that would give you the following structure. 21 | 22 | # { 23 | # "products": [ 24 | # { "name": "Hammer", "sku": 738594937 }, 25 | # { }, 26 | # { "name": "Nail", "sku": 284758393, "color": "gray" } 27 | # ] 28 | # } 29 | 30 | # You can create nested arrays of tables as well. Just use the same double bracket 31 | # syntax on sub-tables. Each double-bracketed sub-table will belong to the most recently defined table element. 32 | # Normal sub-tables (not arrays) likewise belong to the most recently defined table element. 33 | 34 | [[fruit]] 35 | name = "apple" 36 | 37 | [fruit.physical] # subtable 38 | color = "red" 39 | shape = "round" 40 | 41 | [[fruit.variety]] # nested array of tables 42 | name = "red delicious" 43 | 44 | [[fruit.variety]] 45 | name = "granny smith" 46 | 47 | [[fruit]] 48 | name = "banana" 49 | 50 | [[fruit.variety]] 51 | name = "plantain" 52 | 53 | # The above TOML maps to the following JSON. 54 | 55 | # { 56 | # "fruit": [ 57 | # { 58 | # "name": "apple", 59 | # "physical": { 60 | # "color": "red", 61 | # "shape": "round" 62 | # }, 63 | # "variety": [ 64 | # { "name": "red delicious" }, 65 | # { "name": "granny smith" } 66 | # ] 67 | # }, 68 | # { 69 | # "name": "banana", 70 | # "variety": [ 71 | # { "name": "plantain" } 72 | # ] 73 | # } 74 | # ] 75 | # } -------------------------------------------------------------------------------- /tests/pass/t8.toml: -------------------------------------------------------------------------------- 1 | # String 2 | # There are four ways to express strings: basic, multi-line basic, literal, and multi-line literal. All strings must contain only valid UTF-8 characters. 3 | 4 | # Basic strings are surrounded by quotation marks. Any Unicode character may be used except those that must be escaped: quotation mark, backslash, and the control characters other than tab (U+0000 to U+0008, U+000A to U+001F, U+007F). 5 | 6 | str = "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF." 7 | 8 | 9 | # Multi-line basic strings are surrounded by three quotation marks on each side and allow newlines. A newline immediately following the opening delimiter will be trimmed. All other whitespace and newline characters remain intact. 10 | 11 | str1 = """ 12 | Roses are red 13 | Violets are blue""" 14 | 15 | 16 | # TOML parsers should feel free to normalize newline to whatever makes sense for their platform. 17 | 18 | # On a Unix system, the above multi-line string will most likely be the same as: 19 | str2 = "Roses are red\nViolets are blue" 20 | 21 | # On a Windows system, it will most likely be equivalent to: 22 | str3 = "Roses are red\r\nViolets are blue" 23 | 24 | # Literal strings are surrounded by single quotes. Like basic strings, they must appear on a single line: 25 | 26 | # What you see is what you get. 27 | winpath = 'C:\Users\nodejs\templates' 28 | winpath2 = '\\ServerX\admin$\system32\' 29 | quoted = 'Tom "Dubs" Preston-Werner' 30 | regex = '<\i\c*\s*>' 31 | 32 | # Multi-line literal strings are surrounded by three single quotes on each side and allow newlines. Like literal strings, there is no escaping whatsoever. A newline immediately following the opening delimiter will be trimmed. All other content between the delimiters is interpreted as-is without modification. 33 | 34 | regex2 = '''I [dw]on't need \d{2} apples''' 35 | lines = ''' 36 | The first newline is 37 | trimmed in raw strings. 38 | All other whitespace 39 | is preserved. 40 | ''' 41 | 42 | # You can write 1 or 2 single quotes anywhere within a multi-line literal string, but sequences of three or more single quotes are not permitted. 43 | 44 | quot15 = '''Here are fifteen quotation marks: """""""""""""""''' 45 | 46 | # apos15 = '''Here are fifteen apostrophes: '''''''''''''''''' # INVALID 47 | apos15 = "Here are fifteen apostrophes: '''''''''''''''" 48 | 49 | # 'That's still pointless', she said. 50 | str4 = ''''That's still pointless', she said.''' -------------------------------------------------------------------------------- /tests/Tests.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2020 by Ryan Joseph 3 | 4 | TOML Parser Tests 5 | } 6 | 7 | {$mode objfpc} 8 | {$H+} 9 | 10 | program Tests; 11 | uses 12 | TOML, SysUtils, BaseUnix, Classes, FPJSON, FGL; 13 | 14 | function ScanDir(path: ansistring; fullPath: boolean = false): TStringList; 15 | var 16 | handle: PDir; 17 | entry: PDirent; 18 | name: pchar; 19 | begin 20 | result := nil; 21 | handle := fpOpenDir(path); 22 | if assigned(handle) then 23 | begin 24 | while true do 25 | begin 26 | entry := fpReadDir(handle); 27 | if assigned(entry) then 28 | begin 29 | name := pchar(@entry^.d_name[0]); 30 | if (name = '.') or (name = '..') then 31 | continue; 32 | if result = nil then 33 | result := TStringList.Create; 34 | if fullPath then 35 | result.Add(path+'/'+name) 36 | else 37 | result.Add(name); 38 | end 39 | else 40 | break; 41 | end; 42 | fpCloseDir(handle); 43 | end; 44 | end; 45 | 46 | function ReadFile(path: string): string; 47 | var 48 | list: TStringList; 49 | begin 50 | try 51 | list := TStringList.Create; 52 | list.LoadFromFile(path); 53 | result := list.Text; 54 | except 55 | on E:Exception do 56 | writeln(path+': ', E.Message); 57 | end; 58 | list.Free; 59 | end; 60 | 61 | procedure RunTests(dir: string; expectedFail: boolean; showJSON: boolean = false); 62 | var 63 | files: TStringList; 64 | name, ext, path: string; 65 | contents: string; 66 | doc: TTOMLDocument; 67 | json: TJSONData; 68 | begin 69 | dir := ExpandFileName(dir); 70 | files := ScanDir(dir, true); 71 | for path in files do 72 | begin 73 | name := ExtractFileName(path); 74 | ext := ExtractFileExt(path); 75 | if ext = '.toml' then 76 | begin 77 | write(ExtractFileName(dir), '/', name); 78 | doc := nil; 79 | contents := ReadFile(path); 80 | try 81 | doc := GetTOML(contents); 82 | if expectedFail then 83 | begin 84 | WriteLn(' 🔴 Failed!'); 85 | halt; 86 | end; 87 | except 88 | on E: Exception do 89 | begin 90 | if not expectedFail then 91 | begin 92 | WriteLn(' 🔴 ', E.Message); 93 | halt; 94 | end; 95 | end; 96 | end; 97 | if showJSON then 98 | begin 99 | json := doc.AsJSON; 100 | writeln(json.FormatJSON); 101 | json.Free; 102 | end; 103 | doc.Free; 104 | writeln(' ✓'); 105 | end; 106 | end; 107 | writeln('🟢 All tests passed!'); 108 | end; 109 | 110 | begin 111 | RunTests('./pass', false); 112 | RunTests('./fail', true); 113 | end. -------------------------------------------------------------------------------- /sources/TOML.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2020 by Ryan Joseph 3 | 4 | Main unit for fpTOML parser 5 | 6 | ******************************************************************** 7 | 8 | Permission is hereby granted, free of charge, to any person obtaining 9 | a copy of this software and associated documentation files (the "Software"), 10 | to deal in the Software without restriction, including without limitation 11 | the rights to use, copy, modify, merge, publish, distribute, sublicense, 12 | and/or sell copies of the Software, and to permit persons to whom the 13 | Software is furnished to do so, subject to the following conditions: 14 | 15 | The above copyright notice and this permission notice shall be included in 16 | all copies or substantial portions of the Software. 17 | 18 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 19 | INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A 20 | PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 21 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 22 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE 23 | OR OTHER DEALINGS IN THE SOFTWARE. 24 | } 25 | 26 | {$mode objfpc} 27 | {$unitpath sources} 28 | 29 | unit TOML; 30 | interface 31 | uses 32 | TOMLParser, 33 | TOMLTypes; 34 | 35 | type 36 | TTOMLStringType = TOMLTypes.TTOMLStringType; 37 | TTOMLKeyType = TOMLTypes.TTOMLStringType; 38 | TTOMLValueType = TOMLTypes.TTOMLStringType; 39 | TTOMLNumberType = TOMLTypes.TTOMLStringType; 40 | 41 | type 42 | TTOMLData = TOMLTypes.TTOMLData; 43 | TTOMLValue = TOMLTypes.TTOMLValue; 44 | TTOMLNumber = TOMLTypes.TTOMLNumber; 45 | TTOMLDate = TOMLTypes.TTOMLDate; 46 | TTOMLArray = TOMLTypes.TTOMLArray; 47 | TTOMLTable = TOMLTypes.TTOMLTable; 48 | TTOMLDocument = TOMLTypes.TTOMLDocument; 49 | 50 | function GetTOML(contents: TTOMLStringType): TTOMLDocument; 51 | 52 | { TOMLData Operators } 53 | 54 | operator Explicit (right: TTOMLData): ansistring; overload; 55 | operator Explicit (right: TTOMLData): shortstring; overload; 56 | operator Explicit (right: TTOMLData): integer; overload; 57 | operator Explicit (right: TTOMLData): single; overload; 58 | operator Explicit (right: TTOMLData): double; overload; 59 | 60 | operator := (right: variant): TTOMLData; 61 | 62 | implementation 63 | 64 | { TOMLData Operators } 65 | 66 | operator := (right: variant): TTOMLData; 67 | begin 68 | result := TTOMLValue.Create(right); 69 | end; 70 | 71 | operator Explicit (right: TTOMLData): ansistring; 72 | begin 73 | result := right.ToString; 74 | end; 75 | 76 | operator Explicit (right: TTOMLData): shortstring; 77 | begin 78 | result := right.ToString; 79 | end; 80 | 81 | operator Explicit (right: TTOMLData): integer; 82 | begin 83 | result := right.ToInteger; 84 | end; 85 | 86 | operator Explicit (right: TTOMLData): single; 87 | begin 88 | result := right.ToFloat; 89 | end; 90 | 91 | operator Explicit (right: TTOMLData): double; 92 | begin 93 | result := right.ToFloat; 94 | end; 95 | 96 | function GetTOML(contents: TTOMLStringType): TTOMLDocument; 97 | begin 98 | result := TOMLParser.GetTOML(contents); 99 | end; 100 | 101 | end. -------------------------------------------------------------------------------- /sources/Scanner.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2020 by Ryan Joseph 3 | 4 | This unit implements a basic tokenizer 5 | 6 | ******************************************************************** 7 | 8 | Permission is hereby granted, free of charge, to any person obtaining 9 | a copy of this software and associated documentation files (the "Software"), 10 | to deal in the Software without restriction, including without limitation 11 | the rights to use, copy, modify, merge, publish, distribute, sublicense, 12 | and/or sell copies of the Software, and to permit persons to whom the 13 | Software is furnished to do so, subject to the following conditions: 14 | 15 | The above copyright notice and this permission notice shall be included in 16 | all copies or substantial portions of the Software. 17 | 18 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 19 | INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A 20 | PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 21 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 22 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE 23 | OR OTHER DEALINGS IN THE SOFTWARE. 24 | } 25 | 26 | {$mode objfpc} 27 | {$modeswitch advancedrecords} 28 | {$modeswitch typehelpers} 29 | 30 | unit Scanner; 31 | interface 32 | uses 33 | SysUtils; 34 | 35 | type 36 | EScanner = class(Exception); 37 | EScannerClass = class of EScanner; 38 | TScanner = class 39 | private type 40 | TFileInfo = record 41 | line: integer; 42 | column: integer; 43 | end; 44 | private 45 | currentIndex: integer; 46 | fileInfo: TFileInfo; 47 | consumedLineEnding: boolean; 48 | protected type 49 | {$scopedenums on} 50 | TIdentifier = Ansistring; 51 | TToken = (Unknown, 52 | // patterns 53 | ID, 54 | Integer, 55 | RealNumber, 56 | HexadecimalNumber, 57 | OctalNumber, 58 | BinaryNumber, 59 | // symbols 60 | DoubleQuote, 61 | SingleQuote, 62 | SquareBracketOpen, 63 | SquareBracketClosed, 64 | ParenthasisOpen, 65 | ParenthasisClosed, 66 | CurlyBracketOpen, 67 | CurlyBracketClosed, 68 | AngleBracketOpen, 69 | AngleBracketClosed, 70 | Equals, 71 | Colon, 72 | Comma, 73 | Semicolon, 74 | QuestionMark, 75 | ForwardSlash, 76 | BackSlash, 77 | ExclamationMark, 78 | Ampersand, 79 | Dash, 80 | Dot, 81 | Plus, 82 | EOL, 83 | EOF 84 | ); 85 | {$scopedenums off} 86 | protected 87 | contents: ansistring; 88 | pattern: ansistring; 89 | token: TToken; 90 | c: char; 91 | readLineEndingsAsTokens: boolean; 92 | protected 93 | procedure Consume; inline; 94 | procedure Consume(t: TToken); 95 | procedure Consume(inChar: char); 96 | function TryConsume(t: TToken): boolean; 97 | function TryConsume(t: TToken; out s: shortstring): boolean; inline; 98 | function TryConsume(t: TToken; out s: ansistring): boolean; inline; 99 | 100 | function ReadToken: TToken; 101 | function ReadTo(count: integer): TToken; 102 | function ReadChar: char; 103 | function ReadWord: TIdentifier; virtual; 104 | function ReadNumber: string; virtual; 105 | function ReadString(count: integer): string; 106 | 107 | procedure ReadUntilEOL; 108 | procedure SkipSpace; 109 | 110 | function IsLineEnding: boolean; 111 | function IsWhiteSpace: boolean; 112 | 113 | procedure Advance(count: integer); 114 | procedure AdvancePattern(count: integer = 1); 115 | 116 | function Peek(offset: integer = 1): char; overload; 117 | function Peek(str: string; offset: integer = 0): boolean; overload; 118 | function PeekString(count: integer): string; 119 | 120 | { Errors } 121 | procedure ParserError (messageString: string = ''); 122 | function GetException: EScannerClass; virtual; 123 | 124 | { Handlers } 125 | procedure ParseToken; virtual; 126 | procedure UnknownCharacter(out cont: boolean); virtual; 127 | public 128 | constructor Create(str: ansistring); 129 | procedure Parse; virtual; 130 | destructor Destroy; override; 131 | end; 132 | 133 | type 134 | TTokenMethods = type helper for TScanner.TToken 135 | function ToString: string; 136 | end; 137 | 138 | implementation 139 | 140 | {$macro on} 141 | {$define TCharSetLineEnding:=#10, #12, #13} 142 | {$define TCharSetWhiteSpace:=' ', ' '} 143 | {$define TCharSetWord:='a'..'z','A'..'Z','_'} 144 | {$define TCharSetInteger:='0'..'9'} 145 | {$define TCharSetQuotes:='"', ''''} 146 | 147 | function TTokenMethods.ToString: string; 148 | begin 149 | case self of 150 | TScanner.TToken.ID: 151 | result := 'ID'; 152 | TScanner.TToken.Integer: 153 | result := 'Integer'; 154 | TScanner.TToken.RealNumber: 155 | result := 'Real'; 156 | TScanner.TToken.DoubleQuote: 157 | result := '"'; 158 | TScanner.TToken.SingleQuote: 159 | result := ''''; 160 | TScanner.TToken.SquareBracketOpen: 161 | result := '['; 162 | TScanner.TToken.SquareBracketClosed: 163 | result := ']'; 164 | TScanner.TToken.ParenthasisOpen: 165 | result := '('; 166 | TScanner.TToken.ParenthasisClosed: 167 | result := ')'; 168 | TScanner.TToken.CurlyBracketOpen: 169 | result := '{'; 170 | TScanner.TToken.CurlyBracketClosed: 171 | result := '}'; 172 | TScanner.TToken.AngleBracketOpen: 173 | result := '<'; 174 | TScanner.TToken.AngleBracketClosed: 175 | result := '>'; 176 | TScanner.TToken.Equals: 177 | result := '='; 178 | TScanner.TToken.Colon: 179 | result := ':'; 180 | TScanner.TToken.Comma: 181 | result := ','; 182 | TScanner.TToken.Semicolon: 183 | result := ';'; 184 | TScanner.TToken.QuestionMark: 185 | result := '?'; 186 | TScanner.TToken.ExclamationMark: 187 | result := '!'; 188 | TScanner.TToken.ForwardSlash: 189 | result := '/'; 190 | TScanner.TToken.BackSlash: 191 | result := '\'; 192 | TScanner.TToken.Ampersand: 193 | result := '&'; 194 | TScanner.TToken.Dash: 195 | result := '-'; 196 | TScanner.TToken.Dot: 197 | result := '.'; 198 | TScanner.TToken.Plus: 199 | result := '+'; 200 | TScanner.TToken.EOF: 201 | result := 'End of File'; 202 | TScanner.TToken.EOL: 203 | result := 'End of Line'; 204 | otherwise 205 | raise exception.create('invalid token'); 206 | end; 207 | end; 208 | 209 | procedure TScanner.Consume; 210 | begin 211 | Consume(token); 212 | end; 213 | 214 | procedure TScanner.Consume(t: TToken); 215 | begin 216 | if token = t then 217 | ReadToken 218 | else 219 | ParserError('Got "'+token.ToString+'", expected "'+t.ToString+'"'); 220 | end; 221 | 222 | procedure TScanner.Consume(inChar: char); 223 | begin 224 | if c = inChar then 225 | AdvancePattern 226 | else 227 | ParserError('Got "'+c+'", expected "'+inChar+'"'); 228 | end; 229 | 230 | function TScanner.TryConsume(t: TToken; out s: shortstring): boolean; inline; 231 | begin 232 | s := pattern; 233 | result := TryConsume(t); 234 | end; 235 | 236 | function TScanner.TryConsume(t: TToken; out s: ansistring): boolean; 237 | begin 238 | s := pattern; 239 | result := TryConsume(t); 240 | end; 241 | 242 | function TScanner.TryConsume(t: TToken): boolean; 243 | begin 244 | if token = t then 245 | begin 246 | ReadToken; 247 | result := true; 248 | end 249 | else 250 | result := false; 251 | end; 252 | 253 | procedure TScanner.ReadUntilEOL; 254 | begin 255 | repeat 256 | ReadChar; 257 | until IsLineEnding; 258 | end; 259 | 260 | procedure TScanner.SkipSpace; 261 | begin 262 | consumedLineEnding := false; 263 | while IsWhiteSpace do 264 | begin 265 | if IsLineEnding then 266 | consumedLineEnding := true; 267 | ReadChar; 268 | end; 269 | end; 270 | 271 | function TScanner.IsLineEnding: boolean; 272 | begin 273 | result := c in [TCharSetLineEnding]; 274 | end; 275 | 276 | function TScanner.IsWhiteSpace: boolean; 277 | begin 278 | result := (c in [TCharSetWhiteSpace]) or IsLineEnding; 279 | end; 280 | 281 | function TScanner.Peek(offset: integer = 1): char; 282 | begin 283 | if currentIndex + offset < length(contents) then 284 | result := contents[currentIndex + offset] 285 | else 286 | result := #0; 287 | end; 288 | 289 | function TScanner.Peek(str: string; offset: integer = 0): boolean; 290 | var 291 | i, contentsOffset: integer; 292 | begin 293 | result := false; 294 | for i := 0 to length(str) - 1 do 295 | begin 296 | contentsOffset := currentIndex + offset + i; 297 | if (contentsOffset < length(contents)) and (contents[contentsOffset] = str[i + 1]) then 298 | result := true 299 | else 300 | exit(false); 301 | end; 302 | end; 303 | 304 | function TScanner.PeekString(count: integer): string; 305 | var 306 | i: integer; 307 | begin 308 | result := ''; 309 | for i := 0 to count - 1 do 310 | result += contents[currentIndex + i]; 311 | end; 312 | 313 | function TScanner.ReadString(count: integer): string; 314 | begin 315 | pattern := ''; 316 | while count > 0 do 317 | begin 318 | pattern += c; 319 | ReadChar; 320 | Dec(count); 321 | end; 322 | result := pattern; 323 | end; 324 | 325 | function TScanner.ReadChar: char; 326 | begin 327 | if IsLineEnding then 328 | begin 329 | fileInfo.line += 1; 330 | fileInfo.column := 0; 331 | end; 332 | currentIndex += 1; 333 | c := contents[currentIndex]; 334 | fileInfo.column += 1; 335 | result := c; 336 | end; 337 | 338 | function TScanner.ReadWord: TIdentifier; 339 | begin 340 | pattern := ''; 341 | while c in [TCharSetWord, TCharSetInteger] do 342 | begin 343 | pattern += c; 344 | ReadChar; 345 | end; 346 | result := pattern; 347 | end; 348 | 349 | 350 | { Appends character the current pattern and reads next character } 351 | procedure TScanner.AdvancePattern(count: integer = 1); 352 | begin 353 | while count > 0 do 354 | begin 355 | pattern += c; 356 | ReadChar; 357 | Dec(count); 358 | end; 359 | end; 360 | 361 | { Moves the scanner by 'count' characters } 362 | procedure TScanner.Advance(count: integer); 363 | begin 364 | while count > 0 do 365 | begin 366 | ReadChar; 367 | Dec(count); 368 | end; 369 | end; 370 | 371 | { Advances by "count" and reads token at new position } 372 | function TScanner.ReadTo(count: integer): TToken; 373 | begin 374 | Advance(count); 375 | result := ReadToken; 376 | end; 377 | 378 | 379 | function TScanner.ReadNumber: string; 380 | begin 381 | pattern := ''; 382 | token := TToken.Integer; 383 | 384 | if c = '-' then 385 | AdvancePattern; 386 | 387 | if c = '+' then 388 | AdvancePattern; 389 | 390 | while c in [TCharSetInteger, '.', 'e'] do 391 | begin 392 | // TODO: must be followed by a number! 393 | if c = 'e' then 394 | begin 395 | AdvancePattern; 396 | if c = '-' then 397 | begin 398 | AdvancePattern; 399 | while c in [TCharSetInteger] do 400 | AdvancePattern; 401 | break; 402 | end; 403 | end 404 | else if c = '.' then 405 | token := TToken.RealNumber; 406 | AdvancePattern; 407 | end; 408 | 409 | result := pattern; 410 | end; 411 | 412 | function TScanner.GetException: EScannerClass; 413 | begin 414 | result := EScanner; 415 | end; 416 | 417 | procedure TScanner.ParserError(messageString: string = ''); 418 | begin 419 | // in case we pass in line ending from the current character "c" 420 | // replace these with something human readable 421 | messageString := StringReplace(messageString, #10, 'EOL', []); 422 | messageString := StringReplace(messageString, #12, 'EOL', []); 423 | messageString := StringReplace(messageString, #13, 'EOL', []); 424 | raise GetException.Create('Error at '+IntToStr(fileInfo.line)+':'+IntToStr(fileInfo.column)+': '+messageString); 425 | end; 426 | 427 | procedure TScanner.UnknownCharacter(out cont: boolean); 428 | begin 429 | ParserError('unknown character "'+c+'"'); 430 | end; 431 | 432 | function TScanner.ReadToken: TToken; 433 | label 434 | TokenRead; 435 | var 436 | cont: boolean; 437 | begin 438 | while currentIndex < length(contents) do 439 | begin 440 | //writeln(' ', currentIndex, ':', c); 441 | case c of 442 | '+': 443 | begin 444 | if Peek in [TCharSetInteger] then 445 | begin 446 | ReadNumber; 447 | goto TokenRead; 448 | end 449 | else 450 | begin 451 | token := TToken.Plus; 452 | ReadChar; 453 | goto TokenRead; 454 | end; 455 | end; 456 | '-': 457 | begin 458 | if Peek in [TCharSetInteger] then 459 | begin 460 | ReadNumber; 461 | goto TokenRead; 462 | end 463 | else 464 | begin 465 | token := TToken.Dash; 466 | ReadChar; 467 | goto TokenRead; 468 | end; 469 | end; 470 | TCharSetInteger: 471 | begin 472 | ReadNumber; 473 | goto TokenRead; 474 | end; 475 | TCharSetWord: 476 | begin 477 | token := TToken.ID; 478 | ReadWord; 479 | goto TokenRead; 480 | end; 481 | '[': 482 | begin 483 | token := TToken.SquareBracketOpen; 484 | ReadChar; 485 | goto TokenRead; 486 | end; 487 | ']': 488 | begin 489 | token := TToken.SquareBracketClosed; 490 | ReadChar; 491 | goto TokenRead; 492 | end; 493 | '(': 494 | begin 495 | token := TToken.ParenthasisOpen; 496 | ReadChar; 497 | goto TokenRead; 498 | end; 499 | ')': 500 | begin 501 | token := TToken.ParenthasisClosed; 502 | ReadChar; 503 | goto TokenRead; 504 | end; 505 | '{': 506 | begin 507 | token := TToken.CurlyBracketOpen; 508 | ReadChar; 509 | goto TokenRead; 510 | end; 511 | '}': 512 | begin 513 | token := TToken.CurlyBracketClosed; 514 | ReadChar; 515 | goto TokenRead; 516 | end; 517 | '<': 518 | begin 519 | token := TToken.AngleBracketOpen; 520 | ReadChar; 521 | goto TokenRead; 522 | end; 523 | '>': 524 | begin 525 | token := TToken.AngleBracketClosed; 526 | ReadChar; 527 | goto TokenRead; 528 | end; 529 | '=': 530 | begin 531 | token := TToken.Equals; 532 | ReadChar; 533 | goto TokenRead; 534 | end; 535 | ':': 536 | begin 537 | token := TToken.Colon; 538 | ReadChar; 539 | goto TokenRead; 540 | end; 541 | ',': 542 | begin 543 | token := TToken.Comma; 544 | ReadChar; 545 | goto TokenRead; 546 | end; 547 | ';': 548 | begin 549 | token := TToken.Semicolon; 550 | ReadChar; 551 | goto TokenRead; 552 | end; 553 | '?': 554 | begin 555 | token := TToken.QuestionMark; 556 | ReadChar; 557 | goto TokenRead; 558 | end; 559 | '!': 560 | begin 561 | token := TToken.ExclamationMark; 562 | ReadChar; 563 | goto TokenRead; 564 | end; 565 | '.': 566 | begin 567 | token := TToken.Dot; 568 | ReadChar; 569 | goto TokenRead; 570 | end; 571 | '/': 572 | begin 573 | token := TToken.ForwardSlash; 574 | ReadChar; 575 | goto TokenRead; 576 | end; 577 | '\': 578 | begin 579 | token := TToken.BackSlash; 580 | ReadChar; 581 | goto TokenRead; 582 | end; 583 | TCharSetLineEnding, 584 | TCharSetWhiteSpace: 585 | begin 586 | SkipSpace; 587 | if consumedLineEnding and readLineEndingsAsTokens then 588 | begin 589 | token := TToken.EOL; 590 | consumedLineEnding := false; 591 | goto TokenRead; 592 | end; 593 | end; 594 | otherwise 595 | begin 596 | cont := false; 597 | UnknownCharacter(cont); 598 | if cont then 599 | continue; 600 | goto TokenRead; 601 | end; 602 | end; 603 | end; 604 | 605 | // if we got here we reached the end 606 | token := TToken.EOF; 607 | 608 | TokenRead: 609 | result := token; 610 | end; 611 | 612 | procedure TScanner.ParseToken; 613 | begin 614 | end; 615 | 616 | procedure TScanner.Parse; 617 | begin 618 | ReadToken; 619 | while token <> TToken.EOF do 620 | ParseToken; 621 | end; 622 | 623 | constructor TScanner.Create(str: ansistring); 624 | begin 625 | contents := str; 626 | contents += #0; 627 | currentIndex := 1; 628 | fileInfo.line := 1; 629 | fileInfo.column := 1; 630 | c := contents[currentIndex]; 631 | end; 632 | 633 | destructor TScanner.Destroy; 634 | begin 635 | end; 636 | 637 | end. -------------------------------------------------------------------------------- /sources/TOMLTypes.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2020 by Ryan Joseph 3 | 4 | TOML Parser 5 | This unit implements the TOML data types 6 | 7 | ******************************************************************** 8 | 9 | Permission is hereby granted, free of charge, to any person obtaining 10 | a copy of this software and associated documentation files (the "Software"), 11 | to deal in the Software without restriction, including without limitation 12 | the rights to use, copy, modify, merge, publish, distribute, sublicense, 13 | and/or sell copies of the Software, and to permit persons to whom the 14 | Software is furnished to do so, subject to the following conditions: 15 | 16 | The above copyright notice and this permission notice shall be included in 17 | all copies or substantial portions of the Software. 18 | 19 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 20 | INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A 21 | PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 22 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 23 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE 24 | OR OTHER DEALINGS IN THE SOFTWARE. 25 | } 26 | 27 | {$mode objfpc} 28 | {$modeswitch advancedrecords} 29 | {$scopedenums on} 30 | 31 | unit TOMLTypes; 32 | interface 33 | uses 34 | FGL, FPJSON, Classes, SysUtils; 35 | 36 | type 37 | TTOMLStringType = AnsiString; 38 | TTOMLKeyType = ShortString; 39 | TTOMLFloat = Double; 40 | TTOMLValueType = Variant; 41 | TTOMLNumberType = (Integer, 42 | Float, 43 | Octal, 44 | Boolean, 45 | Binary, 46 | Hexadecimal); 47 | 48 | { TTOMLData } 49 | 50 | ETOMLData = class(Exception); 51 | TTOMLData = class 52 | private type 53 | TEnumerator = record 54 | private 55 | container: TTOMLData; 56 | currentValue: TTOMLData; 57 | index: integer; 58 | public 59 | constructor Create(inContainer: TTOMLData); 60 | function MoveNext: Boolean; 61 | procedure Reset; 62 | property CurrentIndex: integer read index; 63 | property Current: TTOMLData read currentValue; 64 | end; 65 | private 66 | function GetItem(index: integer): TTOMLData; overload; virtual; 67 | function GetItem(key: TTOMLKeyType): TTOMLData; overload; virtual; 68 | procedure SetItem(index: integer; item: TTOMLData); virtual; overload; 69 | procedure SetItem(key: TTOMLKeyType; item: TTOMLData); virtual; overload; 70 | public 71 | parent: TTOMLData; 72 | public 73 | function ToInteger: integer; virtual; 74 | function ToFloat: TTOMLFloat; virtual; 75 | function AsJSON: TJSONData; virtual; 76 | function Count: integer; virtual; 77 | property Items[index: integer]: TTOMLData read GetItem write SetItem; default; 78 | function GetEnumerator: TEnumerator; 79 | end; 80 | TTOMLDataList = specialize TFPGObjectList; 81 | TTOMLDataMap = specialize TFPGMapObject; 82 | TTOMLDataClass = class of TTOMLData; 83 | 84 | { TTOMLValue } 85 | 86 | TTOMLValue = class(TTOMLData) 87 | private 88 | m_value: TTOMLValueType; 89 | public 90 | constructor Create(const inValue: TTOMLValueType); 91 | function ToString: ansistring; override; 92 | function ToInteger: integer; override; 93 | function ToFloat: TTOMLFloat; override; 94 | function AsJSON: TJSONData; override; 95 | function TypeString: String; 96 | property Value: TTOMLValueType read m_value; 97 | end; 98 | 99 | { TTOMLNumber } 100 | 101 | TTOMLNumber = class(TTOMLValue) 102 | private 103 | m_type: TTOMLNumberType; 104 | public 105 | constructor Create(const inValue: TTOMLValueType; const inType: TTOMLNumberType); 106 | property &Type: TTOMLNumberType read m_type; 107 | end; 108 | 109 | { TTOMLDate } 110 | 111 | TTOMLDate = class(TTOMLData) 112 | public type 113 | TTime = record 114 | hours: integer; 115 | minutes: integer; 116 | seconds: double; 117 | { A suffix which, when applied to a time, denotes a UTC 118 | offset of 00:00; often spoken "Zulu" from the ICAO 119 | phonetic alphabet representation of the letter "Z". } 120 | z: boolean; 121 | function IsSet: boolean; 122 | end; 123 | public 124 | year: integer; 125 | month: integer; 126 | day: integer; 127 | time: TTime; 128 | 129 | { To unambiguously represent a specific instant in time, 130 | you may use an RFC 3339 formatted date-time with offset. 131 | https://tools.ietf.org/html/rfc3339} 132 | 133 | offset: TTime; 134 | public 135 | constructor Create(localTime: TTime); overload; 136 | 137 | function ToString: ansistring; override; 138 | function AsJSON: TJSONData; override; 139 | function ToISO8601String(roundSeconds: boolean = true): string; 140 | function AsDateTime: TDateTime; 141 | end; 142 | 143 | { TTOMLContainer } 144 | 145 | TTOMLContainer = class(TTOMLData); 146 | TTOMLContainerList = specialize TFPGList; 147 | 148 | { TTOMLArray } 149 | 150 | TTOMLArray = class(TTOMLContainer) 151 | private 152 | list: TTOMLDataList; 153 | function GetItem(index: integer): TTOMLData; override; 154 | public 155 | terminated: boolean; 156 | public 157 | constructor Create; 158 | destructor Destroy; override; 159 | 160 | procedure Add(const value: TTOMLValueType); overload; 161 | procedure Add(const data: TTOMLData); overload; 162 | 163 | function Last: TTOMLData; 164 | function AsJSON: TJSONData; override; 165 | function AsStrings: TStringList; 166 | function AsArray: TStringArray; 167 | function Count: integer; override; 168 | end; 169 | 170 | { TTOMLTable } 171 | 172 | TTOMLTable = class(TTOMLContainer) 173 | private 174 | map: TTOMLDataMap; 175 | m_name: string; 176 | function GetItem(key: TTOMLKeyType): TTOMLData; override; 177 | function GetItem(index: integer): TTOMLData; override; 178 | procedure SetItem(key: TTOMLKeyType; item: TTOMLData); override; 179 | function GetKey(index: integer): TTOMLKeyType; 180 | public 181 | defined: boolean; 182 | terminated: boolean; 183 | parentIsArray: boolean; 184 | public 185 | constructor Create(name: string = ''); 186 | destructor Destroy; override; 187 | 188 | procedure Add(const key: TTOMLKeyType; const value: TTOMLValueType); overload; 189 | procedure Add(const key: TTOMLKeyType; const data: TTOMLData); overload; 190 | procedure Put(const key: String; const value: TTOMLValueType); overload; 191 | procedure Put(const key: String; const data: TTOMLData); overload; 192 | 193 | function Find(const key: TTOMLKeyType): TTOMLData; 194 | function Contains(const key: TTOMLKeyType; dataType: TTOMLDataClass = nil): boolean; 195 | function AsJSON: TJSONData; override; 196 | function Count: integer; override; 197 | 198 | property Name: string read m_name; 199 | property Keys[Index: Integer]: TTOMLKeyType read GetKey; 200 | property Values[Index: Integer]: TTOMLData read GetItem; 201 | end; 202 | 203 | { TTOMLDocument } 204 | 205 | TTOMLDocument = class(TTOMLTable); 206 | 207 | implementation 208 | uses 209 | Variants, Types, DateUtils; 210 | 211 | { TTOMLData } 212 | 213 | function TTOMLData.GetEnumerator: TEnumerator; 214 | begin 215 | result := TEnumerator.Create(self); 216 | end; 217 | 218 | constructor TTOMLData.TEnumerator.Create(inContainer: TTOMLData); 219 | begin 220 | container := inContainer; 221 | index := 0; 222 | end; 223 | 224 | function TTOMLData.TEnumerator.MoveNext: Boolean; 225 | var 226 | count: integer; 227 | begin 228 | count := container.Count; 229 | if index = count then 230 | exit(false); 231 | while index < count do 232 | begin 233 | currentValue := container[index]; 234 | index += 1; 235 | if currentValue <> Default(TTOMLData) then 236 | break; 237 | end; 238 | result := index <= count; 239 | end; 240 | 241 | procedure TTOMLData.TEnumerator.Reset; 242 | begin 243 | index := 0; 244 | end; 245 | 246 | function TTOMLData.GetItem(index: integer): TTOMLData; 247 | begin 248 | Assert(false, ClassName+' doesn''t implement indexing'); 249 | result := nil; 250 | end; 251 | 252 | function TTOMLData.GetItem(key: TTOMLKeyType): TTOMLData; 253 | begin 254 | Assert(false, ClassName+' doesn''t implement keys'); 255 | result := nil; 256 | end; 257 | 258 | procedure TTOMLData.SetItem(index: integer; item: TTOMLData); 259 | begin 260 | Assert(false, ClassName+' doesn''t implement setting by index'); 261 | end; 262 | 263 | procedure TTOMLData.SetItem(key: TTOMLKeyType; item: TTOMLData); 264 | begin 265 | Assert(false, ClassName+' doesn''t implement setting by key'); 266 | end; 267 | 268 | function TTOMLData.Count: integer; 269 | begin 270 | Assert(false, ClassName+' doesn''t implement indexing'); 271 | result := 0; 272 | end; 273 | 274 | function TTOMLData.AsJSON: TJSONData; 275 | begin 276 | Assert(false, 'TOML data can''t be converted to JSON'); 277 | result := nil; 278 | end; 279 | 280 | function TTOMLData.ToInteger: integer; 281 | begin 282 | Assert(false, 'TOML data can''t be converted to integer'); 283 | result := 0; 284 | end; 285 | 286 | function TTOMLData.ToFloat: TTOMLFloat; 287 | begin 288 | Assert(false, 'TOML data can''t be converted to float'); 289 | result := 0; 290 | end; 291 | 292 | { TTOMLValue } 293 | 294 | function TTOMLValue.TypeString: String; 295 | begin 296 | case VarType(value) of 297 | varEmpty: result := 'Empty'; 298 | varNull: result := 'Null'; 299 | varSingle: result := 'Single'; 300 | varDouble: result := 'Double'; 301 | varDecimal: result := 'Decimal'; 302 | varCurrency: result := 'Currency'; 303 | varDate: result := 'Date'; 304 | varOleStr: result := 'UnicodeString'; 305 | varString: result := 'Dynamic string'; 306 | varBoolean: result := 'Boolean'; 307 | varVariant: result := 'Variant'; 308 | varUnknown: result := 'unknown'; 309 | varShortInt: result := 'ShortInt'; 310 | varSmallint: result := 'Smallint'; 311 | varInteger: result := 'Integer'; 312 | varInt64: result := 'Int64'; 313 | varByte: result := 'Byte'; 314 | varWord: result := 'Word'; 315 | varLongWord: result := 'LongWord'; 316 | varQWord: result := 'QWord'; 317 | varError: result := 'ERROR'; 318 | otherwise 319 | result := 'unknown'; 320 | end; 321 | end; 322 | 323 | function TTOMLValue.AsJSON: TJSONData; 324 | begin 325 | case VarType(value) of 326 | varSingle, 327 | varDouble, 328 | varDecimal, 329 | varCurrency: 330 | result := CreateJSON(Double(value)); 331 | varDate: 332 | ; 333 | varOleStr, 334 | varStrArg, 335 | varString: 336 | result := CreateJSON(TTOMLStringType(value)); 337 | varBoolean: 338 | result := CreateJSON(Boolean(value)); 339 | varShortInt, 340 | varSmallint, 341 | varInteger, 342 | varInt64, 343 | varByte, 344 | varWord, 345 | varLongWord, 346 | varQWord: 347 | result := CreateJSON(LongInt(value)); 348 | otherwise 349 | Assert(false, 'TOML value '+IntToStr(VarType(value))+' couldn''t be mapped to JSON value.'); 350 | end; 351 | end; 352 | 353 | function TTOMLValue.ToInteger: integer; 354 | begin 355 | result := integer(value); 356 | end; 357 | 358 | function TTOMLValue.ToFloat: TTOMLFloat; 359 | begin 360 | result := TTOMLFloat(value); 361 | end; 362 | 363 | function TTOMLValue.ToString: ansistring; 364 | begin 365 | result := ansistring(value); 366 | end; 367 | 368 | constructor TTOMLValue.Create(const inValue: TTOMLValueType); 369 | begin 370 | m_value := inValue; 371 | end; 372 | 373 | { TTOMLDate } 374 | 375 | function TTOMLDate.TTime.IsSet: boolean; 376 | begin 377 | result := (hours > 0) or (minutes > 0) or (seconds > 0); 378 | end; 379 | 380 | constructor TTOMLDate.Create(localTime: TTime); 381 | begin 382 | time := localTime; 383 | end; 384 | 385 | function TTOMLDate.ToString: ansistring; 386 | begin 387 | result := ToISO8601String(false); 388 | end; 389 | 390 | function TTOMLDate.ToISO8601String(roundSeconds: boolean): string; 391 | var 392 | s: string; 393 | begin 394 | 395 | result := Format('%.*d',[4, year])+'-'+ 396 | Format('%.*d',[2, month])+'-'+ 397 | Format('%.*d',[2, day]); 398 | 399 | if time.IsSet then 400 | begin 401 | result += 'T'; 402 | result += Format('%.*d',[2, time.hours])+':'+ 403 | Format('%.*d',[2, time.minutes])+':'; 404 | 405 | if roundSeconds then 406 | result += Format('%.*d',[2, Trunc(time.seconds)]) 407 | else 408 | begin 409 | s := FloatToStr(time.seconds); 410 | if length(s) = 1 then 411 | result += '0'; 412 | result += s; 413 | end; 414 | 415 | if time.Z then 416 | result += 'Z'; 417 | 418 | if offset.IsSet then 419 | begin 420 | result += '-'; 421 | result += Format('%.*d',[2, time.hours])+':'+ 422 | Format('%.*d',[2, time.minutes]); 423 | end; 424 | end; 425 | end; 426 | 427 | function TTOMLDate.AsJSON: TJSONData; 428 | begin 429 | result := CreateJSON(ToString); 430 | end; 431 | 432 | function TTOMLDate.AsDateTime: TDateTime; 433 | begin 434 | result := ISO8601ToDate(ToISO8601String); 435 | end; 436 | 437 | { TTOMLNumber } 438 | 439 | constructor TTOMLNumber.Create(const inValue: TTOMLValueType; const inType: TTOMLNumberType); 440 | begin 441 | m_value := inValue; 442 | m_type := inType; 443 | end; 444 | 445 | { TTOMLArray } 446 | 447 | function TTOMLArray.GetItem(index: integer): TTOMLData; 448 | begin 449 | result := list[index]; 450 | end; 451 | 452 | function TTOMLArray.AsStrings: TStringList; 453 | var 454 | data: TTOMLData; 455 | begin 456 | result := TStringList.Create; 457 | for data in list do 458 | result.Add(AnsiString(data)); 459 | end; 460 | 461 | function TTOMLArray.AsArray: TStringArray; 462 | var 463 | i: integer; 464 | begin 465 | result := nil; 466 | SetLength(result, Count); 467 | for i := 0 to Count - 1 do 468 | result[i] := AnsiString(list[i]); 469 | end; 470 | 471 | function TTOMLArray.AsJSON: TJSONData; 472 | var 473 | arr: TJSONArray; 474 | data: TTOMLData; 475 | begin 476 | arr := TJSONArray.Create; 477 | for data in list do 478 | arr.Add(data.AsJSON); 479 | result := arr; 480 | end; 481 | 482 | function TTOMLArray.Last: TTOMLData; 483 | begin 484 | result := list.Last; 485 | end; 486 | 487 | function TTOMLArray.Count: integer; 488 | begin 489 | result := list.Count; 490 | end; 491 | 492 | procedure TTOMLArray.Add(const value: TTOMLValueType); 493 | begin 494 | Add(TTOMLValue.Create(value)); 495 | end; 496 | 497 | procedure TTOMLArray.Add(const data: TTOMLData); 498 | begin 499 | data.parent := self; 500 | list.Add(data); 501 | end; 502 | 503 | constructor TTOMLArray.Create; 504 | begin 505 | list := TTOMLDataList.Create(true); 506 | end; 507 | 508 | destructor TTOMLArray.Destroy; 509 | begin 510 | list.Free; 511 | inherited; 512 | end; 513 | 514 | { TTOMLTable } 515 | 516 | function TTOMLTable.GetKey(index: integer): TTOMLKeyType; 517 | begin 518 | result := map.Keys[index]; 519 | end; 520 | 521 | function TTOMLTable.GetItem(key: TTOMLKeyType): TTOMLData; 522 | var 523 | data: TTOMLData; 524 | begin 525 | if map.TryGetData(key, data) then 526 | result := data 527 | else 528 | raise ETOMLData.Create('Key "'+key+'" doesn''t exist in table "'+name+'"'); 529 | end; 530 | 531 | function TTOMLTable.GetItem(index: integer): TTOMLData; 532 | begin 533 | result := map.data[index]; 534 | end; 535 | 536 | procedure TTOMLTable.SetItem(key: TTOMLKeyType; item: TTOMLData); 537 | begin 538 | Put(key, item); 539 | end; 540 | 541 | function TTOMLTable.Count: integer; 542 | begin 543 | result := map.Count; 544 | end; 545 | 546 | function TTOMLTable.AsJSON: TJSONData; 547 | var 548 | i: integer; 549 | obj: TJSONObject; 550 | begin 551 | obj := TJSONObject.Create; 552 | for i := 0 to map.Count - 1 do 553 | obj.Add(map.Keys[i], map.Data[i].AsJSON); 554 | result := obj; 555 | end; 556 | 557 | procedure TTOMLTable.Add(const key: String; const data: TTOMLData); 558 | begin 559 | if Contains(key) then 560 | raise ETOMLData.Create('Key "'+key+'" already exists in table "'+name+'"'); 561 | data.parent := self; 562 | map.Add(key, data); 563 | end; 564 | 565 | procedure TTOMLTable.Add(const key: String; const value: TTOMLValueType); 566 | begin 567 | Add(key, TTOMLValue.Create(value)); 568 | end; 569 | 570 | procedure TTOMLTable.Put(const key: String; const value: TTOMLValueType); 571 | begin 572 | Put(key, TTOMLValue.Create(value)); 573 | end; 574 | 575 | procedure TTOMLTable.Put(const key: String; const data: TTOMLData); 576 | var 577 | index: integer; 578 | begin 579 | data.parent := self; 580 | 581 | if map.Find(key, index) then 582 | begin 583 | // replace existing item 584 | map.data[index] := data; 585 | end 586 | else 587 | map.Add(key, data); 588 | end; 589 | 590 | function TTOMLTable.Contains(const key: TTOMLKeyType; dataType: TTOMLDataClass = nil): boolean; 591 | var 592 | data: TTOMLData; 593 | begin 594 | result := map.TryGetData(key, data); 595 | if result and 596 | assigned(dataType) and 597 | not data.InheritsFrom(dataType) then 598 | result := false; 599 | end; 600 | 601 | function TTOMLTable.Find(const key: TTOMLKeyType): TTOMLData; 602 | var 603 | data: TTOMLData; 604 | begin 605 | if map.TryGetData(key, data) then 606 | result := data 607 | else 608 | result := nil; 609 | end; 610 | 611 | constructor TTOMLTable.Create(name: string); 612 | begin 613 | m_name := name; 614 | defined := false; 615 | map := TTOMLDataMap.Create(true); 616 | map.Sorted := true; 617 | end; 618 | 619 | destructor TTOMLTable.Destroy; 620 | begin 621 | map.Free; 622 | inherited; 623 | end; 624 | 625 | 626 | end. -------------------------------------------------------------------------------- /sources/TOMLParser.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2020 by Ryan Joseph 3 | 4 | TOML Parser 5 | This unit implements the main parser class 6 | 7 | ******************************************************************** 8 | 9 | Permission is hereby granted, free of charge, to any person obtaining 10 | a copy of this software and associated documentation files (the "Software"), 11 | to deal in the Software without restriction, including without limitation 12 | the rights to use, copy, modify, merge, publish, distribute, sublicense, 13 | and/or sell copies of the Software, and to permit persons to whom the 14 | Software is furnished to do so, subject to the following conditions: 15 | 16 | The above copyright notice and this permission notice shall be included in 17 | all copies or substantial portions of the Software. 18 | 19 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 20 | INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A 21 | PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 22 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 23 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE 24 | OR OTHER DEALINGS IN THE SOFTWARE. 25 | } 26 | 27 | {$mode objfpc} 28 | 29 | unit TOMLParser; 30 | interface 31 | uses 32 | Classes, 33 | Scanner, 34 | TOMLTypes; 35 | 36 | type 37 | TTOMLScanner = class(TScanner) 38 | private 39 | document: TTOMLDocument; 40 | containers: TTOMLContainerList; 41 | private 42 | function LastTable: TTOMLTable; inline; 43 | procedure PopLast; 44 | 45 | function ParseArray: TTOMLArray; 46 | function ParseTable: TTOMLData; 47 | function ParseInlineTable: TTOMLTable; 48 | function ParseArrayOfTables: TTOMLData; 49 | function ParseString: TTOMLStringType; 50 | function ParseDate(continueFromNumber: boolean = false): TTOMLDate; 51 | function ParseTime(continueFromNumber: boolean = false): TTOMLDate.TTime; 52 | procedure ParsePair; 53 | function ParseValue: TTOMLData; 54 | function ParseKey: TStringList; 55 | 56 | function ReadDigits(digits: integer; decimals: boolean = false): string; 57 | protected 58 | procedure ParseToken; override; 59 | procedure UnknownCharacter(out cont: boolean); override; 60 | function ReadWord: TIdentifier; override; 61 | function ReadNumber: string; override; 62 | function GetException: EScannerClass; override; 63 | public 64 | destructor Destroy; override; 65 | procedure Parse; override; 66 | end; 67 | 68 | function GetTOML(contents: TTOMLStringType): TTOMLDocument; 69 | 70 | implementation 71 | uses 72 | SysUtils, StrUtils; 73 | 74 | type 75 | ETOML = class(EScanner); 76 | 77 | function GetTOML(contents: TTOMLStringType): TTOMLDocument; 78 | var 79 | parser: TTOMLScanner; 80 | begin 81 | parser := TTOMLScanner.Create(contents); 82 | parser.Parse; 83 | result := parser.document; 84 | parser.Free; 85 | end; 86 | 87 | { TTOMLScanner } 88 | 89 | function TTOMLScanner.GetException: EScannerClass; 90 | begin 91 | result := ETOML; 92 | end; 93 | 94 | function TTOMLScanner.LastTable: TTOMLTable; 95 | begin 96 | result := TTOMLTable(containers.Last); 97 | end; 98 | 99 | procedure TTOMLScanner.PopLast; 100 | begin 101 | if containers.Last <> document then 102 | containers.Delete(containers.Count - 1); 103 | end; 104 | 105 | function TTOMLScanner.ParseString: TTOMLStringType; 106 | var 107 | quote: char; 108 | scalar: longint; 109 | multiline, 110 | literal, 111 | firstPass: boolean; 112 | begin 113 | pattern := ''; 114 | quote := c; 115 | literal := quote = ''''; 116 | multiline := false; 117 | firstPass := true; 118 | while true do 119 | begin 120 | ReadChar; 121 | 122 | { Multi-line basic strings are surrounded by three quotation marks on each side 123 | and allow newlines. A newline immediately following the opening delimiter will be trimmed. 124 | All other whitespace and newline characters remain intact. } 125 | if firstPass and (c = quote) then 126 | begin 127 | ReadChar; 128 | firstPass := false; 129 | if c = quote then 130 | begin 131 | multiline := true; 132 | // trim first new line 133 | if Peek(System.LineEnding, 1) then 134 | Advance(Length(LineEnding)); 135 | continue; 136 | end 137 | else // the string is empty so return now 138 | begin 139 | result := pattern; 140 | ReadToken; 141 | exit; 142 | end; 143 | end; 144 | 145 | { For convenience, some popular characters have a compact escape sequence. 146 | 147 | \b - backspace (U+0008) 148 | \t - tab (U+0009) 149 | \n - linefeed (U+000A) 150 | \f - form feed (U+000C) 151 | \r - carriage return (U+000D) 152 | \" - quote (U+0022) 153 | \\ - backslash (U+005C) 154 | \uXXXX - unicode (U+XXXX) 155 | \UXXXXXXXX - unicode (U+XXXXXXXX) } 156 | 157 | if not literal and (c = '\') then 158 | begin 159 | ReadChar; 160 | 161 | 162 | { For writing long strings without introducing extraneous whitespace, 163 | use a "line ending backslash". When the last non-whitespace character 164 | on a line is a \, it will be trimmed along with all whitespace (including newlines) 165 | up to the next non-whitespace character or closing delimiter. 166 | All of the escape sequences that are valid for basic strings are 167 | also valid for multi-line basic strings. } 168 | 169 | if IsLineEnding then 170 | begin 171 | SkipSpace; 172 | if c <> quote then 173 | pattern += c; 174 | continue; 175 | end; 176 | 177 | // escaped quotes 178 | if c = quote then 179 | pattern += c 180 | else if c in ['b', 't', 'n', 'f', 'r', 'u', 'U'] then 181 | begin 182 | case c of 183 | 'b': 184 | pattern += #8; 185 | 't': 186 | pattern += #9; 187 | 'n': 188 | pattern += #10; 189 | 'f': 190 | pattern += #12; 191 | 'r': 192 | pattern += #13; 193 | 'u': 194 | begin 195 | ReadChar; 196 | scalar := Hex2Dec(PeekString(4)); 197 | pattern += UnicodeChar(scalar); 198 | Advance(4 - 1); 199 | end; 200 | 'U': 201 | begin 202 | scalar := Hex2Dec(PeekString(8)); 203 | pattern += UnicodeChar(scalar); 204 | Advance(8 - 1); 205 | end; 206 | end; 207 | end; 208 | end 209 | // line breaks are not allowed 210 | else if not multiline and IsLineEnding then 211 | ParserError('Single line strings must not contain line endings (#'+IntToStr(ord(c))+')') 212 | // join any character that isn't a quote 213 | else if c <> quote then 214 | pattern += c 215 | // terminate string 216 | else if c = quote then 217 | begin 218 | if multiline then 219 | begin 220 | // end of string 221 | if Peek(quote+quote) then 222 | begin 223 | result := pattern; 224 | ReadTo(3); 225 | exit; 226 | end 227 | else 228 | pattern += c; 229 | end 230 | else 231 | begin 232 | result := pattern; 233 | ReadTo(1); 234 | exit; 235 | end; 236 | end; 237 | end; 238 | Assert(false, 'string termination error'); 239 | end; 240 | 241 | function TTOMLScanner.ParseArrayOfTables: TTOMLData; 242 | var 243 | keys: TStringList; 244 | table: TTOMLData; 245 | parent, child: TTOMLTable; 246 | arr: TTOMLArray; 247 | i: integer; 248 | begin 249 | Consume(TToken.SquareBracketOpen); 250 | keys := ParseKey; 251 | 252 | //writeln('parse array of tables: ',keys.CommaText); 253 | 254 | PopLast; 255 | parent := LastTable; 256 | 257 | for i := 0 to keys.Count - 1 do 258 | begin 259 | table := parent.Find(keys[i]); 260 | if table = nil then 261 | begin 262 | // add array as value for key and then add empty table 263 | arr := TTOMLArray.Create; 264 | child := TTOMLTable.Create(keys[i]); 265 | child.parentIsArray := true; 266 | child.parent := parent; 267 | arr.Add(child); 268 | 269 | parent.Add(child.Name, arr); 270 | parent := child; 271 | end 272 | else if table is TTOMLTable then 273 | parent := TTOMLTable(table) 274 | else if table is TTOMLArray then 275 | begin 276 | // the last key should add a new table to the array 277 | if i = keys.Count - 1 then 278 | begin 279 | child := TTOMLTable.Create(keys[i]); 280 | TTOMLArray(table).Add(child); 281 | end 282 | else 283 | child := TTOMLArray(table).Last as TTOMLTable; 284 | parent := child; 285 | end; 286 | end; 287 | 288 | // push table 289 | containers.Add(parent); 290 | result := parent; 291 | 292 | Consume(TToken.SquareBracketClosed); 293 | Consume(TToken.SquareBracketClosed); 294 | end; 295 | 296 | function TTOMLScanner.ParseTable: TTOMLData; 297 | var 298 | keys: TStringList; 299 | table: TTOMLData; 300 | parent, child: TTOMLTable; 301 | i: integer; 302 | begin 303 | Consume(TToken.SquareBracketOpen); 304 | // parse array of tables 305 | if token = TToken.SquareBracketOpen then 306 | exit(ParseArrayOfTables); 307 | keys := ParseKey; 308 | 309 | //writeln('parse table: ',keys.CommaText); 310 | 311 | PopLast; 312 | parent := LastTable; 313 | 314 | for i := 0 to keys.Count - 1 do 315 | begin 316 | table := parent.Find(keys[i]); 317 | if table = nil then 318 | begin 319 | child := TTOMLTable.Create(keys[i]); 320 | parent.Add(child.Name, child); 321 | parent := child; 322 | end 323 | else if table is TTOMLTable then 324 | begin 325 | // the final key defines a new table 326 | // which is illegal if 327 | if (i = keys.Count - 1) and TTOMLTable(table).defined then 328 | ParserError('Table "'+keys[i]+'" is already defined') 329 | else 330 | parent := TTOMLTable(table); 331 | end 332 | else if table is TTOMLArray then 333 | begin 334 | child := TTOMLArray(table).Last as TTOMLTable; 335 | parent := child; 336 | end 337 | else 338 | ParserError('Key "'+keys[i]+'" is already defined as a value.'); 339 | end; 340 | 341 | // the final table is now defined 342 | parent.defined := true; 343 | 344 | // push table 345 | containers.Add(parent); 346 | result := parent; 347 | 348 | Consume(TToken.SquareBracketClosed); 349 | end; 350 | 351 | { Parse inline tables 352 | https://toml.io/en/v1.0.0-rc.1#inline-table } 353 | 354 | function TTOMLScanner.ParseInlineTable: TTOMLTable; 355 | begin 356 | // inline tables don't allow newlines so we can override the newline behavior 357 | // of the scanner by enabling newlines as tokens 358 | readLineEndingsAsTokens := true; 359 | 360 | Consume(TToken.CurlyBracketOpen); 361 | 362 | // push new table to stack 363 | result := TTOMLTable.Create; 364 | containers.Add(result); 365 | 366 | repeat 367 | ParsePair; 368 | 369 | if TryConsume(TToken.Comma) then 370 | begin 371 | // curly bracket found for pair 372 | if TryConsume(TToken.CurlyBracketClosed) then 373 | ParserError('Inline tables do not allow trailing commas.'); 374 | continue; 375 | end; 376 | until TryConsume(TToken.CurlyBracketClosed); 377 | 378 | // disable EOL tokens and clear the next one if it's found 379 | readLineEndingsAsTokens := false; 380 | TryConsume(TToken.EOL); 381 | 382 | result.terminated := true; 383 | 384 | PopLast; 385 | end; 386 | 387 | 388 | function TTOMLScanner.ParseArray: TTOMLArray; 389 | var 390 | value: TTOMLData; 391 | begin 392 | Consume(TToken.SquareBracketOpen); 393 | result := TTOMLArray.Create; 394 | result.terminated := true; 395 | 396 | // the array has no values 397 | if TryConsume(TToken.SquareBracketClosed) then 398 | exit(result); 399 | 400 | repeat 401 | value := ParseValue; 402 | result.Add(value); 403 | if TryConsume(TToken.Comma) then 404 | continue; 405 | until TryConsume(TToken.SquareBracketClosed); 406 | end; 407 | 408 | function TTOMLScanner.ParseValue: TTOMLData; 409 | 410 | function ParseNamedValue(negative: boolean = false): TTOMLData; 411 | var 412 | valueString: string; 413 | begin 414 | result := nil; 415 | valueString := LowerCase(pattern); 416 | if (valueString = 'false') or (valueString = 'true') then 417 | begin 418 | if negative then 419 | ParserError('Negative booleans are invalid'); 420 | result := TTOMLNumber.Create(StrToBool(valueString), TTOMLNumberType.Boolean); 421 | Consume; 422 | end 423 | else if valueString = 'inf' then 424 | begin 425 | if negative then 426 | result := TTOMLNumber.Create(-1/0, TTOMLNumberType.Float) 427 | else 428 | result := TTOMLNumber.Create(1/0, TTOMLNumberType.Float); 429 | Consume; 430 | end 431 | else if valueString = 'nan' then 432 | begin 433 | result := TTOMLNumber.Create(0/0, TTOMLNumberType.Float); 434 | Consume; 435 | end; 436 | end; 437 | 438 | var 439 | negative: boolean; 440 | begin 441 | case token of 442 | TToken.DoubleQuote: 443 | result := TTOMLValue.Create(ParseString); 444 | TToken.SingleQuote: 445 | result := TTOMLValue.Create(ParseString); 446 | TToken.Integer: 447 | begin 448 | // the integer is a possible date so switch parsers 449 | if c = '-' then 450 | begin 451 | Advance(1); 452 | result := ParseDate(true); 453 | Consume; 454 | end 455 | else if c = ':' then 456 | begin 457 | Advance(1); 458 | result := TTOMLDate.Create(ParseTime(true)); 459 | Consume; 460 | end 461 | else 462 | begin 463 | result := TTOMLNumber.Create(LongInt(StrToInt(pattern)), TTOMLNumberType.Integer); 464 | Consume; 465 | end; 466 | end; 467 | TToken.HexadecimalNumber: 468 | begin 469 | result := TTOMLNumber.Create(LongInt(StrToInt(pattern)), TTOMLNumberType.Hexadecimal); 470 | Consume; 471 | end; 472 | TToken.OctalNumber: 473 | begin 474 | result := TTOMLNumber.Create(LongInt(StrToInt(pattern)), TTOMLNumberType.Octal); 475 | Consume; 476 | end; 477 | TToken.BinaryNumber: 478 | begin 479 | result := TTOMLNumber.Create(LongInt(StrToInt(pattern)), TTOMLNumberType.Binary); 480 | Consume; 481 | end; 482 | TToken.RealNumber: 483 | begin 484 | result := TTOMLNumber.Create(StrToFloat(pattern), TTOMLNumberType.Float); 485 | Consume; 486 | end; 487 | TToken.SquareBracketOpen: 488 | result := ParseArray; 489 | TToken.CurlyBracketOpen: 490 | result := ParseInlineTable; 491 | TToken.Plus, 492 | TToken.Dash: 493 | begin 494 | negative := token = TToken.Dash; 495 | Consume; 496 | result := ParseNamedValue(negative); 497 | end; 498 | TToken.ID: 499 | begin 500 | result := ParseNamedValue; 501 | if result = nil then 502 | ParserError('Invalid value "'+pattern+'"'); 503 | end; 504 | otherwise 505 | result := nil; 506 | end; 507 | Assert(result <> nil, 'Invalid TOML value from "'+token.ToString+'"'); 508 | end; 509 | 510 | function TTOMLScanner.ParseKey: TStringList; 511 | begin 512 | { *Bare* keys may only contain ASCII letters, ASCII digits, underscores, and dashes (A-Za-z0-9_-). 513 | Note that bare keys are allowed to be composed of only ASCII digits, e.g. 1234, 514 | but are always interpreted as strings. 515 | 516 | *Quoted* keys follow the exact same rules as either basic strings or literal strings and allow 517 | you to use a much broader set of key names. Best practice is to use bare keys except when absolutely necessary. } 518 | 519 | result := TStringList.Create; 520 | 521 | while true do 522 | begin 523 | if (token = TToken.DoubleQuote) or (token = TToken.SingleQuote) then 524 | begin 525 | Consume; 526 | result.Add(ParseString); 527 | end 528 | else if token = TToken.Integer then 529 | begin 530 | Consume; 531 | result.Add(pattern); 532 | end 533 | else 534 | begin 535 | result.Add(pattern); 536 | Consume(TToken.ID); 537 | end; 538 | 539 | if not TryConsume(TToken.Dot) then 540 | break; 541 | end; 542 | end; 543 | 544 | { Parse key/value pair 545 | https://toml.io/en/v1.0.0-rc.1#keyvalue-pair } 546 | 547 | procedure TTOMLScanner.ParsePair; 548 | var 549 | keys: TStringList; 550 | lastKey: TTOMLData; 551 | table, value: TTOMLData; 552 | child, parent: TTOMLTable; 553 | i: integer; 554 | begin 555 | keys := ParseKey; 556 | Consume(TToken.Equals); 557 | value := ParseValue; 558 | 559 | //writeln('parse pair: ',keys.CommaText); 560 | 561 | parent := LastTable; 562 | 563 | // add dotted keys as tables 564 | if keys.Count > 1 then 565 | begin 566 | if parent.parentIsArray then 567 | parent := TTOMLTable(parent.parent); 568 | for i := 0 to keys.Count - 2 do 569 | begin 570 | table := parent.Find(keys[i]); 571 | if table = nil then 572 | begin 573 | child := TTOMLTable.Create; 574 | parent.Add(keys[i], child); 575 | parent := child; 576 | end 577 | else if table is TTOMLTable then 578 | parent := TTOMLTable(table) 579 | else if table is TTOMLArray then 580 | begin 581 | // the node at the current key is a fully defined array 582 | { 583 | list.items = [1,2,3] 584 | list.items.more = 1 # ERROR 585 | } 586 | if TTOMLArray(table).terminated then 587 | ParserError('Dotted key "'+keys[i]+'", can''t index into array'); 588 | child := TTOMLArray(table).Last as TTOMLTable; 589 | parent := child; 590 | end; 591 | end; 592 | end 593 | else if parent.Find(keys[0]) <> nil then 594 | begin 595 | if (value is TTOMLTable) and (TTOMLTable(value).terminated) then 596 | ParserError('Inline tables can not replace partially defined tables'); 597 | end; 598 | 599 | if parent.terminated then 600 | ParserError('Additional keys can not be added to fully defined inline tables'); 601 | 602 | // push the last key to the parent table 603 | if keys.Count > 1 then 604 | begin 605 | lastKey := parent.Find(keys[keys.Count - 2]); 606 | if (lastKey <> nil) and (lastKey is TTOMLValue) then 607 | ParserError('"'+keys[keys.Count - 2]+'" is already defined as '+TTOMLValue(lastKey).TypeString); 608 | end; 609 | 610 | parent.defined := true; 611 | 612 | parent.Add(keys[keys.Count - 1], value); 613 | end; 614 | 615 | function TTOMLScanner.ReadDigits(digits: integer; decimals: boolean = false): string; 616 | begin 617 | pattern := ''; 618 | while (c in ['0'..'9']) and (Length(pattern) <= digits) do 619 | begin 620 | AdvancePattern; 621 | // decimal part at the end 622 | if decimals and (c = '.') then 623 | begin 624 | AdvancePattern; 625 | while c in ['0'..'9'] do 626 | AdvancePattern; 627 | break; 628 | end; 629 | end; 630 | if pattern = '' then 631 | ParserError('Expected '+IntToStr(digits)+' digits but got "'+c+'".'); 632 | result := pattern; 633 | end; 634 | 635 | function TTOMLScanner.ParseTime(continueFromNumber: boolean): TTOMLDate.TTime; 636 | begin 637 | // hours 638 | // the parsing is being continued from a number 639 | // so the year is already in the pattern buffer 640 | if continueFromNumber then 641 | result.hours := StrToInt(pattern) 642 | else 643 | begin 644 | result.hours := StrToInt(ReadDigits(2)); 645 | Consume(':'); 646 | end; 647 | 648 | // minutes 649 | result.minutes := StrToInt(ReadDigits(2)); 650 | 651 | // seconds 652 | // TODO: are seconds optional? 653 | if c = ':' then 654 | begin 655 | Consume(':'); 656 | result.seconds := StrToFloat(ReadDigits(2, true)); 657 | end 658 | else 659 | result.seconds := 0; 660 | end; 661 | 662 | function TTOMLScanner.ParseDate(continueFromNumber: boolean): TTOMLDate; 663 | var 664 | date: TTOMLDate; 665 | begin 666 | date := TTOMLDate.Create; 667 | 668 | // the parsing is being continued from a number 669 | // so the year is already in the pattern buffer 670 | if continueFromNumber then 671 | date.year := StrToInt(pattern) 672 | else 673 | begin 674 | date.year := StrToInt(ReadDigits(4)); 675 | Consume('-'); 676 | end; 677 | 678 | // month 679 | date.month := StrToInt(ReadDigits(2)); 680 | 681 | // day 682 | Consume('-'); 683 | date.day := StrToInt(ReadDigits(2)); 684 | 685 | // the date is a solo year 686 | if IsLineEnding then 687 | begin 688 | result := date; 689 | exit; 690 | end; 691 | 692 | // time seperator 693 | if (c = 'T') or (c = ' ') then 694 | Advance(1) 695 | else 696 | ParserError('Date must be separated by single space or "T".'); 697 | 698 | // hour 699 | date.time := ParseTime; 700 | 701 | // zulu 702 | if c = 'Z' then 703 | begin 704 | Consume('Z'); 705 | date.time.z := true; 706 | end; 707 | 708 | // offset time 709 | if c = '-' then 710 | begin 711 | Consume('-'); 712 | date.offset := ParseTime; 713 | end; 714 | 715 | pattern := ''; 716 | 717 | result := date; 718 | end; 719 | 720 | function TTOMLScanner.ReadNumber: string; 721 | 722 | function LastChar: char; 723 | begin 724 | if pattern <> '' then 725 | result := pattern[high(pattern)] 726 | else 727 | result := #0; 728 | end; 729 | 730 | var 731 | negative: boolean = false; 732 | underscore: boolean = false; 733 | found: boolean; 734 | label 735 | Finished; 736 | begin 737 | pattern := ''; 738 | token := TToken.Integer; 739 | 740 | if c = '-' then 741 | begin 742 | negative := true; 743 | AdvancePattern; 744 | end; 745 | 746 | if c = '+' then 747 | AdvancePattern; 748 | 749 | while c in ['0'..'9', '.', 'e', 'E', '_'] do 750 | begin 751 | if c = '_' then 752 | begin 753 | if underscore then 754 | ParserError('Each underscore must be surrounded by at least one digit on each side'); 755 | ReadChar; 756 | underscore := true; 757 | continue; 758 | end; 759 | 760 | underscore := false; 761 | 762 | // parse octal 763 | if (c = '0') and (Peek(1) = 'o') then 764 | begin 765 | token := TToken.OctalNumber; 766 | Advance(2); 767 | continue; 768 | end; 769 | 770 | // parse binary 771 | if (c = '0') and (Peek(1) = 'b') then 772 | begin 773 | token := TToken.BinaryNumber; 774 | Advance(2); 775 | continue; 776 | end; 777 | 778 | // parse hexadecimal 779 | if (c = '0') and (Peek(1) = 'x') then 780 | begin 781 | token := TToken.HexadecimalNumber; 782 | AdvancePattern(2); 783 | while true do 784 | begin 785 | if c in ['A'..'F','a'..'f','_'] then 786 | begin 787 | if c = '_' then 788 | begin 789 | if underscore then 790 | ParserError('Each underscore must be surrounded by at least one digit on each side'); 791 | ReadChar; 792 | underscore := true; 793 | continue; 794 | end; 795 | AdvancePattern; 796 | underscore := false; 797 | end 798 | else 799 | begin 800 | if IsWhiteSpace then 801 | break 802 | else 803 | ParserError('Invalid hexadecimal number'); 804 | end; 805 | end; 806 | goto Finished; 807 | end; 808 | 809 | if LowerCase(c) = 'e' then 810 | begin 811 | token := TToken.RealNumber; 812 | AdvancePattern; 813 | if (c = '-') or (c = '+') then 814 | AdvancePattern; 815 | found := false; 816 | while c in ['0'..'9'] do 817 | begin 818 | found := true; 819 | if c = '_' then 820 | begin 821 | if underscore then 822 | ParserError('Each underscore must be surrounded by at least one digit on each side'); 823 | ReadChar; 824 | underscore := true; 825 | continue; 826 | end; 827 | AdvancePattern; 828 | end; 829 | if not found then 830 | ParserError('Exponent must be followed by an integer'); 831 | break; 832 | end 833 | else if c = '.' then 834 | token := TToken.RealNumber; 835 | 836 | AdvancePattern; 837 | end; 838 | 839 | if underscore then 840 | ParserError('Each underscore must be surrounded by at least one digit on each side'); 841 | 842 | Finished: 843 | 844 | // incomplete prefixed number 845 | if Length(pattern) = 2 then 846 | case token of 847 | TToken.HexadecimalNumber: 848 | ParserError('Incomplete hexadecimal number'); 849 | TToken.OctalNumber: 850 | ParserError('Incomplete octal number'); 851 | TToken.BinaryNumber: 852 | ParserError('Incomplete binary number'); 853 | end; 854 | 855 | result := pattern; 856 | end; 857 | 858 | function TTOMLScanner.ReadWord: TIdentifier; 859 | begin 860 | pattern := ''; 861 | // TODO: words must start with alphas and quotes are allowed 862 | // dashes must have be adjacent to at least 1 alpha 863 | while c in ['a'..'z','A'..'Z','0'..'9','_','-'] do 864 | AdvancePattern; 865 | result := pattern; 866 | end; 867 | 868 | procedure TTOMLScanner.UnknownCharacter(out cont: boolean); 869 | begin 870 | case c of 871 | '"': 872 | token := TToken.DoubleQuote; 873 | '''': 874 | token := TToken.SingleQuote; 875 | '#': 876 | begin 877 | ReadUntilEOL; 878 | cont := true; 879 | end; 880 | otherwise 881 | inherited; 882 | end; 883 | end; 884 | 885 | procedure TTOMLScanner.ParseToken; 886 | begin 887 | case token of 888 | TToken.SquareBracketOpen: 889 | ParseTable; 890 | // key/value pairs can be ID, Integer (non-negative) or strings (see ParseKey) 891 | TToken.ID, 892 | TToken.Integer, 893 | TToken.DoubleQuote, 894 | TToken.SingleQuote: 895 | ParsePair; 896 | otherwise 897 | if token <> TToken.EOF then 898 | ParserError('Unexpected "'+token.ToString+'" found.'); 899 | end; 900 | end; 901 | 902 | procedure TTOMLScanner.Parse; 903 | begin 904 | containers := TTOMLContainerList.Create; 905 | document := TTOMLDocument.Create('document'); 906 | containers.Add(document); 907 | inherited; 908 | end; 909 | 910 | destructor TTOMLScanner.Destroy; 911 | begin 912 | containers.Free; 913 | 914 | inherited; 915 | end; 916 | 917 | 918 | end. --------------------------------------------------------------------------------